├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── Makefile ├── README.md ├── batsh.opam ├── dune-project ├── lib ├── bash.ml ├── bash.mli ├── bash_ast.ml ├── bash_compile.ml ├── bash_format.ml ├── bash_functions.ml ├── bash_transform.ml ├── batsh_ast.ml ├── batsh_format.ml ├── batsh_lib.ml ├── dune ├── errors.ml ├── errors.mli ├── formatutil.ml ├── lexer.mll ├── parser.ml ├── parser.mli ├── parser_yacc.mly ├── semantic_checker.ml ├── symbol_table.ml ├── symbol_table.mli ├── winbat.ml ├── winbat.mli ├── winbat_ast.ml ├── winbat_compile.ml ├── winbat_format.ml ├── winbat_functions.ml └── winbat_transform.ml ├── scripts └── update.js ├── src ├── batsh.ocp ├── dune ├── main.ml └── version.ml ├── test_scripts ├── arith.batsh ├── array.batsh ├── assignment.batsh ├── bash │ ├── arith.sh │ ├── array.sh │ ├── assignment.sh │ ├── block.sh │ ├── command.sh │ ├── comment.sh │ ├── exists.sh │ ├── function.sh │ ├── if.sh │ ├── recursion.sh │ ├── string.sh │ └── while.sh ├── batch │ ├── arith.bat │ ├── array.bat │ ├── assignment.bat │ ├── block.bat │ ├── command.bat │ ├── comment.bat │ ├── exists.bat │ ├── function.bat │ ├── if.bat │ ├── recursion.bat │ ├── string.bat │ └── while.bat ├── block.batsh ├── command.batsh ├── comment.batsh ├── exists.batsh ├── function.batsh ├── if.batsh ├── output │ ├── arith.txt │ ├── array.txt │ ├── assignment.txt │ ├── block.txt │ ├── command.txt │ ├── comment.txt │ ├── exists.txt │ ├── function.txt │ ├── if.txt │ ├── recursion.txt │ ├── string.txt │ └── while.txt ├── recursion.batsh ├── string.batsh └── while.batsh └── tests ├── dune └── main.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _obuild/ 2 | *.sublime* 3 | ocp-build.root* 4 | tests/oUnit* 5 | batsh 6 | oUnit-anon.cache 7 | _build/ 8 | .merlin 9 | *.install 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | branches: 4 | except: 5 | - dev 6 | services: 7 | - docker 8 | before_install: 9 | - docker pull ocaml/opam2:alpine 10 | - docker run -td --name builder -v $(pwd):/home/opam/Batsh-master ocaml/opam2:alpine 11 | - docker exec builder sudo apk add m4 12 | - docker exec builder sudo apk add linux-headers 13 | - docker exec builder opam install dune 14 | - docker exec builder opam install core_kernel 15 | - docker exec builder opam install core 16 | - docker exec builder opam install ounit2 17 | - docker exec builder opam pin add dlist https://github.com/darrenldl/Dlist.git 18 | - docker exec builder opam install ppx_sexp_conv 19 | - docker exec builder opam install cmdliner 20 | - docker exec builder opam install sexplib 21 | - docker exec builder opam install menhir 22 | script: 23 | - docker exec builder bash -c 'cd ~; echo $(pwd)' 24 | - docker exec builder bash -c 'cd ~; ls' 25 | - docker exec builder bash -c 'cp -r ~/Batsh-master ~/Batsh' 26 | - docker exec builder bash -c 'chmod u=rwx ~/Batsh' 27 | - docker exec builder bash -c 'eval $(opam env); cd ~/Batsh/; make' 28 | - docker cp builder:/home/opam/Batsh/_build/default/src/main.exe ./batsh 29 | - strip batsh 30 | notifications: 31 | email: 32 | on_success: never 33 | deploy: 34 | provider: releases 35 | api_key: 36 | secure: Fd8V/RfIG4DVP355EituB9SBSFKL+R+VI1RzBDsvMclSmd4d42rQrmJ3jl30waY3BwGlzeRLMdZt1Wd7abnUohAQiAdEndrdYfzVes+54N2QK/AMEcUXWqwISQjt2tue73XS72L7IfR2cw5rIAq+SLeeA9FzELjGrDAmzkxSG/is8pa6heVXiD14jYyInRiH0EvAmwPG7dopCCSaOLcv2Fk+LRQ1vJqTA4sQ6Ytz/s8gpDpqUJXkdq6nsDeUr7WrzBhRXgvn6X0u0S1c8hbv79s3F5b6cDKZ/Hr4jJNZGDQfvO9NT4f3BIdo7kpsM9u3LxfxbSCB6AHY3im0tLOtGcmk4kn3qCiNPPp6+4SmYWuS8CRSt9XH95lnmLABb3fFkp1QKrk6vmbKmKoRWB+3edePQvS14GPjNKW7g+EiiVSjYN0OEmL9dxVQfsIF5iZV7mxRkZFdfYKSOUa0uI3SEcLUDpk4SkvQVODcLaL4/XOchvwqevfAI/fKRred5Vbi7grwlPAepowfN+moxBvWXRSbMvsBENhzkwqGFdqiSN7prKZsPbWMWmP71Tn3+Lqwr1QTWY6+b8UpthT7mKRcXrdjYE3WG+YNleOtCsW3nWZPlgR9GWIowiylc/PDBIcokvm1dRb5isj2ETefMhlmfBAdUxlrsf20dFdIvgC3aIE= 37 | file: batsh 38 | on: 39 | tags: true 40 | repo: darrenldl/Batsh 41 | skip_cleanup: true 42 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 0.0.7 2 | 3 | - Migrated to `dune` as build system 4 | 5 | - Switched to using `ppx` for derivation of sexp related functions 6 | 7 | - Switching from presumably ocamlyacc to menhir for `parser_yacc.mly` (modified file a bit to fit menhir’s syntax) 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | SRCFILES = src/*.ml* 2 | 3 | OCAMLFORMAT = ocamlformat \ 4 | --inplace \ 5 | --field-space loose \ 6 | --let-and sparse \ 7 | --let-open auto \ 8 | --type-decl sparse \ 9 | --sequence-style terminator \ 10 | $(SRCFILES) 11 | 12 | OCPINDENT = ocp-indent \ 13 | --inplace \ 14 | $(SRCFILES) 15 | 16 | .PHONY: all 17 | all : 18 | dune build @all 19 | 20 | .PHONY: test 21 | test : 22 | dune exec ./tests/main.exe 23 | 24 | .PHONY: run 25 | run : 26 | dune exec ./src/main.exe 27 | 28 | .PHONY: format 29 | format : 30 | $(OCAMLFORMAT) 31 | $(OCPINDENT) 32 | 33 | .PHONY : clean 34 | clean: 35 | dune clean 36 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Batsh 2 | 3 | ## Notes from maintainers 4 | 5 | This repo was transferred from the original author @BYVoid, 6 | and has been upgraded to build on more recent OCaml versions (buildable on at least OCaml 4.08.1). 7 | You can see the discussion thread which spawned this fork effort 8 | [here](https://discuss.ocaml.org/t/compiling-batsh/4700/). 9 | 10 | Note that this project is currently in minimum maintenance mode. 11 | Issues, PR may not be actively dealt with. 12 | 13 | The following sections may contain out of date info as we are still 14 | in the process of going through the repo 15 | 16 | ## Project description 17 | 18 | Batsh is a simple programming language that compiles to Bash and Windows [Batch](http://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/batch.mspx). 19 | It enables you to write your script once runs on all platforms without **any** additional dependency. 20 | 21 | Both Bash and Batch are messy to read and tricky to write due to historical reasons. 22 | You have to spend a lot of time learning either of them and write platform-dependent code for each operating system. 23 | I have wasted lots of time in my life struggling with bizarre syntaxes and unreasonable behaviors of them, and do not want to waste any more. 24 | 25 | If you happen to be a maintainer of a cross-platform tool which relies on Bash on Linux/Mac and Batch on Windows as "glue code", and found it painful to "synchronize" between them, you would definitely like to try Batsh. 26 | 27 | ## How to get it 28 | 29 | ### The easiest way 30 | 31 | [Try it online: http://batsh.org](http://batsh.org/) 32 | 33 | ### Install from OPAM 34 | 35 | Batsh is implemented in OCaml and managed by [OPAM](http://opam.ocaml.org/pkg/batsh/0.0.5/). 36 | 37 | 1. Install OPAM. See [instructions](http://opam.ocaml.org/doc/Install.html). 38 | 2. Switch to the latest version (or at least 4.00.1) of OCaml by running `opam switch`. 39 | 3. Install Batsh: `opam install batsh` 40 | 41 | ### Build from source 42 | 43 | You have to install OCaml (version 4.00.1 or higher) development environment before compiling Batsh from source code, and follow steps below: 44 | 45 | 1. Download source code of Batsh from [releases](https://github.com/BYVoid/Batsh/releases) or clone with git. 46 | 2. Uncompress source code tarball. 47 | 3. `make` 48 | 4. `make install` 49 | 5. Run: `batsh` 50 | 51 | #### Dependencies 52 | 53 | If there is any missing dependency, you can install them by running `opam install dune core_kernel ounit dlist cmdliner` 54 | 55 | * [dune](https://dune.build/): Build framework. 56 | * [core_kernel](https://github.com/janestreet/core_kernel/): Core_kernel is the system-independent part of Core, Jane Street's industrial-strength alternative to the OCaml standard library. 57 | * [ounit](http://ounit.forge.ocamlcore.org/): Unit test framework. 58 | * [dlist](https://github.com/BYVoid/Dlist): A purely functional list-like data structure supporting O(1) concatenation. 59 | * [cmdliner](http://erratique.ch/software/cmdliner): Command line interfaces parser. 60 | 61 | ## Syntax 62 | 63 | The syntax of Batsh is [C-based](https://en.wikipedia.org/wiki/List_of_C-based_programming_languages) (derived from C programming language). 64 | If you have learned C, Java, C++ or JavaScript, Batsh is quite easy for you. 65 | 66 | ### Assignment 67 | 68 | ```javascript 69 | a = 1; 70 | b = "string"; 71 | c = [1, 2, "str", true, false]; 72 | ``` 73 | 74 | ### Expression 75 | 76 | ```javascript 77 | a = 1 + 2; 78 | b = a * 7; 79 | c = "Con" ++ "cat"; 80 | d = c ++ b; 81 | ``` 82 | 83 | ### Command 84 | 85 | ```javascript 86 | // On UNIX 87 | output = ls(); 88 | // On Windows 89 | output = dir(); 90 | // Platform independent 91 | output = readdir(); 92 | 93 | // Test existence 94 | ex = exists("file.txt"); 95 | ``` 96 | 97 | ### If condition 98 | 99 | ```javascript 100 | a = 3; 101 | if (a > 2) { 102 | println("Yes"); 103 | } else { 104 | println("No"); 105 | } 106 | ``` 107 | 108 | ### Loop 109 | 110 | ```javascript 111 | // Fibonacci 112 | n = 0; 113 | i = 0; 114 | j = 1; 115 | while (n < 60) { 116 | k = i + j; 117 | i = j; 118 | j = k; 119 | n = n + 1; 120 | println(k); 121 | } 122 | ``` 123 | 124 | ### Function 125 | 126 | ```javascript 127 | v1 = "Global V1"; 128 | v2 = "Global V2"; 129 | function func(p) { 130 | v1 = "Local " ++ p; 131 | global v2; 132 | v2 = "V2 Modified."; 133 | } 134 | func("Var"); 135 | ``` 136 | 137 | ### Recursion 138 | 139 | ```javascript 140 | function fibonacci(num) { 141 | if (num == 0) { 142 | return 0; 143 | } else if (num == 1) { 144 | return 1; 145 | } else { 146 | return (fibonacci(num - 2) + fibonacci(num - 1)); 147 | } 148 | } 149 | println(fibonacci(8)); 150 | ``` 151 | 152 | ### [More examples](https://github.com/BYVoid/Batsh/tree/master/test_scripts) 153 | 154 | ### Syntax Highlighting 155 | 156 | #### Vim 157 | 158 | * [vim-Batsh](https://github.com/vuryleo/vim-Batsh) 159 | 160 | #### Emacs 161 | 162 | * [batsh-mode](https://github.com/thechampagne/batsh-mode) 163 | 164 | ## Built-in functions 165 | 166 | In order to make script cross-platform, Batsh provided some "built-in" functions that will compile to platform-dependent code. It is assumed that Bash script runs on Linux or Mac OS and Batch script runs on Windows (XP or higher), which means Cygwin or wine are not supported. 167 | 168 | ### `print(text, ...)` 169 | 170 | Prints a text string to console without a newline. 171 | 172 | ### `println(text, ...)` 173 | 174 | Prints a text string to console with a new line (LF for bash, CRLF for batch). 175 | 176 | ### `call(path, arg, ...)` 177 | 178 | Runs command from path through shell. 179 | 180 | ### `bash(rawStatement)` 181 | 182 | Put `rawStatement` into compiled code for Bash. Ignore for Windows Batch. 183 | 184 | ### `batch(rawStatement)` 185 | 186 | Put `rawStatement` into compiled code for Windows Batch. Ignore for Bash. 187 | 188 | ### `readdir(path)` 189 | 190 | Equals to `ls` and `dir /w`. 191 | 192 | ### `exists(path)` 193 | 194 | Test existence of given path. 195 | 196 | ## Command Line Usage 197 | 198 | ``` 199 | NAME 200 | batsh - A language that compiles to Bash and Windows Batch 201 | 202 | SYNOPSIS 203 | batsh COMMAND ... 204 | 205 | COMMANDS 206 | bash 207 | Compile to Bash script. 208 | 209 | batsh 210 | Format source file. 211 | 212 | winbat 213 | Compile to Windows Batch script. 214 | 215 | OPTIONS 216 | --help[=FMT] (default=pager) 217 | Show this help in format FMT (pager, plain or groff). 218 | 219 | --version 220 | Show version information. 221 | ``` 222 | 223 | ## Why not Python/Ruby/Node.js/Lua 224 | 225 | Yes you can use any of them as platform-independent glue code. But there are several disadvantages: 226 | 227 | 1. None of them is **preinstalled on all platforms** (including Windows). 228 | 2. Functionalities like process piping are not convenient to use. 229 | 3. Hard to integrate with existing code written in Bash or Batch. 230 | 231 | Those reasons are why I developed Batsh. 232 | 233 | ## License 234 | 235 | [MIT](http://opensource.org/licenses/MIT) 236 | 237 | ## Contributors 238 | 239 | * [Carbo Kuo](https://github.com/BYVoid) 240 | * [Song Zhang](http://www.linkedin.com/pub/song-zhang/76/632/b51) 241 | * [Anthony Chan](https://github.com/anthonyhchan) 242 | * [jeb-de](https://github.com/jeb-de) 243 | * [Al Ramirez](https://github.com/mirez) 244 | * [Nixola](https://github.com/Nixola) 245 | * [Darren Ldl](https://github.com/darrenldl) 246 | * [Anton Kochkov](https://github.com/XVilka) 247 | -------------------------------------------------------------------------------- /batsh.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "byvoid@byvoid.com" 3 | authors: ["BYVoid "] 4 | homepage: "https://github.com/BYVoid/Batsh" 5 | bug-reports: "https://github.com/BYVoid/Batsh/issues" 6 | license: "MIT" 7 | build: [ 8 | ["dune" "build" "-p" name "-j" jobs] 9 | ] 10 | depends: [ 11 | "ocaml" {>= "4.04.1"} 12 | "core" {>= "0.12"} 13 | "core_kernel" {>= "0.12"} 14 | "dlist" {>= "0.0.3"} 15 | "cmdliner" {>= "0.9.2"} 16 | ] 17 | depopts: ["ounit"] 18 | dev-repo: "git://github.com/BYVoid/Batsh" 19 | install: ["dune" "install"] 20 | synopsis: 21 | "A (C-like syntax) programming language that compiles to Bash and Windows Batch" 22 | description: """ 23 | Batsh enables you to write code once runs on all platforms without any additional dependency 24 | 25 | Documentation: https://github.com/BYVoid/Batsh 26 | 27 | Online demo: http://batsh.org/ 28 | """ 29 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.11) 2 | (using menhir 2.0) 3 | -------------------------------------------------------------------------------- /lib/bash.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | batsh : Parser.t; 3 | bash_ast : Bash_ast.t; 4 | bash_ast_expanded : Bash_ast.t; 5 | } 6 | 7 | let compile (batsh : Parser.t) : t = 8 | let bash_ast = Bash_compile.compile batsh in 9 | let bash_ast_expanded = Bash_functions.expand bash_ast in 10 | {batsh; bash_ast; bash_ast_expanded} 11 | 12 | let print (bash : t) : string = 13 | let buf = Buffer.create 1024 in 14 | Bash_format.print buf bash.bash_ast_expanded; 15 | Buffer.contents buf 16 | 17 | let ast ?(expand_functions=true) (bash : t) : Bash_ast.t = 18 | if expand_functions then 19 | bash.bash_ast_expanded 20 | else 21 | bash.bash_ast 22 | -------------------------------------------------------------------------------- /lib/bash.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val compile : Parser.t -> t 4 | val print : t -> string 5 | val ast : ?expand_functions:bool -> t -> Bash_ast.t 6 | -------------------------------------------------------------------------------- /lib/bash_ast.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type identifier = string 4 | 5 | and identifiers = identifier list 6 | 7 | and leftvalue = 8 | | Identifier of identifier 9 | | ListAccess of (leftvalue * arithmetic) 10 | | EntireList of leftvalue 11 | | Cardinal of leftvalue 12 | 13 | and arithmetic = 14 | | Leftvalue of leftvalue 15 | | Int of int 16 | | Float of float 17 | | ArithUnary of (string * arithmetic) 18 | | ArithBinary of (string * arithmetic * arithmetic) 19 | 20 | and expression = 21 | | Variable of leftvalue 22 | | String of string 23 | | Result of arithmetic 24 | | StrBinary of (string * expression * expression) 25 | | TestUnary of (string * expression) 26 | | Command of (expression * expressions) 27 | | List of expressions 28 | | Raw of string 29 | 30 | and expressions = expression list 31 | 32 | and statement = 33 | | Comment of string 34 | | Local of identifier 35 | | Assignment of (leftvalue * expression) 36 | | Expression of expression 37 | | If of (expression * statement) 38 | | IfElse of (expression * statement * statement) 39 | | While of (expression * statement) 40 | | Block of statements 41 | | Return 42 | | Empty 43 | 44 | and statements = statement list 45 | 46 | and toplevel = 47 | | Statement of statement 48 | | Function of (identifier * statements) 49 | 50 | and t = toplevel list 51 | [@@deriving sexp] 52 | -------------------------------------------------------------------------------- /lib/bash_compile.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Bash_ast 3 | 4 | module BAST = Batsh_ast 5 | 6 | let is_arith (expr: BAST.expression) :bool = 7 | match expr with 8 | | BAST.String _ 9 | | BAST.List _ 10 | | BAST.StrCompare _ 11 | | BAST.Concat _ 12 | | BAST.Call _ -> 13 | false 14 | | BAST.Bool _ 15 | | BAST.Int _ 16 | | BAST.Float _ 17 | | BAST.Leftvalue _ 18 | | BAST.ArithUnary _ 19 | | BAST.ArithBinary _ -> 20 | true 21 | 22 | let is_leftvalue (expr : BAST.expression) : bool = 23 | match expr with 24 | | BAST.Leftvalue _ -> true 25 | | _ -> false 26 | 27 | let rec compile_expr_to_arith 28 | (expr: BAST.expression) 29 | ~(symtable: Symbol_table.t) 30 | ~(scope: Symbol_table.Scope.t) 31 | :arithmetic = 32 | let compile_expr_to_arith = compile_expr_to_arith ~symtable ~scope in 33 | match expr with 34 | | BAST.Bool false -> Int 0 35 | | BAST.Bool true -> Int 1 36 | | BAST.Int number -> Int number 37 | | BAST.Float number -> Float number 38 | | BAST.Leftvalue lvalue -> 39 | Leftvalue (compile_leftvalue lvalue ~symtable ~scope) 40 | | BAST.ArithUnary (operator, expr) -> 41 | ArithUnary (operator, compile_expr_to_arith expr) 42 | | BAST.ArithBinary (operator, left, right) -> 43 | ArithBinary (operator, 44 | compile_expr_to_arith left, 45 | compile_expr_to_arith right) 46 | | BAST.String _ 47 | | BAST.List _ 48 | | BAST.StrCompare _ 49 | | BAST.Concat _ 50 | | BAST.Call _ -> 51 | assert false 52 | 53 | and compile_expr 54 | (expr: BAST.expression) 55 | ~(symtable: Symbol_table.t) 56 | ~(scope: Symbol_table.Scope.t) 57 | : expression = 58 | if is_arith expr && not (is_leftvalue expr) then 59 | Result (compile_expr_to_arith expr ~symtable ~scope) 60 | else 61 | let compile_expr = compile_expr ~symtable ~scope in 62 | match expr with 63 | | BAST.Bool false -> String "false" 64 | | BAST.Bool true -> String "true" 65 | | BAST.Int number -> String (string_of_int number) 66 | | BAST.Float number -> String (Float.to_string number) 67 | | BAST.String str -> String str 68 | | BAST.Leftvalue lvalue -> 69 | Variable (compile_leftvalue lvalue ~symtable ~scope) 70 | | BAST.StrCompare (operator, left, right) -> 71 | StrBinary (operator, 72 | compile_expr left, 73 | compile_expr right) 74 | | BAST.Concat (left, right) -> 75 | StrBinary ("++", 76 | compile_expr left, 77 | compile_expr right) 78 | | BAST.Call (ident, exprs) -> 79 | compile_call (ident, exprs) ~symtable ~scope 80 | | BAST.List exprs -> 81 | List (List.map exprs ~f: compile_expr) 82 | | BAST.ArithUnary _ 83 | | BAST.ArithBinary _ -> 84 | assert false 85 | 86 | and compile_call 87 | (ident, exprs) 88 | ~(symtable: Symbol_table.t) 89 | ~(scope: Symbol_table.Scope.t) 90 | : expression = 91 | match ident with 92 | | "exists" -> 93 | let params_1 params = 94 | match params with 95 | | param :: _ -> param 96 | | _ -> failwith ("exists must have only 1 parameter.") 97 | in 98 | let param = compile_expr (params_1 exprs) ~symtable ~scope in 99 | TestUnary ("-e", param) 100 | | _ -> 101 | let params = List.map exprs ~f: (compile_expr ~symtable ~scope) in 102 | Command (String ident, params) 103 | 104 | and compile_leftvalue 105 | (lvalue: BAST.leftvalue) 106 | ~(symtable: Symbol_table.t) 107 | ~(scope: Symbol_table.Scope.t) 108 | :leftvalue = 109 | match lvalue with 110 | | BAST.Identifier ident -> 111 | Identifier ident 112 | | BAST.ListAccess (lvalue, expr) -> 113 | ListAccess (compile_leftvalue lvalue ~symtable ~scope, 114 | compile_expr_to_arith expr ~symtable ~scope) 115 | 116 | let rec compile_statement 117 | (stmt: BAST.statement) 118 | ~(symtable: Symbol_table.t) 119 | ~(scope: Symbol_table.Scope.t) 120 | :statement = 121 | match stmt with 122 | | BAST.Comment comment -> 123 | Comment comment 124 | | BAST.Assignment assignment -> 125 | compile_assignment assignment ~symtable ~scope 126 | | BAST.Expression expr -> 127 | Expression (compile_expr expr ~symtable ~scope) 128 | | BAST.If (expr, stmt) -> 129 | compile_if_statement expr stmt ~symtable ~scope 130 | | BAST.IfElse (expr, thenStmt, elseStmt) -> 131 | compile_if_else_statement expr thenStmt elseStmt ~symtable ~scope 132 | | BAST.While (expr, stmt) -> 133 | compile_while_statement expr stmt ~symtable ~scope 134 | | BAST.Block stmts -> 135 | Block (List.map stmts ~f: (compile_statement ~symtable ~scope)) 136 | | BAST.Global _ -> 137 | Empty 138 | | BAST.Return (Some expr) -> 139 | let call_stmt = BAST.Expression (BAST.Call ("print", [expr])) in 140 | Block [compile_statement call_stmt ~symtable ~scope; Return] 141 | | BAST.Return None -> 142 | Return 143 | | BAST.Empty -> 144 | Empty 145 | 146 | and compile_assignment 147 | (lvalue, expr) 148 | ~(symtable: Symbol_table.t) 149 | ~(scope: Symbol_table.Scope.t) 150 | : statement = 151 | let lvalue = compile_leftvalue lvalue ~symtable ~scope in 152 | let expr_compiled = compile_expr expr ~symtable ~scope in 153 | let split_test (test_stmt : statement) : statement = 154 | let assignment = Assignment 155 | (lvalue, 156 | Result ( 157 | ArithUnary ("!", 158 | Leftvalue (Identifier "?")))) 159 | in 160 | Block [test_stmt; assignment] 161 | in 162 | match expr with 163 | | BAST.StrCompare _ -> 164 | let test_stmt = Expression expr_compiled in 165 | split_test test_stmt 166 | | BAST.Call (("exists", _) as call) -> 167 | let test_expr = compile_call call ~symtable ~scope in 168 | split_test (Expression test_expr) 169 | | _ -> 170 | Assignment (lvalue, expr_compiled) 171 | 172 | and compile_if_statement 173 | (expr: BAST.expression) 174 | stmt 175 | ~(symtable: Symbol_table.t) 176 | ~(scope: Symbol_table.Scope.t) 177 | :statement = 178 | If (compile_expr expr ~symtable ~scope, 179 | compile_statement stmt ~symtable ~scope) 180 | 181 | and compile_if_else_statement 182 | (expr: BAST.expression) 183 | (thenStmt: BAST.statement) 184 | (elseStmt: BAST.statement) 185 | ~(symtable: Symbol_table.t) 186 | ~(scope: Symbol_table.Scope.t) 187 | :statement = 188 | IfElse (compile_expr expr ~symtable ~scope, 189 | compile_statement thenStmt ~symtable ~scope, 190 | compile_statement elseStmt ~symtable ~scope) 191 | 192 | and compile_while_statement 193 | (expr: BAST.expression) 194 | stmt 195 | ~(symtable: Symbol_table.t) 196 | ~(scope: Symbol_table.Scope.t) 197 | :statement = 198 | While (compile_expr expr ~symtable ~scope, 199 | compile_statement stmt ~symtable ~scope) 200 | 201 | let compile_statements 202 | (stmts: BAST.statements) 203 | ~(symtable: Symbol_table.t) 204 | ~(scope: Symbol_table.Scope.t) 205 | :statements = 206 | List.map stmts ~f: (compile_statement ~symtable ~scope) 207 | 208 | let compile_function 209 | (name, params, stmts) 210 | ~(symtable: Symbol_table.t) 211 | :toplevel = 212 | let scope = Symbol_table.scope symtable name in 213 | let body = compile_statements stmts ~symtable ~scope in 214 | let locals = Symbol_table.Scope.fold scope 215 | ~init: [] 216 | ~f: (fun ident global acc -> 217 | if global then 218 | acc 219 | else 220 | (Local ident) :: acc 221 | ) 222 | in 223 | let param_defines = List.mapi params ~f: (fun i param -> 224 | Assignment (Identifier param, 225 | Variable (Identifier (string_of_int (i + 1)))) 226 | ) 227 | in 228 | Function (name, List.concat [locals; param_defines; body]) 229 | 230 | let compile_toplevel 231 | ~(symtable: Symbol_table.t) 232 | (topl: BAST.toplevel) 233 | :toplevel = 234 | match topl with 235 | | BAST.Statement stmt -> 236 | Statement (compile_statement stmt ~symtable 237 | ~scope: (Symbol_table.global_scope symtable)) 238 | | BAST.Function func -> 239 | compile_function func ~symtable 240 | 241 | let compile (batsh : Parser.t) : t = 242 | let symtable = Parser.symtable batsh in 243 | let program = Bash_transform.split (Parser.ast batsh) ~symtable in 244 | List.map program ~f: (compile_toplevel ~symtable) 245 | -------------------------------------------------------------------------------- /lib/bash_format.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Bash_ast 3 | 4 | let rec print_lvalue_partial (buf : Buffer.t) (lvalue : leftvalue) = 5 | match lvalue with 6 | | Identifier ident -> 7 | Buffer.add_string buf ident 8 | | ListAccess (lvalue, arith) -> 9 | bprintf buf "%a[%a]" 10 | print_lvalue_partial lvalue 11 | (print_arith ~paren:false) arith 12 | | EntireList lvalue -> 13 | bprintf buf "%a[@]" print_lvalue_partial lvalue 14 | | Cardinal lvalue -> 15 | bprintf buf "#%a" print_lvalue_partial lvalue 16 | 17 | and print_lvalue (buf : Buffer.t) (lvalue : leftvalue) ~(quote : bool) = 18 | let quote = if quote then "\"" else "" in 19 | match lvalue with 20 | | Identifier _ident -> 21 | bprintf buf "%s$%a%s" quote print_lvalue_partial lvalue quote 22 | | ListAccess _ 23 | | EntireList _ 24 | | Cardinal _ -> 25 | bprintf buf "%s${%a}%s" quote print_lvalue_partial lvalue quote 26 | 27 | and print_arith 28 | ?(paren = true) 29 | (buf : Buffer.t) 30 | (expr: arithmetic) 31 | = 32 | match expr with 33 | | Leftvalue lvalue -> print_lvalue buf lvalue ~quote:false 34 | | Int number -> Buffer.add_string buf (string_of_int number) 35 | | Float number -> Buffer.add_string buf (Float.to_string number) 36 | | ArithUnary (operator, arith) -> 37 | if paren then 38 | bprintf buf "%s(%a)" operator (print_arith ~paren:true) arith 39 | else 40 | bprintf buf "%s%a" operator (print_arith ~paren:true) arith 41 | | ArithBinary binary -> 42 | if paren then 43 | bprintf buf "(%a)" print_arith_binary binary 44 | else 45 | print_arith_binary buf binary 46 | 47 | and print_arith_binary 48 | (buf : Buffer.t) 49 | (operator, left, right) 50 | = 51 | let operator = match operator with 52 | | "===" -> "==" 53 | | "!==" -> "!=" 54 | | _ -> operator 55 | in 56 | bprintf buf "%a %s %a" 57 | (print_arith ~paren:true) left 58 | operator 59 | (print_arith ~paren:true) right 60 | 61 | let rec print_expression buf (expr: expression) = 62 | match expr with 63 | | Variable lvalue | Result Leftvalue lvalue -> 64 | print_lvalue buf lvalue ~quote:true 65 | | String str -> 66 | bprintf buf "\"%s\"" (Formatutil.escape str) 67 | | Result arith -> 68 | bprintf buf "$((%a))" (print_arith ~paren:false) arith 69 | | StrBinary binary -> 70 | print_str_binary buf binary 71 | | TestUnary test -> 72 | print_test_unary buf test 73 | | Command cmd -> 74 | bprintf buf "$(%a)" print_command cmd 75 | | List exprs -> 76 | Buffer.add_string buf "("; 77 | let num_exprs = List.length exprs in 78 | List.iteri exprs ~f: (fun i expr -> 79 | print_expression buf expr; 80 | if i <> num_exprs - 1 then 81 | Buffer.add_string buf " " 82 | ); 83 | Buffer.add_string buf ")" 84 | | Raw str -> 85 | Buffer.add_string buf str 86 | 87 | and print_str_binary (buf: Buffer.t) (operator, left, right) = 88 | match operator with 89 | | "++" -> 90 | bprintf buf "%a%a" print_expression left print_expression right 91 | | "==" -> 92 | bprintf buf "[ %a == %a ]" print_expression left print_expression right 93 | | "!=" -> 94 | bprintf buf "[ %a != %a ]" print_expression left print_expression right 95 | | _ -> 96 | failwith ("Unknown operator: " ^ operator) 97 | 98 | and print_test_unary (buf: Buffer.t) (operator, expr) = 99 | bprintf buf "[ %s %a ]" operator print_expression expr 100 | 101 | and print_command (buf: Buffer.t) (name, params) = 102 | bprintf buf "%a %a" 103 | print_expression name 104 | (Formatutil.print_separate_list ~f: print_expression ~separator: " ") params 105 | 106 | let rec print_statement buf (stmt: statement) ~(indent: int) = 107 | let () = match stmt with 108 | | Block _ -> () 109 | | _ -> 110 | Formatutil.print_indent buf indent in 111 | match stmt with 112 | | Comment comment -> 113 | bprintf buf "#%s" comment 114 | | Local ident -> 115 | bprintf buf "local %s" ident 116 | | Assignment (lvalue, expr) -> 117 | bprintf buf "%a=%a" 118 | print_lvalue_partial lvalue 119 | print_expression expr 120 | | Expression (Command cmd) -> 121 | print_command buf cmd 122 | | Expression expr -> 123 | print_expression buf expr 124 | | If (expr, stmts) -> 125 | print_if buf expr stmts ~indent 126 | | IfElse (expr, then_stmts, else_stmts) -> 127 | print_if_else buf expr then_stmts else_stmts ~indent 128 | | While (expr, stmts) -> 129 | print_while buf expr stmts ~indent 130 | | Block [] -> 131 | Buffer.add_string buf "-" 132 | | Block stmts -> 133 | print_statements buf stmts ~indent 134 | | Return -> 135 | Buffer.add_string buf "return" 136 | | Empty -> () 137 | 138 | and print_condition (buf : Buffer.t) (expr : expression) = 139 | match expr with 140 | | StrBinary (("==", _, _) as bin) 141 | | StrBinary (("!=", _, _) as bin) -> 142 | print_str_binary buf bin 143 | | TestUnary test -> 144 | print_test_unary buf test 145 | | _ -> 146 | bprintf buf "[ %a == 1 ]" print_expression expr 147 | 148 | and print_if_while 149 | (buf: Buffer.t) 150 | (expr: expression) 151 | (stmt: statement) 152 | (first: string) 153 | (second: string) 154 | (third: string) 155 | ~(indent: int) = 156 | let print_statement_indented = print_statement ~indent: (indent + 2) in 157 | bprintf buf "%s %a; %s\n%a%a\n%s" 158 | first (* if/while *) 159 | print_condition expr 160 | second (* then/do *) 161 | print_statement_indented stmt 162 | Formatutil.print_indent indent 163 | third (* fi/done *) 164 | 165 | and print_if buf (expr: expression) (stmt: statement) ~(indent: int) = 166 | print_if_while buf expr stmt "if" "then" "fi" ~indent 167 | 168 | and print_if_else 169 | (buf: Buffer.t) 170 | (expr: expression) 171 | (then_stmt: statement) 172 | (else_stmt: statement) 173 | ~(indent: int) = 174 | let print_statement_indented = print_statement ~indent: (indent + 2) in 175 | bprintf buf "if %a; then\n%a\n%aelse\n%a\n%afi" 176 | print_condition expr 177 | print_statement_indented then_stmt 178 | Formatutil.print_indent indent 179 | print_statement_indented else_stmt 180 | Formatutil.print_indent indent 181 | 182 | and print_while buf (expr: expression) (stmt: statement) ~(indent: int) = 183 | print_if_while buf expr stmt "while" "do" "done" ~indent 184 | 185 | and print_statements: Buffer.t -> statements -> indent:int -> unit = 186 | Formatutil.print_statements ~f: print_statement 187 | 188 | let print_function (buf: Buffer.t) (name, stmts) = 189 | bprintf buf "function %s {\n%a\n}" 190 | name 191 | (print_statements ~indent: 2) stmts 192 | 193 | let print_toplevel (buf: Buffer.t) (topl: toplevel) ~indent = 194 | match topl with 195 | | Statement stmt -> print_statement buf stmt ~indent 196 | | Function func -> print_function buf func 197 | 198 | let print (buf: Buffer.t) (program: t) :unit = 199 | Formatutil.print_statements buf program ~f: print_toplevel ~indent: 0 200 | -------------------------------------------------------------------------------- /lib/bash_functions.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Bash_ast 3 | 4 | let rec expand_leftvalue (lvalue : leftvalue) : leftvalue = 5 | match lvalue with 6 | | Identifier _ | EntireList _ | Cardinal _ -> 7 | lvalue 8 | | ListAccess (lvalue, arith) -> 9 | ListAccess (expand_leftvalue lvalue, arith) 10 | 11 | let rec expand_expression (expr : expression) : expression = 12 | match expr with 13 | | Variable lvalue -> 14 | Variable (expand_leftvalue lvalue) 15 | | StrBinary (operator, left, right) -> 16 | StrBinary (operator, expand_expression left, expand_expression right) 17 | | Command (name, exprs) -> 18 | expand_command name exprs 19 | | List (exprs) -> 20 | List (expand_expressions exprs) 21 | | String _ | Result _ | Raw _ | TestUnary _ -> expr 22 | 23 | and expand_expressions (exprs : expressions) : expressions = 24 | List.map exprs ~f: expand_expression 25 | 26 | and expand_command (name : expression) (exprs : expressions) = 27 | let exprs = expand_expressions exprs in 28 | match name with 29 | | String "bash" -> ( 30 | match exprs with 31 | | [String raw] -> 32 | Raw raw 33 | | _ -> 34 | failwith "bash raw command must have 1 argument of string literal." 35 | ) 36 | | String "batch" -> 37 | failwith "batch raw command can not be a part of expression." 38 | | String "println" -> 39 | Command (String "echo", (String "-e") :: exprs) 40 | | String "print" -> 41 | Command (String "echo", (String "-ne") :: exprs) 42 | | String "call" -> ( 43 | match exprs with 44 | | cmd :: args -> 45 | expand_command cmd args 46 | | [] -> 47 | failwith "call must have at least 1 argument." 48 | ) 49 | | String "len" -> ( 50 | match exprs with 51 | | [Variable lvalue] | [Result (Leftvalue lvalue)] -> 52 | Variable (Cardinal (EntireList lvalue)) 53 | | _ -> 54 | failwith "len must have exactly 1 argument." 55 | ) 56 | | String "readdir" -> 57 | Command (String "ls", exprs) 58 | | _ -> 59 | Command (name, exprs) 60 | 61 | let rec expand_statement (stmt : statement) : statement = 62 | match stmt with 63 | | Assignment (lvalue, expr) -> 64 | Assignment (expand_leftvalue lvalue, expand_expression expr) 65 | | Expression (Command (String "batch", _)) -> 66 | Empty 67 | | Expression expr -> 68 | Expression (expand_expression expr) 69 | | If (expr, stmt) -> 70 | If (expand_expression expr, expand_statement stmt) 71 | | IfElse (expr, then_stmt, else_stmt) -> 72 | IfElse (expand_expression expr, 73 | expand_statement then_stmt, 74 | expand_statement else_stmt) 75 | | While (expr, stmt) -> 76 | While (expand_expression expr, expand_statement stmt) 77 | | Block stmts -> 78 | Block (expand_statements stmts) 79 | | Comment _ | Local _ | Empty | Return -> stmt 80 | 81 | and expand_statements (stmts: statements) : statements = 82 | List.map stmts ~f: expand_statement 83 | 84 | let expand_function ((name : identifier), (stmts : statements)) 85 | : (identifier * statements) = 86 | (name, expand_statements stmts) 87 | 88 | let expand_toplevel (topl : toplevel) : toplevel = 89 | match topl with 90 | | Statement stmt -> 91 | Statement (expand_statement stmt) 92 | | Function func -> 93 | Function (expand_function func) 94 | 95 | let expand (ast : t) : t = 96 | List.map ast ~f: expand_toplevel 97 | -------------------------------------------------------------------------------- /lib/bash_transform.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Batsh_ast 3 | 4 | let rec split_expression 5 | ?(split_string = false) 6 | ?(split_list = true) 7 | ?(split_strcmp = true) 8 | (expr : expression) 9 | ~(symtable : Symbol_table.t) 10 | ~(scope : Symbol_table.Scope.t) 11 | : (statement Dlist.t * expression) = 12 | let split_binary ?(split_string = false) (left, right) = 13 | let assignments_left, left = split_expression left 14 | ~split_string ~symtable ~scope 15 | in 16 | let assignments_right, right = split_expression right 17 | ~split_string ~symtable ~scope 18 | in 19 | (Dlist.append assignments_left assignments_right), (left, right) 20 | in 21 | let split_when ~cond current_assignments new_expr = 22 | let split_expr_to_assignment assignments expr 23 | : (statement Dlist.t * expression) = 24 | let ident = Symbol_table.Scope.add_temporary_variable scope in 25 | let variable = Identifier ident in 26 | let assignments = Dlist.append 27 | assignments 28 | (Dlist.of_list [Assignment (variable, expr)]) 29 | in 30 | assignments, (Leftvalue variable) 31 | in 32 | if cond then 33 | split_expr_to_assignment current_assignments new_expr 34 | else 35 | current_assignments, new_expr 36 | in 37 | match expr with 38 | | Bool _ | Int _ | Float _ | Leftvalue _ -> 39 | Dlist.empty () , expr 40 | | ArithUnary (operator, expr) -> 41 | let assignments, expr = split_expression expr 42 | ~split_string:true ~symtable ~scope 43 | in 44 | assignments, ArithUnary (operator, expr) 45 | | ArithBinary (operator, left, right) -> 46 | let assignments, (left, right) = split_binary (left, right) 47 | ~split_string:true 48 | in 49 | assignments, ArithBinary (operator, left, right) 50 | | String str -> 51 | split_when ~cond:split_string (Dlist.empty ()) (String str) 52 | | Concat (left, right) -> 53 | let assignments, (left, right) = split_binary (left, right) in 54 | split_when ~cond:split_string assignments (Concat (left, right)) 55 | | StrCompare (operator, left, right) -> 56 | let assignments, (left, right) = split_binary (left, right) in 57 | split_when ~cond:split_strcmp assignments (StrCompare (operator, left, right)) 58 | | Call (ident, exprs) -> 59 | let assignments, exprs = split_expressions exprs ~symtable ~scope in 60 | split_when ~cond:split_string assignments (Call (ident, exprs)) 61 | | List exprs -> 62 | let assignments, exprs = split_expressions exprs ~symtable ~scope in 63 | split_when ~cond:split_list assignments (List exprs) 64 | 65 | and split_expressions 66 | (exprs : expressions) 67 | ~(symtable : Symbol_table.t) 68 | ~(scope : Symbol_table.Scope.t) 69 | : (statement Dlist.t * expressions) = 70 | let assignments, exprs = List.fold exprs ~init: (Dlist.empty (), []) 71 | ~f: (fun (assignments_acc, exprs_acc) expr -> 72 | let assignments, expr = split_expression expr ~symtable ~scope in 73 | (Dlist.append assignments assignments_acc, expr :: exprs_acc) 74 | ) 75 | in 76 | assignments, List.rev exprs 77 | 78 | let rec split_statement 79 | (stmt : statement) 80 | ~(symtable : Symbol_table.t) 81 | ~(scope : Symbol_table.Scope.t) 82 | : statement = 83 | let prepend_assignments (assignments : statement Dlist.t) stmt : statement = 84 | if Dlist.length assignments = 0 then 85 | stmt 86 | else 87 | Block (Dlist.to_list (Dlist.append assignments (Dlist.of_list [stmt]))) 88 | in 89 | match stmt with 90 | | Empty | Global _ | Comment _ | Return None -> 91 | stmt 92 | | Expression expr -> 93 | let assignments, expr = split_expression expr 94 | ~split_list:false ~symtable ~scope 95 | in 96 | prepend_assignments assignments (Expression expr) 97 | | Assignment (lvalue, expr) -> 98 | let assignments, expr = split_expression expr 99 | ~split_list:false ~split_strcmp:false ~symtable ~scope 100 | in 101 | prepend_assignments assignments (Assignment (lvalue, expr)) 102 | | If (expr, stmt) -> 103 | let assignments, expr = split_expression expr 104 | ~split_strcmp:false ~symtable ~scope 105 | in 106 | let stmt = split_statement stmt ~symtable ~scope in 107 | prepend_assignments assignments (If (expr, stmt)) 108 | | IfElse (expr, then_stmt, else_stmt) -> 109 | let assignments, expr = split_expression expr 110 | ~split_strcmp:false ~symtable ~scope 111 | in 112 | let then_stmt = split_statement then_stmt ~symtable ~scope in 113 | let else_stmt = split_statement else_stmt ~symtable ~scope in 114 | prepend_assignments assignments (IfElse (expr, then_stmt, else_stmt)) 115 | | While (expr, stmt) -> 116 | let assignments, expr = split_expression expr 117 | ~split_strcmp:false ~symtable ~scope 118 | in 119 | let stmt = split_statement stmt ~symtable ~scope in 120 | prepend_assignments assignments (While (expr, stmt)) 121 | | Block stmts -> 122 | Block (split_statements stmts ~symtable ~scope) 123 | | Return (Some expr) -> 124 | let assignments, expr = split_expression expr ~symtable ~scope in 125 | prepend_assignments assignments (Return (Some expr)) 126 | 127 | and split_statements 128 | (stmts : statements) 129 | ~(symtable : Symbol_table.t) 130 | ~(scope : Symbol_table.Scope.t) 131 | : statements = 132 | List.map stmts ~f: (split_statement ~symtable ~scope) 133 | 134 | let split_function 135 | (name, params, stmts) 136 | ~(symtable : Symbol_table.t) 137 | = 138 | let scope = Symbol_table.scope symtable name in 139 | let body = split_statements stmts ~symtable ~scope in 140 | name, params, body 141 | 142 | let split_toplevel 143 | (topl : toplevel) 144 | ~(symtable : Symbol_table.t) 145 | : toplevel = 146 | match topl with 147 | | Statement stmt -> 148 | Statement (split_statement stmt ~symtable 149 | ~scope: (Symbol_table.global_scope symtable)) 150 | | Function func -> 151 | Function (split_function func ~symtable) 152 | 153 | (* Split arithmetic expressions, list literal and command call *) 154 | let split (ast : Batsh_ast.t) ~(symtable : Symbol_table.t) : Batsh_ast.t = 155 | List.map ast ~f: (split_toplevel ~symtable) 156 | -------------------------------------------------------------------------------- /lib/batsh_ast.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type identifier = string 4 | 5 | and identifiers = identifier list 6 | 7 | and leftvalue = 8 | | Identifier of identifier 9 | | ListAccess of (leftvalue * expression) 10 | 11 | and expression = 12 | | Bool of bool 13 | | Float of float 14 | | Int of int 15 | | List of expressions 16 | | String of string 17 | | Leftvalue of leftvalue 18 | | ArithUnary of (string * expression) 19 | | ArithBinary of (string * expression * expression) 20 | | Concat of (expression * expression) 21 | | StrCompare of (string * expression * expression) 22 | | Call of (identifier * expressions) 23 | 24 | and expressions = expression list 25 | 26 | and statement = 27 | | Comment of string 28 | | Block of statements 29 | | Expression of expression 30 | | Assignment of (leftvalue * expression) 31 | | If of (expression * statement) 32 | | IfElse of (expression * statement * statement) 33 | | While of (expression * statement) 34 | | Global of identifier 35 | | Return of expression option 36 | | Empty 37 | 38 | and statements = statement list 39 | 40 | and toplevel = 41 | | Statement of statement 42 | | Function of (identifier * identifiers * statements) 43 | 44 | and t = toplevel list 45 | [@@deriving sexp] 46 | -------------------------------------------------------------------------------- /lib/batsh_format.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Batsh_ast 3 | 4 | let rec print_lvalue (buf : Buffer.t) (lvalue: leftvalue) = 5 | match lvalue with 6 | | Identifier ident -> 7 | Buffer.add_string buf ident 8 | | ListAccess (lvalue, expr) -> 9 | bprintf buf "%a[%a]" print_lvalue lvalue print_expression expr 10 | 11 | and print_expression (buf : Buffer.t) (expr: expression) = 12 | match expr with 13 | | Leftvalue lvalue -> print_lvalue buf lvalue 14 | | Int number -> Buffer.add_string buf (string_of_int number) 15 | | Float number -> Buffer.add_string buf (Float.to_string number) 16 | | String str -> bprintf buf "\"%s\"" (Formatutil.escape str) 17 | | Bool true -> Buffer.add_string buf "true" 18 | | Bool false -> Buffer.add_string buf "false" 19 | | ArithUnary (operator, expr) -> 20 | bprintf buf "%s(%a)" operator print_expression expr 21 | | ArithBinary binary | StrCompare binary -> 22 | print_binary_expression buf binary 23 | | Concat (left, right) -> 24 | print_binary_expression buf ("++", left, right) 25 | | Call (ident, exprs) -> 26 | bprintf buf "%s(%a)" ident print_expressions exprs 27 | | List exprs -> 28 | bprintf buf "[%a]" print_expressions exprs 29 | 30 | and print_expressions (buf : Buffer.t) (exprs: expression list) = 31 | Formatutil.print_separate_list buf exprs 32 | ~f: print_expression ~separator: ", " 33 | 34 | and print_binary_expression 35 | (buf : Buffer.t) 36 | (operator, left, right) 37 | = 38 | bprintf buf "(%a %s %a)" 39 | print_expression left operator print_expression right 40 | 41 | let rec print_statement (buf : Buffer.t) (stmt: statement) ~(indent: int) = 42 | let () = match stmt with 43 | | Block _ -> () 44 | | _ -> 45 | Formatutil.print_indent buf indent in 46 | match stmt with 47 | | Comment comment -> 48 | bprintf buf "//%s" comment 49 | | Block inner_stmts -> print_block_statement ~indent buf inner_stmts 50 | | Expression expr -> 51 | print_expression buf expr; 52 | Buffer.add_string buf ";" 53 | | Assignment (lvalue, expr) -> 54 | bprintf buf "%a = %a;" print_lvalue lvalue print_expression expr 55 | | If (expr, stmt) -> 56 | print_if_statement buf expr stmt ~indent 57 | | IfElse (expr, thenStmt, elseStmt) -> 58 | print_if_else_statement buf expr thenStmt elseStmt ~indent 59 | | While (expr, stmt) -> 60 | print_while_statement buf expr stmt ~indent 61 | | Global ident -> 62 | bprintf buf "global %s;" ident 63 | | Return (Some expr) -> 64 | bprintf buf "return %a;" print_expression expr 65 | | Return None -> 66 | bprintf buf "return;" 67 | | Empty -> () 68 | 69 | and print_statements = Formatutil.print_statements ~f: print_statement 70 | 71 | and print_block_statement 72 | (buf : Buffer.t) 73 | (inner_stmts : statements) 74 | ~(indent : int) 75 | = 76 | let print_statements_indented = print_statements ~indent:(indent + 2) in 77 | bprintf buf "{\n%a\n%a}" 78 | print_statements_indented inner_stmts 79 | Formatutil.print_indent indent 80 | 81 | and print_if_while_statement 82 | (buf : Buffer.t) 83 | (name : string) 84 | (expr : expression) 85 | (stmt : statement) 86 | ~(indent : int) 87 | = 88 | bprintf buf "%s (%a) " name print_expression expr; 89 | print_statement buf stmt ~indent 90 | 91 | and print_if_statement 92 | (buf : Buffer.t) 93 | (expr: expression) 94 | (stmt: statement) 95 | ~(indent: int) 96 | = 97 | print_if_while_statement buf "if" expr stmt ~indent 98 | 99 | and print_if_else_statement 100 | (buf : Buffer.t) 101 | (expr: expression) 102 | (thenStmt: statement) 103 | (elseStmt: statement) 104 | ~(indent: int) 105 | = 106 | print_if_statement buf expr thenStmt ~indent; 107 | Buffer.add_string buf " else "; 108 | print_statement buf elseStmt ~indent 109 | 110 | and print_while_statement 111 | (buf : Buffer.t) 112 | (expr: expression) 113 | (stmt: statement) 114 | ~(indent: int) 115 | = 116 | print_if_while_statement buf "while" expr stmt ~indent 117 | 118 | let print_params (buf : Buffer.t) (params: identifiers) = 119 | Formatutil.print_separate_list buf params ~f: Buffer.add_string ~separator: ", " 120 | 121 | let print_function (buf : Buffer.t) (name, params, stmts) = 122 | bprintf buf "function %s (%a) {\n%a\n}" 123 | name 124 | print_params params 125 | (print_statements ~indent: 2) stmts 126 | 127 | let print_toplevel (buf : Buffer.t) (topl: toplevel) ~indent = 128 | match topl with 129 | | Statement stmt -> 130 | print_statement buf stmt ~indent 131 | | Function func -> 132 | print_function buf func 133 | 134 | let print_ast (buf : Buffer.t) (ast: t) = 135 | Formatutil.print_statements buf ast ~f: print_toplevel ~indent: 0 136 | -------------------------------------------------------------------------------- /lib/batsh_lib.ml: -------------------------------------------------------------------------------- 1 | module Bash_ast = Bash_ast 2 | 3 | module Bash = Bash 4 | 5 | module Batsh_ast = Batsh_ast 6 | 7 | module Errors = Errors 8 | 9 | module Parser = Parser 10 | 11 | module Symbol_table = Symbol_table 12 | 13 | module Winbat_ast = Winbat_ast 14 | 15 | module Winbat = Winbat 16 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name batsh_lib) 3 | (flags (-w "+a-4-9-29-37-40-42-44-48-50-32")) 4 | (libraries core_kernel 5 | dlist) 6 | (preprocess (pps ppx_sexp_conv)) 7 | ) 8 | 9 | (ocamllex lexer) 10 | 11 | (menhir (modules parser_yacc)) 12 | -------------------------------------------------------------------------------- /lib/errors.ml: -------------------------------------------------------------------------------- 1 | exception SemanticError of (string * string) 2 | -------------------------------------------------------------------------------- /lib/errors.mli: -------------------------------------------------------------------------------- 1 | exception SemanticError of (string * string) 2 | -------------------------------------------------------------------------------- /lib/formatutil.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | let print_indent (buf : Buffer.t) (indent : int) = 4 | Buffer.add_string buf (String.make indent ' ') 5 | 6 | let print_statements 7 | (buf : Buffer.t) 8 | (stmts : 'a list) 9 | ~(f : Buffer.t -> 'a -> indent:int -> unit) 10 | ~(indent : int) = 11 | let print_statement_indented buf stmt = f buf stmt ~indent in 12 | let num_stmts = List.length stmts in 13 | List.iteri stmts ~f: (fun i stmt -> 14 | print_statement_indented buf stmt; 15 | if i < num_stmts - 1 then 16 | Buffer.add_string buf "\n" 17 | ) 18 | 19 | let print_separate_list 20 | (buf : Buffer.t) 21 | (elements : 'a list) 22 | ~(f : Buffer.t -> 'a -> unit) 23 | ~(separator : string) = 24 | let num_elements = List.length elements in 25 | List.iteri elements ~f: (fun i element -> 26 | f buf element; 27 | if i < num_elements - 1 then 28 | Buffer.add_string buf separator 29 | ) 30 | 31 | let escaper = Staged.unstage ( 32 | String.Escaping.escape_gen_exn 33 | ~escapeworthy_map: [ 34 | ('\n', 'n'); 35 | ('\r', 'r'); 36 | ('\"', '"')] 37 | ~escape_char: '\\' 38 | ) 39 | 40 | let escape (str : string) : string = 41 | escaper str 42 | -------------------------------------------------------------------------------- /lib/lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Lexing 3 | open Parser_yacc 4 | 5 | exception SyntaxError of string 6 | 7 | let next_line (lexbuf: Lexing.lexbuf) = 8 | let pos = lexbuf.lex_curr_p in 9 | lexbuf.lex_curr_p <- 10 | { pos with pos_bol = lexbuf.lex_curr_pos; 11 | pos_lnum = pos.pos_lnum + 1 12 | } 13 | 14 | } 15 | 16 | let int = '-'? ['0'-'9'] ['0'-'9']* 17 | 18 | let digit = ['0'-'9'] 19 | let frac = '.' digit* 20 | let exp = ['e' 'E'] ['-' '+']? digit+ 21 | let float = digit* frac? exp? 22 | 23 | let white = [' ' '\t']+ 24 | let newline = '\r' | '\n' | "\r\n" 25 | let ident = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']* 26 | 27 | rule read = 28 | parse 29 | | white { read lexbuf } 30 | | newline { next_line lexbuf; read lexbuf } 31 | | int { INT (int_of_string (Lexing.lexeme lexbuf)) } 32 | | float { FLOAT (float_of_string (Lexing.lexeme lexbuf)) } 33 | | "true" { TRUE } 34 | | "false" { FALSE } 35 | | "if" { IF } 36 | | "else" { ELSE } 37 | | "while" { WHILE } 38 | | "function" { FUNCTION } 39 | | "global" { GLOBAL } 40 | | "return" { RETURN } 41 | | '=' { EQUAL } 42 | | '"' { read_string (Buffer.create 17) lexbuf } 43 | | '(' { LEFT_PAREN } 44 | | ')' { RIGHT_PAREN } 45 | | '{' { LEFT_BRACE } 46 | | '}' { RIGHT_BRACE } 47 | | '[' { LEFT_BRACK } 48 | | ']' { RIGHT_BRACK } 49 | | ';' { SEMICOLON } 50 | | ',' { COMMA } 51 | | '+' { PLUS } 52 | | '-' { MINUS } 53 | | '*' { MULTIPLY } 54 | | '/' { DIVIDE } 55 | | '%' { MODULO } 56 | | "++" { CONCAT } 57 | | '!' { NOT } 58 | | "==" { SEQ } 59 | | "!=" { SNE } 60 | | "===" { AEQ } 61 | | "!==" { ANE } 62 | | '>' { GT } 63 | | '<' { LT } 64 | | ">=" { GE } 65 | | "<=" { LE } 66 | | "//" { read_line_comment (Buffer.create 17) lexbuf } 67 | | ident { IDENTIFIER (Lexing.lexeme lexbuf) } 68 | | eof { EOF } 69 | | _ { raise (SyntaxError ( 70 | "Unexpected char: " ^ Lexing.lexeme lexbuf)) } 71 | 72 | and read_string buf = 73 | parse 74 | | '"' { STRING (Buffer.contents buf) } 75 | | '\\' '"' { Buffer.add_char buf '"'; read_string buf lexbuf } 76 | | '\\' '\\' { Buffer.add_char buf '\\'; read_string buf lexbuf } 77 | | '\\' 'b' { Buffer.add_char buf '\b'; read_string buf lexbuf } 78 | | '\\' 'f' { Buffer.add_char buf '\012'; read_string buf lexbuf } 79 | | '\\' 'n' { Buffer.add_char buf '\n'; read_string buf lexbuf } 80 | | '\\' 'r' { Buffer.add_char buf '\r'; read_string buf lexbuf } 81 | | '\\' 't' { Buffer.add_char buf '\t'; read_string buf lexbuf } 82 | | [^ '"' '\\']+ 83 | { Buffer.add_string buf (Lexing.lexeme lexbuf); 84 | read_string buf lexbuf 85 | } 86 | | _ { raise (SyntaxError ("Illegal string character: " ^ Lexing.lexeme lexbuf)) } 87 | | eof { raise (SyntaxError ("String is not terminated")) } 88 | 89 | and read_line_comment buf = 90 | parse 91 | | newline 92 | | eof 93 | { COMMENT (Buffer.contents buf) } 94 | | _ 95 | { Buffer.add_string buf (Lexing.lexeme lexbuf); 96 | read_line_comment buf lexbuf 97 | } 98 | -------------------------------------------------------------------------------- /lib/parser.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type t = { 4 | lex: Lexing.lexbuf; 5 | ast: Batsh_ast.t; 6 | symtable: Symbol_table.t; 7 | } 8 | 9 | exception ParseError of string 10 | exception SemanticError of string 11 | 12 | let parse (lexbuf : Lexing.lexbuf) : Batsh_ast.t = 13 | let print_position () () = 14 | let pos = lexbuf.Lexing.lex_curr_p in 15 | sprintf "%s:%d:%d" 16 | pos.Lexing.pos_fname 17 | pos.Lexing.pos_lnum 18 | (pos.Lexing.pos_cnum - pos.Lexing.pos_bol + 1) 19 | in 20 | try 21 | Parser_yacc.program Lexer.read lexbuf 22 | with 23 | | Lexer.SyntaxError msg -> 24 | let err = sprintf "%a: %s" print_position () msg in 25 | raise (ParseError err) 26 | | Parsing.Parse_error -> 27 | let err = sprintf "%a: syntax error" print_position () in 28 | raise (ParseError err) 29 | 30 | let create_from_lexbuf (lexbuf : Lexing.lexbuf) (filename: string) : t = 31 | lexbuf.Lexing.lex_curr_p <- { 32 | lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = filename 33 | }; 34 | let ast = parse lexbuf in 35 | let () = 36 | try 37 | Semantic_checker.check ast 38 | with 39 | | Semantic_checker.Error msg -> 40 | raise (SemanticError (sprintf "Semantic error: %s" msg)) 41 | in 42 | let symtable = Symbol_table.create ast in 43 | { lex = lexbuf; ast; symtable; } 44 | 45 | let create_from_channel (inx: In_channel.t) (filename: string) : t = 46 | let lexbuf = Lexing.from_channel inx in 47 | create_from_lexbuf lexbuf filename 48 | 49 | let create_from_file (filename : string) : t = 50 | let inx = In_channel.create filename in 51 | let batsh = create_from_channel inx filename in 52 | In_channel.close inx; 53 | batsh 54 | 55 | let create_from_string (source : string) : t = 56 | let lexbuf = Lexing.from_string source in 57 | create_from_lexbuf lexbuf "input" 58 | 59 | let prettify (batsh : t) : string = 60 | let buf = Buffer.create 1024 in 61 | Batsh_format.print_ast buf batsh.ast; 62 | Buffer.contents buf 63 | 64 | let ast (batsh: t) : Batsh_ast.t = 65 | batsh.ast 66 | 67 | let symtable (batsh: t) : Symbol_table.t = 68 | batsh.symtable 69 | -------------------------------------------------------------------------------- /lib/parser.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | exception ParseError of string 4 | exception SemanticError of string 5 | 6 | val create_from_file : string -> t 7 | val create_from_channel : in_channel -> string -> t 8 | val create_from_string : string -> t 9 | val prettify : t -> string 10 | val ast : t -> Batsh_ast.t 11 | val symtable : t -> Symbol_table.t 12 | -------------------------------------------------------------------------------- /lib/parser_yacc.mly: -------------------------------------------------------------------------------- 1 | %token INT 2 | %token FLOAT 3 | %token STRING 4 | %token IDENTIFIER 5 | %token COMMENT 6 | %token TRUE 7 | %token FALSE 8 | %token IF 9 | %token ELSE 10 | %token WHILE 11 | %token FUNCTION 12 | %token GLOBAL 13 | %token RETURN 14 | %token EQUAL 15 | %token LEFT_PAREN 16 | %token RIGHT_PAREN 17 | %token LEFT_BRACK 18 | %token RIGHT_BRACK 19 | %token LEFT_BRACE 20 | %token RIGHT_BRACE 21 | %token SEMICOLON 22 | %token COMMA 23 | %token PLUS 24 | %token MINUS 25 | %token MULTIPLY 26 | %token DIVIDE 27 | %token MODULO 28 | %token CONCAT 29 | %token NOT 30 | %token SEQ 31 | %token SNE 32 | %token AEQ 33 | %token ANE 34 | %token GT 35 | %token LT 36 | %token GE 37 | %token LE 38 | %token EOF 39 | 40 | %nonassoc SEQ SNE AEQ ANE 41 | %nonassoc GT LT GE LE 42 | %left CONCAT 43 | %nonassoc NOT 44 | %left PLUS MINUS 45 | %left MULTIPLY DIVIDE MODULO 46 | 47 | %nonassoc IF 48 | %nonassoc ELSE 49 | 50 | %start program 51 | %type program 52 | 53 | %% 54 | 55 | program: 56 | toplevel_list; EOF; 57 | { $1 } 58 | ; 59 | 60 | toplevel: 61 | | statement; 62 | { Batsh_ast.Statement $1 } 63 | | FUNCTION; IDENTIFIER; LEFT_PAREN; 64 | identifier_list; RIGHT_PAREN; 65 | LEFT_BRACE; statement_list; RIGHT_BRACE; 66 | { Batsh_ast.Function ($2, $4, $7) } 67 | 68 | toplevel_list: 69 | | { [] } 70 | | toplevel; toplevel_list 71 | { $1 :: $2 } 72 | 73 | statement: 74 | | SEMICOLON; 75 | { Batsh_ast.Empty } 76 | | COMMENT; 77 | { Batsh_ast.Comment $1 } 78 | | expression; SEMICOLON; 79 | { Batsh_ast.Expression $1 } 80 | | LEFT_BRACE; statement_list; RIGHT_BRACE; 81 | { Batsh_ast.Block $2 } 82 | | leftvalue; EQUAL; expression; SEMICOLON; 83 | { Batsh_ast.Assignment ($1, $3) } 84 | | if_statement 85 | { $1 } 86 | | loop_statement 87 | { $1 } 88 | | GLOBAL IDENTIFIER; SEMICOLON 89 | { Batsh_ast.Global $2 } 90 | | RETURN expression; SEMICOLON 91 | { Batsh_ast.Return (Some $2)} 92 | | RETURN SEMICOLON 93 | { Batsh_ast.Return None} 94 | 95 | statement_list: 96 | | { [] } 97 | | statement; statement_list 98 | { $1 :: $2 } 99 | 100 | if_statement: 101 | | IF; LEFT_PAREN; expression; RIGHT_PAREN; statement %prec IF 102 | { Batsh_ast.If ($3, $5) } 103 | | IF; LEFT_PAREN; expression; RIGHT_PAREN; statement; ELSE; statement 104 | { Batsh_ast.IfElse ($3, $5, $7) } 105 | 106 | loop_statement: 107 | | WHILE; LEFT_PAREN; expression; RIGHT_PAREN; statement; 108 | { Batsh_ast.While ($3, $5) } 109 | ; 110 | 111 | expression: 112 | | leftvalue 113 | { Batsh_ast.Leftvalue $1 } 114 | | STRING 115 | { Batsh_ast.String $1 } 116 | | INT 117 | { Batsh_ast.Int $1 } 118 | | FLOAT 119 | { Batsh_ast.Float $1 } 120 | | TRUE 121 | { Batsh_ast.Bool true } 122 | | FALSE 123 | { Batsh_ast.Bool false } 124 | | LEFT_BRACK; expression_list; RIGHT_BRACK 125 | { Batsh_ast.List $2 } 126 | | unary_expression; 127 | { $1 } 128 | | binary_expression; 129 | { $1 } 130 | | LEFT_PAREN; expression; RIGHT_PAREN; 131 | { $2 } 132 | | IDENTIFIER; LEFT_PAREN; expression_list; RIGHT_PAREN; 133 | { Batsh_ast.Call ($1, $3) } 134 | 135 | expression_list: 136 | | { [] } 137 | | expression 138 | { [$1] } 139 | | expression; COMMA; expression_list 140 | { $1 :: $3 } 141 | 142 | identifier_list: 143 | | { [] } 144 | | IDENTIFIER 145 | { [$1] } 146 | | IDENTIFIER; COMMA; identifier_list 147 | { $1 :: $3 } 148 | 149 | leftvalue: 150 | | IDENTIFIER; 151 | { Batsh_ast.Identifier $1 } 152 | | leftvalue; LEFT_BRACK; expression; RIGHT_BRACK 153 | { Batsh_ast.ListAccess ($1, $3) } 154 | 155 | unary_expression: 156 | | NOT; expression 157 | { Batsh_ast.ArithUnary ("!", $2) } 158 | 159 | binary_expression: 160 | | expression; PLUS; expression 161 | { Batsh_ast.ArithBinary ("+", $1, $3) } 162 | | expression; MINUS; expression 163 | { Batsh_ast.ArithBinary ("-", $1, $3) } 164 | | expression; MULTIPLY; expression 165 | { Batsh_ast.ArithBinary ("*", $1, $3) } 166 | | expression; DIVIDE; expression 167 | { Batsh_ast.ArithBinary ("/", $1, $3) } 168 | | expression; MODULO; expression 169 | { Batsh_ast.ArithBinary ("%", $1, $3) } 170 | | expression; AEQ; expression 171 | { Batsh_ast.ArithBinary ("===", $1, $3) } 172 | | expression; ANE; expression 173 | { Batsh_ast.ArithBinary ("!==", $1, $3) } 174 | | expression; GT; expression 175 | { Batsh_ast.ArithBinary (">", $1, $3) } 176 | | expression; LT; expression 177 | { Batsh_ast.ArithBinary ("<", $1, $3) } 178 | | expression; GE; expression 179 | { Batsh_ast.ArithBinary (">=", $1, $3) } 180 | | expression; LE; expression 181 | { Batsh_ast.ArithBinary ("<=", $1, $3) } 182 | | expression; CONCAT; expression 183 | { Batsh_ast.Concat ($1, $3) } 184 | | expression; SEQ; expression 185 | { Batsh_ast.StrCompare ("==", $1, $3) } 186 | | expression; SNE; expression 187 | { Batsh_ast.StrCompare ("!=", $1, $3) } 188 | -------------------------------------------------------------------------------- /lib/semantic_checker.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Batsh_ast 3 | 4 | exception Error of string 5 | 6 | let check_function_statement (stmt : statement) = 7 | match stmt with 8 | | Return (Some List _) -> 9 | raise (Error "list can not be used as a return value") 10 | | _ -> 11 | () 12 | 13 | let check_function (func : (identifier * identifiers * statements)) = 14 | let _name, _params, stmts = func in 15 | List.iter stmts ~f: check_function_statement 16 | 17 | let check_toplevel (topl : toplevel) = 18 | match topl with 19 | | Statement (Global _) -> 20 | raise (Error "qualifier 'global' must be used in a function") 21 | | Statement (Return _) -> 22 | raise (Error "statement 'return' must be used in a function") 23 | | Statement _ -> 24 | () 25 | | Function func -> 26 | check_function func 27 | 28 | let check (ast : t) : unit = 29 | List.iter ast ~f: check_toplevel 30 | -------------------------------------------------------------------------------- /lib/symbol_table.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Batsh_ast 3 | 4 | type variable_entry = { 5 | name : string; 6 | global : bool; 7 | } 8 | [@@deriving sexp] 9 | 10 | type variable_table = (string, variable_entry) Hashtbl.Poly.t 11 | [@@deriving sexp] 12 | 13 | let sexp_of_variable_table (vtable : variable_table) : Sexp.t = 14 | Sexp.List (Hashtbl.fold vtable ~init: [] 15 | ~f: (fun ~key:_ ~data acc -> 16 | let item = (sexp_of_variable_entry data) in 17 | item :: acc 18 | ) 19 | ) 20 | 21 | type function_entry = 22 | | Declaration 23 | | Defination of variable_table 24 | [@@deriving sexp] 25 | 26 | type t = { 27 | functions : (string, function_entry) Hashtbl.Poly.t; 28 | globals : variable_table; 29 | } 30 | [@@deriving sexp] 31 | 32 | module Scope = struct 33 | type t = 34 | | GlobalScope of variable_table 35 | | FunctionScope of (string * variable_table) 36 | [@@deriving sexp] 37 | 38 | let is_function (scope : t) : bool = 39 | match scope with 40 | | GlobalScope _ -> false 41 | | FunctionScope _ -> true 42 | 43 | let variables (scope : t) : variable_table = 44 | match scope with 45 | | GlobalScope variables -> variables 46 | | FunctionScope (_, variables) -> variables 47 | 48 | let find_variable 49 | (scope: t) 50 | ~(name: string) 51 | : variable_entry option = 52 | Hashtbl.find (variables scope) name 53 | 54 | let is_global_variable 55 | (scope : t) 56 | ~(name : string) 57 | : bool = 58 | match scope with 59 | | GlobalScope _ -> true 60 | | FunctionScope (_, variable_table) -> 61 | match Hashtbl.find variable_table name with 62 | | None -> true (* if variable is not found, consider it as external *) 63 | | Some variable -> variable.global 64 | 65 | let fold 66 | (scope: t) 67 | ~(init: 'a) 68 | ~(f: string -> bool -> 'a -> 'a) = 69 | let vtable = variables scope in 70 | Hashtbl.fold vtable ~init 71 | ~f: (fun ~key:_ ~data acc -> f data.name data.global acc) 72 | 73 | let add_temporary_variable 74 | (scope: t) 75 | : identifier = 76 | let rec find_available_name (num : int) : string = 77 | let name = "_" ^ (Int.to_string num) in 78 | match find_variable scope ~name with 79 | | None -> 80 | (* Add to symbol table *) 81 | let variables = variables scope in 82 | Hashtbl.add_exn variables ~key: name ~data: {name; global = false}; 83 | name 84 | | Some _ -> 85 | (* Duplicated, try again *) 86 | find_available_name (num + 1) 87 | in 88 | find_available_name 0 89 | end 90 | 91 | let process_identifier 92 | (scope: variable_table) 93 | (ident: identifier) 94 | ~(global: bool) = 95 | Hashtbl.change scope ident ~f:(fun original -> 96 | let entry = Some { 97 | name = ident; 98 | global = global; 99 | } 100 | in 101 | match original with 102 | | None -> entry 103 | | Some existing -> 104 | if global && not existing.global then 105 | entry 106 | else 107 | original 108 | ) 109 | 110 | let rec process_leftvalue 111 | (scope: variable_table) 112 | (lvalue: leftvalue) 113 | ~(global: bool) = 114 | match lvalue with 115 | | Identifier ident -> 116 | process_identifier scope ident ~global 117 | | ListAccess (lvalue, _) -> 118 | process_leftvalue scope lvalue ~global 119 | 120 | let process_statement 121 | (scope: variable_table) 122 | (stmt: statement) = 123 | match stmt with 124 | | Assignment (lvalue, _) -> process_leftvalue scope lvalue ~global: false 125 | | Global ident -> process_identifier scope ident ~global: true 126 | | _ -> () 127 | 128 | let process_function 129 | functions 130 | (name, params, stmts) = 131 | match Hashtbl.find functions name with 132 | | Some _ -> () (* TODO duplicate *) 133 | | None -> 134 | let variables = Hashtbl.create (module String) in 135 | Hashtbl.change functions name ~f:(fun _original -> 136 | (* TODO declaration *) 137 | Some (Defination variables) 138 | ); 139 | List.iter stmts ~f: (process_statement variables); 140 | List.iter params ~f: (process_identifier variables ~global: false) 141 | 142 | let process_toplevel (symtable: t) (topl: toplevel) = 143 | match topl with 144 | | Statement stmt -> process_statement symtable.globals stmt 145 | | Function func -> process_function symtable.functions func 146 | 147 | let create (ast: Batsh_ast.t) :t = 148 | let symtable = { 149 | functions = Hashtbl.create (module String); 150 | globals = Hashtbl.create (module String) 151 | } in 152 | List.iter ast ~f: (process_toplevel symtable); 153 | symtable 154 | 155 | let scope (symtable: t) (name: string) : Scope.t = 156 | let variables = match Hashtbl.find_exn symtable.functions name with 157 | | Declaration -> failwith "No such function" 158 | | Defination variables -> variables 159 | in 160 | Scope.FunctionScope (name, variables) 161 | 162 | let global_scope (symtable: t) : Scope.t = 163 | Scope.GlobalScope symtable.globals 164 | 165 | let is_function (symtable : t) (name : string) : bool = 166 | match Hashtbl.find symtable.functions name with 167 | | Some _ -> true 168 | | None -> false 169 | -------------------------------------------------------------------------------- /lib/symbol_table.mli: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type t 4 | 5 | module Scope : sig 6 | type t 7 | val is_function : t -> bool 8 | val is_global_variable : t -> name: string -> bool 9 | val add_temporary_variable : t -> Batsh_ast.identifier 10 | val fold : t -> init: 'a -> f: (string -> bool -> 'a -> 'a) -> 'a 11 | end 12 | 13 | val create : Batsh_ast.t -> t 14 | val scope : t -> string -> Scope.t 15 | val global_scope : t -> Scope.t 16 | val sexp_of_t : t -> Sexp.t 17 | val is_function : t -> string -> bool 18 | -------------------------------------------------------------------------------- /lib/winbat.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | batsh : Parser.t; 3 | batch_ast : Winbat_ast.t; 4 | batch_ast_expanded : Winbat_ast.t; 5 | } 6 | 7 | let compile (batsh : Parser.t) : t = 8 | let batch_ast = Winbat_compile.compile batsh in 9 | let batch_ast_expanded = Winbat_functions.expand batch_ast in 10 | {batsh; batch_ast; batch_ast_expanded} 11 | 12 | let print (batch : t) : string = 13 | let buf = Buffer.create 1024 in 14 | Winbat_format.print buf batch.batch_ast_expanded; 15 | Buffer.contents buf 16 | 17 | let ast ?(expand_functions=true) (winbat : t) : Winbat_ast.t = 18 | if expand_functions then 19 | winbat.batch_ast_expanded 20 | else 21 | winbat.batch_ast 22 | -------------------------------------------------------------------------------- /lib/winbat.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val compile : Parser.t -> t 4 | val print : t -> string 5 | val ast : ?expand_functions:bool -> t -> Winbat_ast.t 6 | -------------------------------------------------------------------------------- /lib/winbat_ast.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | 3 | type identifier = string 4 | 5 | and identifiers = identifier list 6 | 7 | and label = string 8 | 9 | and varint = [ 10 | | `Var of leftvalue 11 | | `Int of int 12 | ] 13 | 14 | and leftvalue = [ 15 | | `Identifier of identifier 16 | | `ListAccess of (leftvalue * varint) 17 | ] 18 | 19 | and arithmetic = [ 20 | | `Var of leftvalue 21 | | `Int of int 22 | | `ArithUnary of (string * arithmetic) 23 | | `ArithBinary of (string * arithmetic * arithmetic) 24 | ] 25 | 26 | and varstring = [ 27 | | `Var of leftvalue 28 | | `Str of string 29 | | `Rawstr of string 30 | ] 31 | 32 | and varstrings = varstring list 33 | 34 | and comparison = [ 35 | | `UniCompare of (string * varstrings) 36 | | `StrCompare of (string * varstrings * varstrings) 37 | | `TestCompare of (string * varstrings) 38 | ] 39 | 40 | and parameter = varstrings 41 | 42 | and parameters = parameter list 43 | 44 | and statement = [ 45 | | `Comment of string 46 | | `Raw of string 47 | | `Label of label 48 | | `Goto of label 49 | | `Assignment of (leftvalue * varstrings) 50 | | `ArithAssign of (leftvalue * arithmetic) 51 | | `Call of (varstrings * parameters) 52 | | `Output of (leftvalue * varstrings * parameters) 53 | | `If of (comparison * statements) 54 | | `IfElse of (comparison * statements * statements) 55 | | `Empty 56 | ] 57 | 58 | and statements = statement list 59 | 60 | and t = statements 61 | [@@deriving sexp] 62 | -------------------------------------------------------------------------------- /lib/winbat_compile.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Batsh_ast 3 | open Winbat_ast 4 | 5 | let rec compile_leftvalue 6 | (lvalue: Batsh_ast.leftvalue) 7 | ~(symtable: Symbol_table.t) 8 | ~(scope: Symbol_table.Scope.t) 9 | : leftvalue = 10 | match lvalue with 11 | | Identifier ident -> 12 | `Identifier ident 13 | | ListAccess (lvalue, index) -> 14 | let lvalue = compile_leftvalue lvalue ~symtable ~scope in 15 | let index = compile_expression_to_varint index ~symtable ~scope in 16 | `ListAccess (lvalue, index) 17 | 18 | and compile_expression_to_varint 19 | (expr : Batsh_ast.expression) 20 | ~(symtable : Symbol_table.t) 21 | ~(scope : Symbol_table.Scope.t) 22 | : varint = 23 | match expr with 24 | | Leftvalue lvalue -> 25 | `Var (compile_leftvalue lvalue ~symtable ~scope) 26 | | Int num -> 27 | `Int num 28 | | _ -> 29 | raise (Errors.SemanticError 30 | ("Index should be either var or int", 31 | expr |> Batsh_ast.sexp_of_expression |> Sexp.to_string 32 | ) 33 | ) 34 | 35 | let rec compile_expression_to_arith 36 | (expr : Batsh_ast.expression) 37 | ~(symtable : Symbol_table.t) 38 | ~(scope : Symbol_table.Scope.t) 39 | : arithmetic = 40 | match expr with 41 | | Bool false -> 42 | `Int 0 43 | | Bool true -> 44 | `Int 1 45 | | Int num -> 46 | `Int num 47 | | Leftvalue lvalue -> 48 | `Var (compile_leftvalue lvalue ~symtable ~scope) 49 | | ArithUnary (operator, expr) -> 50 | `ArithUnary (operator, compile_expression_to_arith expr ~symtable ~scope) 51 | | ArithBinary (operator, left, right) -> 52 | `ArithBinary (operator, 53 | compile_expression_to_arith left ~symtable ~scope, 54 | compile_expression_to_arith right ~symtable ~scope) 55 | | String _ 56 | | Float _ 57 | | List _ 58 | | Concat _ 59 | | StrCompare _ 60 | | Call _ -> 61 | Sexp.output_hum stderr (Batsh_ast.sexp_of_expression expr); 62 | failwith "Can not be here" 63 | 64 | let compile_expression 65 | (expr : Batsh_ast.expression) 66 | ~(symtable : Symbol_table.t) 67 | ~(scope : Symbol_table.Scope.t) 68 | : varstrings = 69 | let rec compile_expression_impl 70 | (expr : Batsh_ast.expression) 71 | : varstring Dlist.t = 72 | match expr with 73 | | Bool false -> 74 | Dlist.of_list [`Str "0"] 75 | | Bool true -> 76 | Dlist.of_list [`Str "1"] 77 | | Int num -> 78 | Dlist.of_list [`Str (string_of_int num)] 79 | | Float num -> 80 | Dlist.of_list [`Str (Float.to_string num)] 81 | | String str -> 82 | Dlist.of_list [`Str str] 83 | | Leftvalue lvalue -> 84 | Dlist.of_list [`Var (compile_leftvalue lvalue ~symtable ~scope)] 85 | | Concat (left, right) -> 86 | let left = compile_expression_impl left in 87 | let right = compile_expression_impl right in 88 | Dlist.append left right 89 | | List _ 90 | | ArithUnary _ 91 | | ArithBinary _ 92 | | StrCompare _ 93 | | Call _ -> 94 | Sexp.output_hum stderr (Batsh_ast.sexp_of_expression expr); 95 | failwith "Bug: Must have been split into assignments." 96 | in 97 | Dlist.to_list (compile_expression_impl expr) 98 | 99 | let compile_expressions_to_arguments 100 | (exprs : Batsh_ast.expressions) 101 | ~(symtable : Symbol_table.t) 102 | ~(scope : Symbol_table.Scope.t) 103 | : parameters = 104 | List.map exprs ~f: (compile_expression ~symtable ~scope) 105 | 106 | let compile_expression_to_comparison 107 | (expr : Batsh_ast.expression) 108 | ~(symtable : Symbol_table.t) 109 | ~(scope : Symbol_table.Scope.t) 110 | : comparison = 111 | match expr with 112 | | ArithUnary (operator, sub_expr) -> 113 | let sub_expr = compile_expression sub_expr ~symtable ~scope in 114 | `UniCompare (operator, sub_expr) 115 | | StrCompare (operator, left, right) 116 | | ArithBinary (operator, left, right) -> 117 | let left = compile_expression left ~symtable ~scope in 118 | let right = compile_expression right ~symtable ~scope in 119 | `StrCompare (operator, left, right) 120 | | Leftvalue lvalue -> 121 | let lvalue = `Var (compile_leftvalue lvalue ~symtable ~scope) in 122 | `StrCompare ("==", [lvalue], [`Str "1"]) 123 | | Bool true | Int 1 -> 124 | `UniCompare ("", [`Str "1"]) 125 | | Bool false | Int _ -> 126 | `UniCompare ("!", [`Str "1"]) 127 | | Call ("exists", (sub_expr :: _)) -> 128 | let clause = compile_expression sub_expr ~symtable ~scope in 129 | `TestCompare ("exist", clause) 130 | | _ -> 131 | raise (Errors.SemanticError 132 | ("Expression can not compile to comparison", 133 | expr |> Batsh_ast.sexp_of_expression |> Sexp.to_string 134 | ) 135 | ) 136 | 137 | let compile_call 138 | (ident, exprs) 139 | ~(return_value : leftvalue option) 140 | ~(symtable : Symbol_table.t) 141 | ~(scope : Symbol_table.Scope.t) 142 | : statements = 143 | let args = compile_expressions_to_arguments exprs ~symtable ~scope in 144 | if Symbol_table.is_function symtable ident then 145 | (* function call *) 146 | let frame_pointer_assign, frame_pointer = 147 | if Symbol_table.Scope.is_function scope then 148 | (* add frame pointer as surffix to local variables *) 149 | (* increase frame pointer %~2 by 1 *) 150 | let frame_pointer = `Identifier ( 151 | Symbol_table.Scope.add_temporary_variable scope) 152 | in 153 | [`ArithAssign ( 154 | frame_pointer, 155 | `ArithBinary ("+", `Int 1, `Var (`Identifier "%~2")) 156 | ) 157 | ], `Var (frame_pointer) 158 | else 159 | (* call from toplevel *) 160 | [], `Str "0" 161 | in 162 | let retval = Symbol_table.Scope.add_temporary_variable scope in 163 | let surffix = 164 | if Symbol_table.Scope.is_function scope then 165 | (* call from function scope *) 166 | "_%~2" 167 | else 168 | (* call from toplevel *) 169 | "" 170 | in 171 | let surffixed_retval = `Rawstr (retval ^ surffix) in 172 | let stringified_args = List.map args ~f:(fun arg -> 173 | match arg with 174 | | [`Var (`Identifier ident)] -> 175 | [`Rawstr (ident ^ surffix)] 176 | | _ -> 177 | Sexp.output_hum stderr (Winbat_ast.sexp_of_parameter arg); 178 | failwith "Argument should have been converted to variable." 179 | ) 180 | in 181 | let prefixed_args = [ 182 | [surffixed_retval]; (* return value *) 183 | [frame_pointer]; (* frame pointer *) 184 | ] @ stringified_args in 185 | let call_stmt = `Call ([`Str ("call :" ^ ident)], prefixed_args) in 186 | let stmts = frame_pointer_assign @ [call_stmt] in 187 | let stmts = 188 | match return_value with 189 | | Some lvalue -> 190 | (* Assign return value *) 191 | stmts @ [`Assignment (lvalue, [`Var (`Identifier retval)])] 192 | | None -> 193 | (* Print out return value *) 194 | stmts @ [`Call ([`Str "print"], [[`Var (`Identifier retval)]])] 195 | in 196 | stmts 197 | else 198 | match ident with 199 | | "exists" -> 200 | let params_1 params = 201 | match params with 202 | | param :: _ -> param 203 | | _ -> failwith ("exists must have only 1 parameter.") 204 | in 205 | let arg = compile_expression (params_1 exprs) ~symtable ~scope in 206 | let cond = `TestCompare ("exist", arg) in 207 | let stmts = 208 | match return_value with 209 | | Some lvalue -> 210 | let true_stmt = [`ArithAssign (lvalue, `Int 1)] in 211 | let false_stmt = [`ArithAssign (lvalue, `Int 0)] in 212 | [`IfElse (cond, true_stmt, false_stmt)] 213 | | None -> 214 | [`IfElse (cond, [], [])] 215 | in 216 | stmts 217 | | _ -> 218 | (* external command *) 219 | let stmts = 220 | match return_value with 221 | | Some lvalue -> 222 | [`Output (lvalue, [`Str ident], args)] 223 | | None -> 224 | [`Call ([`Str ident], args)] 225 | in 226 | stmts 227 | 228 | let compile_expression_statement 229 | (expr : Batsh_ast.expression) 230 | ~(symtable : Symbol_table.t) 231 | ~(scope : Symbol_table.Scope.t) 232 | : statements = 233 | match expr with 234 | | Call call -> 235 | (* Call discarding return value *) 236 | compile_call call ~return_value:None ~symtable ~scope 237 | | Leftvalue _ -> 238 | [] (* No side effect *) 239 | | _ -> 240 | Sexp.output_hum stderr (Batsh_ast.sexp_of_expression expr); 241 | assert false (* TODO *) 242 | 243 | let compile_arith_assignment 244 | (lvalue : Batsh_ast.leftvalue) 245 | (expr : Batsh_ast.expression) 246 | ~(symtable : Symbol_table.t) 247 | ~(scope : Symbol_table.Scope.t) 248 | : statements = 249 | match expr with 250 | | ArithBinary ("===", _, _) 251 | | ArithBinary ("!==", _, _) 252 | | ArithBinary (">", _, _) 253 | | ArithBinary ("<", _, _) 254 | | ArithBinary (">=", _, _) 255 | | ArithBinary ("<=", _, _) 256 | | ArithUnary ("!", _) -> 257 | let cond = compile_expression_to_comparison expr ~symtable ~scope in 258 | let lvalue = compile_leftvalue lvalue ~symtable ~scope in 259 | let true_stmt = [`ArithAssign (lvalue, `Int 1)] in 260 | let false_stmt = [`ArithAssign (lvalue, `Int 0)] in 261 | [`IfElse (cond, true_stmt, false_stmt)] 262 | | Bool _ 263 | | Int _ 264 | | Float _ 265 | | ArithUnary _ 266 | | ArithBinary _ -> 267 | let lvalue = compile_leftvalue lvalue ~symtable ~scope in 268 | let arith = compile_expression_to_arith expr ~symtable ~scope in 269 | [`ArithAssign (lvalue, arith)] 270 | | _ -> 271 | Sexp.output_hum stderr (Batsh_ast.sexp_of_leftvalue lvalue); 272 | Sexp.output_hum stderr (Batsh_ast.sexp_of_expression expr); 273 | failwith "Can not reach here." 274 | 275 | let rec compile_statement 276 | (stmt : Batsh_ast.statement) 277 | ~(symtable : Symbol_table.t) 278 | ~(scope : Symbol_table.Scope.t) 279 | : statements = 280 | match stmt with 281 | | Comment comment -> 282 | [`Comment comment] 283 | | Block stmts -> 284 | compile_statements stmts ~symtable ~scope 285 | | Expression expr -> 286 | compile_expression_statement expr ~symtable ~scope 287 | | Assignment (lvalue, expr) -> 288 | compile_assignment lvalue expr ~symtable ~scope 289 | | If (expr, stmt) -> 290 | [`If (compile_expression_to_comparison expr ~symtable ~scope, 291 | compile_statement stmt ~symtable ~scope)] 292 | | IfElse (expr, then_stmt, else_stmt) -> 293 | [`IfElse (compile_expression_to_comparison expr ~symtable ~scope, 294 | compile_statement then_stmt ~symtable ~scope, 295 | compile_statement else_stmt ~symtable ~scope)] 296 | | While (expr, stmt) -> 297 | let condition = compile_expression_to_comparison expr ~symtable ~scope in 298 | let body = compile_statement stmt ~symtable ~scope in 299 | let label_surfix = Symbol_table.Scope.add_temporary_variable 300 | (Symbol_table.global_scope symtable) 301 | in 302 | let label = sprintf "WHILE%s" label_surfix in 303 | [ 304 | `Label label; 305 | `If (condition, body @ [`Goto label]); 306 | ] 307 | | Return (Some expr) -> 308 | [ 309 | `Assignment (`Identifier "%~1", compile_expression expr ~symtable ~scope); 310 | `Goto ":EOF" 311 | ] 312 | | Return None -> 313 | [`Goto ":EOF"] 314 | | Global _ 315 | | Empty -> 316 | [] 317 | 318 | and compile_assignment 319 | (lvalue : Batsh_ast.leftvalue) 320 | (expr : Batsh_ast.expression) 321 | ~(symtable : Symbol_table.t) 322 | ~(scope : Symbol_table.Scope.t) 323 | : statements = 324 | match expr with 325 | | String _ 326 | | Concat _ 327 | | Leftvalue _ -> 328 | let lvalue = compile_leftvalue lvalue ~symtable ~scope in 329 | [`Assignment (lvalue, compile_expression expr ~symtable ~scope)] 330 | | Bool _ 331 | | Int _ 332 | | Float _ 333 | | ArithUnary _ 334 | | ArithBinary _ -> 335 | compile_arith_assignment lvalue expr ~symtable ~scope 336 | | List exprs -> 337 | List.concat (List.mapi exprs ~f: (fun i expr -> 338 | compile_assignment (ListAccess (lvalue, (Int i))) expr ~symtable ~scope 339 | )) 340 | | Call call -> 341 | (* Call obtaining return value *) 342 | let lvalue = compile_leftvalue lvalue ~symtable ~scope in 343 | compile_call call ~return_value:(Some lvalue) ~symtable ~scope 344 | | StrCompare _ -> 345 | let comp = compile_expression_to_comparison expr ~symtable ~scope in 346 | let lvalue = compile_leftvalue lvalue ~symtable ~scope in 347 | [`IfElse ( 348 | comp, 349 | [`ArithAssign (lvalue, `Int 1)], 350 | [`ArithAssign (lvalue, `Int 0)] 351 | ) 352 | ] 353 | 354 | and compile_statements 355 | (stmts: Batsh_ast.statements) 356 | ~(symtable: Symbol_table.t) 357 | ~(scope: Symbol_table.Scope.t) 358 | : statements = 359 | Dlist.to_list ( 360 | List.fold stmts ~init: (Dlist.empty ()) ~f: (fun acc stmt -> 361 | let stmts = compile_statement stmt ~symtable ~scope in 362 | Dlist.append acc (Dlist.of_list stmts) 363 | ) 364 | ) 365 | 366 | (* Function variable, call, return replacement *) 367 | 368 | let rec compile_function_leftvalue 369 | (lvalue : leftvalue) 370 | ~(symtable : Symbol_table.t) 371 | ~(scope : Symbol_table.Scope.t) 372 | : leftvalue = 373 | match lvalue with 374 | | `Identifier ident -> 375 | if Symbol_table.Scope.is_global_variable scope ~name: ident then 376 | lvalue 377 | else 378 | (* Add surfix _%~2 to local variable *) 379 | `ListAccess (lvalue, `Var (`Identifier "%~2")) 380 | | `ListAccess (lvalue, index) -> 381 | `ListAccess (compile_function_leftvalue lvalue ~symtable ~scope, index) 382 | 383 | let compile_function_varstring 384 | (var : varstring) 385 | ~(symtable : Symbol_table.t) 386 | ~(scope : Symbol_table.Scope.t) 387 | : varstring = 388 | match var with 389 | | `Var lvalue -> 390 | `Var (compile_function_leftvalue lvalue ~symtable ~scope) 391 | | `Str _ | `Rawstr _ -> 392 | var 393 | 394 | let compile_function_varstrings 395 | (vars : varstrings) 396 | ~(symtable : Symbol_table.t) 397 | ~(scope : Symbol_table.Scope.t) 398 | : varstrings = 399 | List.map vars ~f: (compile_function_varstring ~symtable ~scope) 400 | 401 | let compile_function_parameters 402 | (params : parameters) 403 | ~(symtable : Symbol_table.t) 404 | ~(scope : Symbol_table.Scope.t) 405 | : parameters = 406 | List.map params ~f: (compile_function_varstrings ~symtable ~scope) 407 | 408 | let rec compile_function_arithmetic 409 | (arith : arithmetic) 410 | ~(symtable : Symbol_table.t) 411 | ~(scope : Symbol_table.Scope.t) 412 | : arithmetic = 413 | match arith with 414 | | `Var lvalue -> 415 | `Var (compile_function_leftvalue lvalue ~symtable ~scope) 416 | | `Int _ -> 417 | arith 418 | | `ArithUnary (operator, arith) -> 419 | `ArithUnary (operator, compile_function_arithmetic arith ~symtable ~scope) 420 | | `ArithBinary (operator, left, right) -> 421 | `ArithBinary (operator, 422 | compile_function_arithmetic left ~symtable ~scope, 423 | compile_function_arithmetic right ~symtable ~scope) 424 | 425 | let compile_function_comparison 426 | (cond : comparison) 427 | ~(symtable : Symbol_table.t) 428 | ~(scope : Symbol_table.Scope.t) 429 | : comparison = 430 | match cond with 431 | | `TestCompare (operator, expr) -> 432 | `TestCompare (operator, 433 | compile_function_varstrings expr ~symtable ~scope) 434 | | `UniCompare (operator, expr) -> 435 | `UniCompare (operator, 436 | compile_function_varstrings expr ~symtable ~scope) 437 | | `StrCompare (operator, left, right) -> 438 | `StrCompare (operator, 439 | compile_function_varstrings left ~symtable ~scope, 440 | compile_function_varstrings right ~symtable ~scope) 441 | 442 | let rec compile_function_statement 443 | (stmt : statement) 444 | ~(symtable : Symbol_table.t) 445 | ~(scope : Symbol_table.Scope.t) 446 | : statement = 447 | match stmt with 448 | | `Comment _ | `Raw _ | `Label _ | `Goto _ | `Empty -> 449 | stmt 450 | | `Assignment (lvalue, vars) -> 451 | `Assignment (compile_function_leftvalue lvalue ~symtable ~scope, 452 | compile_function_varstrings vars ~symtable ~scope) 453 | | `ArithAssign (lvalue, arith) -> 454 | `ArithAssign (compile_function_leftvalue lvalue ~symtable ~scope, 455 | compile_function_arithmetic arith ~symtable ~scope) 456 | | `Call (name, params) -> 457 | `Call (compile_function_varstrings name ~symtable ~scope, 458 | compile_function_parameters params ~symtable ~scope) 459 | | `Output (lvalue, name, params) -> 460 | `Output ( 461 | compile_function_leftvalue lvalue ~symtable ~scope, 462 | compile_function_varstrings name ~symtable ~scope, 463 | compile_function_parameters params ~symtable ~scope) 464 | | `If (cond, stmts) -> 465 | `If (compile_function_comparison cond ~symtable ~scope, 466 | compile_function_statements stmts ~symtable ~scope) 467 | | `IfElse (cond, then_stmts, else_stmts) -> 468 | `IfElse (compile_function_comparison cond ~symtable ~scope, 469 | compile_function_statements then_stmts ~symtable ~scope, 470 | compile_function_statements else_stmts ~symtable ~scope) 471 | 472 | and compile_function_statements 473 | (stmts : statements) 474 | ~(symtable : Symbol_table.t) 475 | ~(scope : Symbol_table.Scope.t) 476 | : statements = 477 | List.map stmts ~f: (compile_function_statement ~symtable ~scope) 478 | 479 | let compile_function 480 | (name, params, stmts) 481 | ~(symtable : Symbol_table.t) 482 | : statements = 483 | let scope = Symbol_table.scope symtable name in 484 | let body = compile_statements stmts ~symtable ~scope in 485 | let replaced_body = compile_function_statements body ~symtable ~scope in 486 | let params_assignments = List.mapi params ~f: (fun i param -> 487 | (* Add frame pointer surfix to every paramemeter *) 488 | let lvalue = `ListAccess (`Identifier param, `Var (`Identifier "%~2")) in 489 | let param_var = (sprintf "!%%~%d!" (i + 3)) in 490 | `Assignment (lvalue, [`Rawstr param_var]) 491 | ) 492 | in 493 | (`Empty 494 | :: (`Goto ":EOF") 495 | :: (`Label name) 496 | :: params_assignments) 497 | @ replaced_body 498 | 499 | let compile_toplevel 500 | ~(symtable : Symbol_table.t) 501 | (topl: Batsh_ast.toplevel) 502 | : statements = 503 | match topl with 504 | | Statement stmt -> 505 | compile_statement stmt ~symtable 506 | ~scope: (Symbol_table.global_scope symtable) 507 | | Function func -> 508 | compile_function func ~symtable 509 | 510 | let sort_functions (topls : Batsh_ast.t) : Batsh_ast.t = 511 | let is_function topl : bool = 512 | match topl with 513 | | Function _ -> true 514 | | Statement _ -> false 515 | in 516 | List.stable_sort topls ~compare:(fun a b -> 517 | let func_a = is_function a in 518 | let func_b = is_function b in 519 | match (func_a, func_b) with 520 | | (true, true) -> 0 521 | | (true, false) -> 1 522 | | (false, true) -> -1 523 | | (false, false) -> 0 524 | ) 525 | 526 | let compile (batsh: Parser.t) : t = 527 | let ast = Parser.ast batsh in 528 | let symtable = Parser.symtable batsh in 529 | let transformed_ast = Winbat_transform.split ast ~symtable in 530 | let sorted_ast = sort_functions transformed_ast in 531 | let stmts = Dlist.to_list ( 532 | List.fold_left sorted_ast 533 | ~init: (Dlist.empty ()) 534 | ~f: (fun acc topl -> 535 | let stmts = compile_toplevel topl ~symtable in 536 | Dlist.append acc (Dlist.of_list stmts) 537 | ) 538 | ) 539 | in 540 | (`Raw "@echo off") 541 | :: (`Raw "setlocal EnableDelayedExpansion") 542 | :: (`Raw "setlocal EnableExtensions") 543 | :: (`Empty) 544 | :: stmts 545 | -------------------------------------------------------------------------------- /lib/winbat_format.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Winbat_ast 3 | 4 | let escape (str : string) : string = 5 | let buffer = Buffer.create (String.length str) in 6 | let exclamation = match String.index str '!' with 7 | | None -> false 8 | | Some _ -> true 9 | in 10 | String.iter str ~f:(fun ch -> 11 | let escaped = match ch with 12 | | '%' -> "%%" 13 | | '^' -> 14 | if exclamation then 15 | "^^^^" 16 | else 17 | "^^" 18 | | '&' -> "^&" 19 | | '<' -> "^<" 20 | | '>' -> "^>" 21 | | '\'' -> "^'" 22 | | '"' -> "^\"" 23 | | '`' -> "^`" 24 | | ',' -> "^," 25 | | ';' -> "^;" 26 | | '=' -> "^=" 27 | | '(' -> "^(" 28 | | ')' -> "^)" 29 | | '!' -> "^^!" 30 | | '\n' -> "^\n\n" 31 | | _ -> String.of_char ch 32 | in 33 | Buffer.add_string buffer escaped 34 | ); 35 | Buffer.contents buffer 36 | 37 | let rec print_leftvalue 38 | (buf : Buffer.t) 39 | (lvalue : leftvalue) 40 | ~(bare : bool) 41 | = 42 | match lvalue with 43 | | `Identifier ident -> 44 | if bare || (Char.equal (String.get ident 0) '%') then 45 | bprintf buf "%s" ident 46 | else 47 | bprintf buf "!%s!" ident 48 | | `ListAccess (lvalue, index) -> 49 | if bare then 50 | bprintf buf "%a_%a" 51 | (print_leftvalue ~bare: true) lvalue 52 | (print_varint ~bare: true) index 53 | else 54 | bprintf buf "!%a_%a!" 55 | (print_leftvalue ~bare: true) lvalue 56 | (print_varint ~bare: true) index 57 | 58 | and print_varint 59 | (buf : Buffer.t) 60 | (index : varint) 61 | ~(bare : bool) 62 | = 63 | match index with 64 | | `Var lvalue -> 65 | (print_leftvalue ~bare) buf lvalue 66 | | `Int num -> 67 | bprintf buf "%d" num 68 | 69 | let rec print_arith buf (arith : arithmetic) = 70 | match arith with 71 | | `Var lvalue -> 72 | print_leftvalue buf lvalue ~bare: false 73 | | `Int num -> 74 | bprintf buf "%d" num 75 | | `ArithUnary (operator, arith) -> 76 | bprintf buf "%s^(%a^)" operator print_arith arith 77 | | `ArithBinary (operator, left, right) -> ( 78 | let operator = if String.equal operator "%" then "%%" else operator in 79 | bprintf buf "^(%a %s %a^)" 80 | print_arith left 81 | operator 82 | print_arith right 83 | ) 84 | 85 | let print_varstring buf (var : varstring) = 86 | match var with 87 | | `Var lvalue -> 88 | print_leftvalue buf lvalue ~bare: false 89 | | `Str str -> 90 | Buffer.add_string buf (escape str) 91 | | `Rawstr str -> 92 | Buffer.add_string buf str 93 | 94 | let print_varstrings buf (vars : varstrings) = 95 | List.iter vars ~f: (print_varstring buf) 96 | 97 | let print_parameters buf (params : parameters) = 98 | let comsume = ref false in 99 | List.iter params ~f: (fun vars -> 100 | match vars with 101 | | [] -> comsume := true 102 | | _ -> 103 | if !comsume then 104 | comsume := false 105 | else 106 | Buffer.add_char buf ' '; 107 | print_varstrings buf vars 108 | ) 109 | 110 | let print_comparison buf (condition : comparison) = 111 | match condition with 112 | | `TestCompare (operator, expr) -> 113 | bprintf buf "%s %a" 114 | operator 115 | print_varstrings expr 116 | | `UniCompare (operator, expr) -> ( 117 | let sign = match operator with 118 | | "" -> "EQU" 119 | | "!" -> "NEQ" 120 | | _ -> failwith ("Unknown operator: " ^ operator) 121 | in 122 | bprintf buf "%a %s 1" 123 | print_varstrings expr 124 | sign 125 | ) 126 | | `StrCompare (operator, left, right) -> ( 127 | let sign = match operator with 128 | | "==" | "===" -> "EQU" 129 | | "!=" | "!==" -> "NEQ" 130 | | ">" -> "GTR" 131 | | "<" -> "LSS" 132 | | ">=" -> "GEQ" 133 | | "<=" -> "LEQ" 134 | | _ -> failwith ("Unknown operator: " ^ operator) 135 | in 136 | bprintf buf "%a %s %a" 137 | print_varstrings left 138 | sign 139 | print_varstrings right 140 | ) 141 | 142 | let rec print_statement buf (stmt: statement) ~(indent: int) = 143 | Formatutil.print_indent buf indent; 144 | match stmt with 145 | | `Comment comment -> 146 | let len = String.length comment in 147 | bprintf buf "rem%s%s" ( 148 | if len = 0 || (len > 0 && Char.equal (String.get comment 0) ' ') then 149 | "" 150 | else 151 | " " 152 | ) comment 153 | | `Raw str -> 154 | Buffer.add_string buf str 155 | | `Label lbl -> 156 | bprintf buf ":%s" lbl 157 | | `Goto lbl -> 158 | bprintf buf "goto %s" lbl 159 | | `Assignment (lvalue, vars) -> 160 | bprintf buf "set %a=%a" 161 | (print_leftvalue ~bare: true) lvalue 162 | print_varstrings vars 163 | | `ArithAssign (lvalue, arith) -> 164 | bprintf buf "set /a %a=%a" 165 | (print_leftvalue ~bare: true) lvalue 166 | print_arith arith 167 | | `Call (name, params) -> 168 | bprintf buf "%a%a" 169 | print_varstrings name 170 | print_parameters params 171 | | `Output (lvalue, name, params) -> 172 | bprintf buf "for /f \"delims=\" %%%%i in ('%a%a') do set %a=%%%%i" 173 | print_varstrings name 174 | print_parameters params 175 | (print_leftvalue ~bare: true) lvalue 176 | | `If (condition, stmts) -> 177 | bprintf buf "if %a (\n%a\n%a)" 178 | print_comparison condition 179 | (print_statements ~indent: (indent + 2)) stmts 180 | Formatutil.print_indent indent 181 | | `IfElse (condition, then_stmts, else_stmts) -> 182 | bprintf buf "if %a (\n%a\n%a) else (\n%a\n%a)" 183 | print_comparison condition 184 | (print_statements ~indent: (indent + 2)) then_stmts 185 | Formatutil.print_indent indent 186 | (print_statements ~indent: (indent + 2)) else_stmts 187 | Formatutil.print_indent indent 188 | | `Empty -> () 189 | 190 | and print_statements: Buffer.t -> statements -> indent:int -> unit = 191 | Formatutil.print_statements ~f: print_statement 192 | 193 | let print (buf: Buffer.t) (program: t) :unit = 194 | print_statements buf program ~indent: 0 195 | -------------------------------------------------------------------------------- /lib/winbat_functions.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Winbat_ast 3 | 4 | let rec expand_command (name : varstrings) (args : parameters) = 5 | match name with 6 | | [`Str "bash"] -> 7 | `Empty 8 | | [`Str "batch"] -> ( 9 | match args with 10 | | [[`Str raw]] -> 11 | `Raw raw 12 | | _ -> 13 | failwith "batch raw command must have 1 argument of string literal." 14 | ) 15 | | [`Str "println"] -> ( 16 | match args with 17 | | [] -> 18 | `Call ([`Str "echo:"], []) 19 | | _ -> 20 | `Call ([`Str "echo"], args) 21 | ) 22 | | [`Str "print"] -> 23 | `Call ([`Str "echo | set /p ="], [] :: args) 24 | | [`Str "call"] -> ( 25 | match args with 26 | | cmd :: real_args -> 27 | expand_command cmd real_args 28 | | [] -> 29 | failwith "call must have at least 1 argument." 30 | ) 31 | | [`Str "readdir"] -> 32 | `Call ([`Str "dir /w"], args) 33 | | _ -> 34 | `Call (name, args) 35 | 36 | let rec expand_statement (stmt : statement) : statement = 37 | match stmt with 38 | | `Call (name, exprs) -> 39 | expand_command name exprs 40 | | `Output (lvalue, name, exprs) -> 41 | let expaned = expand_command name exprs in ( 42 | match expaned with 43 | | `Call (name, exprs) -> `Output (lvalue, name, exprs) 44 | | _ -> failwith (sprintf "command do not have a return value.") 45 | ) 46 | | `If (condition, stmts) -> 47 | `If (condition, expand_statements stmts) 48 | | `IfElse (condition, then_stmts, else_stmts) -> 49 | `IfElse (condition, 50 | expand_statements then_stmts, 51 | expand_statements else_stmts) 52 | | `Assignment _ 53 | | `ArithAssign _ 54 | | `Comment _ | `Raw _ | `Label _ | `Goto _ | `Empty -> stmt 55 | 56 | and expand_statements (stmts: statements) : statements = 57 | List.map stmts ~f: expand_statement 58 | 59 | let expand (ast : t) : t = 60 | expand_statements ast 61 | -------------------------------------------------------------------------------- /lib/winbat_transform.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Batsh_ast 3 | 4 | let rec split_expression 5 | ?(no_split_top = false) 6 | ?(split_call = true) 7 | ?(split_arith = true) 8 | ?(split_string = false) 9 | ?(split_list = true) 10 | ?(split_primitive = false) 11 | (expr : expression) 12 | ~(symtable : Symbol_table.t) 13 | ~(scope : Symbol_table.Scope.t) 14 | : (statement Dlist.t * expression) = 15 | let split_binary (left, right) ~split_arith ~split_string = 16 | let assignments_left, left = split_expression left 17 | ~split_arith ~split_string ~symtable ~scope 18 | in 19 | let assignments_right, right = split_expression right 20 | ~split_arith ~split_string ~symtable ~scope 21 | in 22 | Dlist.append assignments_left assignments_right, (left, right) 23 | in 24 | let split_when ~cond current_assignments new_expr = 25 | let split_expr_to_assignment assignments expr 26 | : (statement Dlist.t * expression) = 27 | if no_split_top then 28 | assignments, expr 29 | else 30 | let ident = Symbol_table.Scope.add_temporary_variable scope in 31 | let variable = Identifier ident in 32 | let assignments = Dlist.append 33 | assignments 34 | (Dlist.of_list [Assignment (variable, expr)]) 35 | in 36 | assignments, (Leftvalue variable) 37 | in 38 | if cond then 39 | split_expr_to_assignment current_assignments new_expr 40 | else 41 | current_assignments, new_expr 42 | in 43 | match expr with 44 | | Bool _ | Int _ | Float _ | Leftvalue _ -> 45 | split_when ~cond:split_primitive (Dlist.empty ()) expr 46 | | String _str -> 47 | split_when ~cond:split_string (Dlist.empty ()) expr 48 | | ArithUnary (operator, expr) -> 49 | let split = match operator with 50 | | "!" -> true 51 | | _ -> false 52 | in 53 | let assignments, expr = split_expression expr ~symtable ~scope 54 | ~split_arith:split 55 | ~split_string:true 56 | in 57 | split_when ~cond:split_arith assignments (ArithUnary (operator, expr)) 58 | | ArithBinary (operator, left, right) -> 59 | let split = match operator with 60 | | "===" | "!==" | ">" | "<" | ">=" | "<=" -> true 61 | | _ -> false 62 | in 63 | let assignments, (left, right) = split_binary (left, right) 64 | ~split_arith:split 65 | ~split_string:true 66 | in 67 | split_when ~cond:split_arith 68 | assignments (ArithBinary (operator, left, right)) 69 | | Concat (left, right) -> 70 | let assignments, (left, right) = split_binary (left, right) 71 | ~split_arith:true 72 | ~split_string:false 73 | in 74 | split_when ~cond:split_string assignments (Concat (left, right)) 75 | | StrCompare (operator, left, right) -> 76 | let assignments, (left, right) = split_binary (left, right) 77 | ~split_arith:true 78 | ~split_string:false 79 | in 80 | split_when ~cond:true assignments (StrCompare (operator, left, right)) 81 | | Call (ident, exprs) -> 82 | (* If this is a function call, then split all its arguments *) 83 | let split_primitive = Symbol_table.is_function symtable ident in 84 | let assignments, exprs = split_expressions exprs 85 | ~split_primitive ~symtable ~scope 86 | in 87 | split_when ~cond:split_call assignments (Call (ident, exprs)) 88 | | List exprs -> 89 | let assignments, exprs = split_expressions exprs 90 | ~split_primitive:false ~symtable ~scope 91 | in 92 | split_when ~cond:split_list assignments (List exprs) 93 | 94 | and split_expressions 95 | (exprs : expressions) 96 | ~(split_primitive : bool) 97 | ~(symtable : Symbol_table.t) 98 | ~(scope : Symbol_table.Scope.t) 99 | : (statement Dlist.t * expressions) = 100 | let assignments, exprs = List.fold exprs ~init: (Dlist.empty (), []) 101 | ~f: (fun (assignments_acc, exprs_acc) expr -> 102 | let assignments, expr = split_expression expr 103 | ~split_string:split_primitive 104 | ~split_primitive 105 | ~symtable ~scope 106 | in 107 | (Dlist.append assignments assignments_acc, expr :: exprs_acc) 108 | ) 109 | in 110 | assignments, List.rev exprs 111 | 112 | let rec split_statement 113 | (stmt : statement) 114 | ~(symtable : Symbol_table.t) 115 | ~(scope : Symbol_table.Scope.t) 116 | : statement = 117 | let prepend_assignments assignments stmt : statement = 118 | if Dlist.length assignments = 0 then 119 | stmt 120 | else 121 | Block (Dlist.to_list (Dlist.append assignments (Dlist.of_list [stmt]))) 122 | in 123 | match stmt with 124 | | Empty | Global _ | Comment _ | Return None -> 125 | stmt 126 | | Expression expr -> 127 | let assignments, expr = split_expression expr ~symtable ~scope 128 | ~split_call:false 129 | in 130 | prepend_assignments assignments (Expression expr) 131 | | Return (Some expr) -> 132 | let assignments, expr = split_expression expr ~symtable ~scope in 133 | prepend_assignments assignments (Return (Some expr)) 134 | | Assignment (lvalue, expr) -> 135 | let assignments, expr = split_expression expr 136 | ~symtable 137 | ~scope 138 | ~split_arith:false 139 | ~split_call:false 140 | ~split_list:false 141 | in 142 | prepend_assignments assignments (Assignment (lvalue, expr)) 143 | | If (expr, stmt) -> 144 | let assignments, expr = split_expression expr 145 | ~symtable 146 | ~scope 147 | ~no_split_top:true 148 | in 149 | let stmt = split_statement stmt ~symtable ~scope in 150 | prepend_assignments assignments (If (expr, stmt)) 151 | | IfElse (expr, then_stmt, else_stmt) -> 152 | let assignments, expr = split_expression expr 153 | ~symtable 154 | ~scope 155 | ~no_split_top:true 156 | in 157 | let then_stmt = split_statement then_stmt ~symtable ~scope in 158 | let else_stmt = split_statement else_stmt ~symtable ~scope in 159 | prepend_assignments assignments (IfElse (expr, then_stmt, else_stmt)) 160 | | While (expr, stmt) -> 161 | let assignments, expr = split_expression expr 162 | ~symtable 163 | ~scope 164 | ~no_split_top:true 165 | in 166 | let stmt = split_statement stmt ~symtable ~scope in 167 | prepend_assignments assignments (While (expr, stmt)) 168 | | Block stmts -> 169 | Block (split_statements stmts ~symtable ~scope) 170 | 171 | and split_statements 172 | (stmts : statements) 173 | ~(symtable : Symbol_table.t) 174 | ~(scope : Symbol_table.Scope.t) 175 | : statements = 176 | List.map stmts ~f: (split_statement ~symtable ~scope) 177 | 178 | let split_function 179 | (name, params, stmts) 180 | ~(symtable : Symbol_table.t) 181 | = 182 | let scope = Symbol_table.scope symtable name in 183 | let body = split_statements stmts ~symtable ~scope in 184 | name, params, body 185 | 186 | let split_toplevel 187 | (topl : toplevel) 188 | ~(symtable : Symbol_table.t) 189 | : toplevel = 190 | match topl with 191 | | Statement stmt -> 192 | Statement (split_statement stmt ~symtable 193 | ~scope: (Symbol_table.global_scope symtable)) 194 | | Function func -> 195 | Function (split_function func ~symtable) 196 | 197 | (* Split arithmetic expressions, string literals, string comparisons, 198 | list literals, and command calls *) 199 | let split (ast : Batsh_ast.t) ~(symtable : Symbol_table.t) : Batsh_ast.t = 200 | List.map ast ~f: (split_toplevel ~symtable) 201 | -------------------------------------------------------------------------------- /scripts/update.js: -------------------------------------------------------------------------------- 1 | var fs = require("fs"); 2 | var path = require("path"); 3 | 4 | var files = fs.readdirSync("tests"); 5 | for (var i = 0; i < files.length; i++) { 6 | var file = files[i]; 7 | var ext = path.extname(file); 8 | if (ext == '.batsh') { 9 | var name = path.basename(file, ext); 10 | console.log('./batsh bash tests/' + name + '.batsh > tests/bash/' + name + '.sh'); 11 | console.log('./batsh winbat tests/' + name + '.batsh > tests/batch/' + name + '.bat'); 12 | console.log('bash tests/bash/' + name + '.sh > tests/output/' + name + '.txt'); 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /src/batsh.ocp: -------------------------------------------------------------------------------- 1 | authors = ["Carbo Kuo "] 2 | license = ["BSD3"] 3 | version = "0.0.5" 4 | description = "A language that compiles to Bash and Windows Batch." 5 | 6 | begin library "batsh-lib" 7 | sort = true 8 | files = [ 9 | "bash.ml" 10 | "bash_ast.ml" (syntax = "sexplib-syntax") 11 | "bash_compile.ml" 12 | "bash_format.ml" 13 | "bash_functions.ml" 14 | "bash_transform.ml" 15 | "batsh_ast.ml" (syntax = "sexplib-syntax") 16 | "batsh_format.ml" 17 | "errors.ml" 18 | "formatutil.ml" 19 | "lexer.mll" 20 | "parser.ml" 21 | "parser_yacc.mly" 22 | "semantic_checker.ml" 23 | "symbol_table.ml" (syntax = "sexplib-syntax") 24 | "version.ml" (ocp2ml) 25 | "winbat.ml" 26 | "winbat_ast.ml" (syntax = "sexplib-syntax") 27 | "winbat_compile.ml" 28 | "winbat_format.ml" 29 | "winbat_functions.ml" 30 | "winbat_transform.ml" 31 | ] 32 | requires = ["core_kernel" "dlist" "sexplib-syntax"] 33 | bundle = [ "batsh" ] 34 | end 35 | 36 | begin program "batsh" 37 | files = [ 38 | "main.ml" 39 | ] 40 | requires = ["batsh-lib" "cmdliner"] 41 | end 42 | 43 | begin program "test" 44 | files = ["test.ml"] 45 | test_dir = "tests" 46 | test_asm = false 47 | test_byte = false 48 | requires = ["batsh-lib" "core" "oUnit" "threads"] 49 | install = false 50 | end 51 | 52 | begin syntax "sexplib-syntax" 53 | install = false 54 | requires = [ 55 | "camlp4o" 56 | "pa_sexp_conv.syntax" 57 | ] 58 | end 59 | 60 | (* sexplib syntax *) 61 | begin 62 | generated = true 63 | dirname = ["%{sexplib_DST_DIR}%"] 64 | begin library "pa_sexp_conv" 65 | files = ["pa_sexp_conv.ml"] 66 | requires = ["pa_type_conv"] 67 | end 68 | begin syntax "pa_sexp_conv.syntax" 69 | requires = ["pa_sexp_conv"] 70 | end 71 | (* type_conv syntax *) 72 | begin 73 | generated = true 74 | dirname = ["%{type_conv_DST_DIR}%"] 75 | begin library "pa_type_conv" 76 | is_before = ["pa_macro"] 77 | requires = ["camlp4-pa-o" "camlp4-pa-op"] 78 | files = ["pa_type_conv.ml"] 79 | end 80 | begin syntax "pa_type_conv.syntax" 81 | requires = ["pa_type_conv"] 82 | end 83 | end 84 | end 85 | 86 | begin library "threads" 87 | installed = true 88 | dirname = ["%{OCAMLLIB}%/threads"] 89 | has_byte = false 90 | byte += ["-custom"] 91 | end 92 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (public_name batsh) 4 | (flags (-w "+a-4-9-29-37-40-42-44-48-50-32" -ccopt -static)) 5 | (libraries batsh_lib 6 | cmdliner) 7 | ) 8 | -------------------------------------------------------------------------------- /src/main.ml: -------------------------------------------------------------------------------- 1 | open Core_kernel 2 | open Cmdliner 3 | open Batsh_lib 4 | 5 | (* Options common to all commands *) 6 | 7 | type output_type = Code | Ast | Symbols 8 | 9 | type copts = { 10 | output_type : output_type; 11 | output_file : string option 12 | } 13 | 14 | let copts_sect = "COMMON OPTIONS" 15 | 16 | let copts_t = 17 | let docs = copts_sect in 18 | 19 | let output_type = 20 | let doc = "Print abstract syntax tree instead." in 21 | let quiet = Ast, Arg.info ["ast"] ~docs ~doc in 22 | 23 | let doc = "Print symbol table instead." in 24 | let verbose = Symbols, Arg.info ["symbols"] ~docs ~doc in 25 | Arg.(last & vflag_all [Code] [quiet; verbose]) 26 | in 27 | 28 | let output_file = 29 | let doc = "Write output to $(docv)." in 30 | let opts = ["o"; "output"] in 31 | Arg.(value & opt (some string) None & info opts ~docs ~doc ~docv:"FILE") 32 | in 33 | let copts_cons output_type output_file = { output_type; output_file } in 34 | Term.(pure copts_cons $ output_type $ output_file) 35 | 36 | let get_outx opts = 37 | match opts.output_file with 38 | | Some filename -> Out_channel.create filename 39 | | None -> Out_channel.stdout 40 | 41 | let print_common opts ~batsh ~code ~ast = 42 | let outx = get_outx opts in 43 | match opts.output_type with 44 | | Code -> 45 | fprintf outx "%s\n" (Lazy.force code) 46 | | Ast -> 47 | fprintf outx "%a\n" Sexp.output_hum (Lazy.force ast) 48 | | Symbols -> 49 | let symtable_sexp = Symbol_table.sexp_of_t (Parser.symtable batsh) in 50 | fprintf outx "%a\n" Sexp.output_hum symtable_sexp 51 | 52 | (* Commands *) 53 | 54 | let parse_with_error (filename : string) : Parser.t = 55 | try 56 | Parser.create_from_file filename 57 | with 58 | | Parser.ParseError msg -> 59 | eprintf "%s\n" msg; 60 | exit 1 61 | | Parser.SemanticError msg -> 62 | eprintf "%s\n" msg; 63 | exit 1 64 | 65 | let bash = 66 | let doc = "Compile $(docv) to Bash script." in 67 | let t = 68 | Arg.(required & pos 0 (some non_dir_file) None & info [] ~doc ~docv:"FILE") 69 | in 70 | let cmd opts (filename : string) = 71 | let batsh = parse_with_error filename in 72 | let bash = 73 | try 74 | Bash.compile batsh 75 | with 76 | | Errors.SemanticError (msg, context) -> 77 | eprintf "%s\n%s\n" msg context; 78 | exit 1 79 | in 80 | let code = lazy (Bash.print bash) in 81 | let ast = lazy (Bash.ast bash |> Bash_ast.sexp_of_t) in 82 | print_common opts ~code ~ast ~batsh 83 | in 84 | Term.(pure cmd $ copts_t $ t), 85 | Term.info "bash" ~doc:"Compile to Bash script." 86 | 87 | let winbat = 88 | let doc = "Compile $(docv) to Windows Batch script." in 89 | let t = 90 | Arg.(required & pos 0 (some non_dir_file) None & info [] ~doc ~docv:"FILE") 91 | in 92 | let cmd opts (filename : string) = 93 | let batsh = parse_with_error filename in 94 | let winbat = 95 | try 96 | Winbat.compile batsh 97 | with 98 | | Errors.SemanticError (msg, context) -> 99 | eprintf "%s\n%s\n" msg context; 100 | exit 1 101 | in 102 | let code = lazy (Winbat.print winbat) in 103 | let ast = lazy (Winbat.ast winbat |> Winbat_ast.sexp_of_t) in 104 | print_common opts ~code ~ast ~batsh 105 | in 106 | Term.(pure cmd $ copts_t $ t), 107 | Term.info "winbat" ~doc:"Compile to Windows Batch script." 108 | 109 | let batsh = 110 | let doc = "Format $(docv)." in 111 | let t = 112 | Arg.(required & pos 0 (some non_dir_file) None & info [] ~doc ~docv:"FILE") 113 | in 114 | let cmd opts (filename : string) = 115 | let batsh = parse_with_error filename in 116 | let code = lazy (Parser.prettify batsh) in 117 | let ast = lazy (Parser.ast batsh |> Batsh_ast.sexp_of_t) in 118 | print_common opts ~code ~ast ~batsh 119 | in 120 | Term.(pure cmd $ copts_t $ t), 121 | Term.info "batsh" ~doc:"Format source file." 122 | 123 | let default_cmd = 124 | let doc = Version.description in 125 | Term.(ret (pure (fun _ -> `Help (`Plain, None)) $ (Term.pure ()) )), 126 | Term.info "batsh" ~version:Version.string ~doc 127 | 128 | let () = 129 | match Term.eval_choice default_cmd [bash; winbat; batsh] with 130 | | `Error _ -> exit 1 131 | | _ -> () 132 | -------------------------------------------------------------------------------- /src/version.ml: -------------------------------------------------------------------------------- 1 | let major = 0 2 | 3 | let minor = 0 4 | 5 | let patch = 7 6 | 7 | let string = Printf.sprintf "%d.%d.%d" major minor patch 8 | 9 | let description = "A language that compiles to Bash and Windows Batch" 10 | -------------------------------------------------------------------------------- /test_scripts/arith.batsh: -------------------------------------------------------------------------------- 1 | println(false); 2 | println(true); 3 | println(42); 4 | println(1 + (4 + 6) * 3); 5 | println(8 - 3 % 2); 6 | println(-9 - 9); 7 | println((2 + 8) / 3); 8 | println(2 === 2); 9 | println(6 !== 8); 10 | println(3 > 2); 11 | println(4 < 5); 12 | println(6 >= 2); 13 | println(19 <= 30); 14 | println(!true); 15 | println(!false); 16 | println(!(2 - 1)); 17 | -------------------------------------------------------------------------------- /test_scripts/array.batsh: -------------------------------------------------------------------------------- 1 | a = ["", "y", -1, 1]; 2 | a[0] = 2 * 9; 3 | a[2] = "abx"; 4 | a[4] = "5" ++ a[0]; 5 | println(a[0], a[1], a[2], a[3], a[4]); 6 | a = [1, 2, 3]; 7 | println(a[0], a[1], a[2]); 8 | println(("10" ++ a[0]) * 2); 9 | println(len(a)); 10 | println(len(a) * 8); 11 | //println([1, 2, 3]); 12 | -------------------------------------------------------------------------------- /test_scripts/assignment.batsh: -------------------------------------------------------------------------------- 1 | a = "Value: " ++ 1+(4+6)*3; 2 | println(a); 3 | b = 3 + 4; 4 | println(b); 5 | c = a; 6 | println(c); 7 | d = b ++ c; 8 | println(d); 9 | -------------------------------------------------------------------------------- /test_scripts/bash/arith.sh: -------------------------------------------------------------------------------- 1 | "echo" "-e" $((0)) 2 | "echo" "-e" $((1)) 3 | "echo" "-e" $((42)) 4 | "echo" "-e" $((1 + ((4 + 6) * 3))) 5 | "echo" "-e" $((8 - (3 % 2))) 6 | "echo" "-e" $((-9 - 9)) 7 | "echo" "-e" $(((2 + 8) / 3)) 8 | "echo" "-e" $((2 == 2)) 9 | "echo" "-e" $((6 != 8)) 10 | "echo" "-e" $((3 > 2)) 11 | "echo" "-e" $((4 < 5)) 12 | "echo" "-e" $((6 >= 2)) 13 | "echo" "-e" $((19 <= 30)) 14 | "echo" "-e" $((!1)) 15 | "echo" "-e" $((!0)) 16 | "echo" "-e" $((!(2 - 1))) 17 | -------------------------------------------------------------------------------- /test_scripts/bash/array.sh: -------------------------------------------------------------------------------- 1 | a=("" "y" $((-1)) $((1))) 2 | a[0]=$((2 * 9)) 3 | a[2]="abx" 4 | a[4]="5""${a[0]}" 5 | "echo" "-e" "${a[0]}" "${a[1]}" "${a[2]}" "${a[3]}" "${a[4]}" 6 | a=($((1)) $((2)) $((3))) 7 | "echo" "-e" "${a[0]}" "${a[1]}" "${a[2]}" 8 | _0="10""${a[0]}" 9 | "echo" "-e" $(($_0 * 2)) 10 | "echo" "-e" "${#a[@]}" 11 | _1="${#a[@]}" 12 | "echo" "-e" $(($_1 * 8)) 13 | #println([1, 2, 3]); 14 | -------------------------------------------------------------------------------- /test_scripts/bash/assignment.sh: -------------------------------------------------------------------------------- 1 | a="Value: "$((1 + ((4 + 6) * 3))) 2 | "echo" "-e" "$a" 3 | b=$((3 + 4)) 4 | "echo" "-e" "$b" 5 | c="$a" 6 | "echo" "-e" "$c" 7 | d="$b""$c" 8 | "echo" "-e" "$d" 9 | -------------------------------------------------------------------------------- /test_scripts/bash/block.sh: -------------------------------------------------------------------------------- 1 | #Level 0 Start 2 | "echo" "-e" "Hello" 3 | #Level 1 Start 4 | "echo" "-e" "Lo" 5 | #Level 2 Start 6 | "echo" "-e" "and behold" 7 | #Level 2 End 8 | #Level 1 End 9 | "echo" "-e" "End" 10 | #Level 0 End 11 | -------------------------------------------------------------------------------- /test_scripts/bash/command.sh: -------------------------------------------------------------------------------- 1 | "echo" "-e" "Println Called" 2 | cmd="ec""ho" 3 | "$cmd" "Echo Called" 4 | retval=$("echo" "Value 100%") 5 | "echo" "-e" "$retval" 6 | -------------------------------------------------------------------------------- /test_scripts/bash/comment.sh: -------------------------------------------------------------------------------- 1 | a=$((3)) 2 | # This is comment 1 3 | a=$(($a * 5)) 4 | # This is comment 2 5 | "echo" "-e" "$a" 6 | #This is comment 3 7 | -------------------------------------------------------------------------------- /test_scripts/bash/exists.sh: -------------------------------------------------------------------------------- 1 | [ -e "Makefile" ] 2 | ex=$((!$?)) 3 | "echo" "-e" "$ex" 4 | [ -e "Makefile" ] 5 | if [ -e "Makefile" ]; then 6 | "echo" "-e" "Yes" 7 | fi 8 | if [ -e "none" ]; then 9 | "echo" "-e" "Impossible" 10 | else 11 | "echo" "-e" "No" 12 | fi 13 | -------------------------------------------------------------------------------- /test_scripts/bash/function.sh: -------------------------------------------------------------------------------- 1 | # Function call 2 | function func1 { 3 | local p1 4 | local p2 5 | p1="$1" 6 | p2="$2" 7 | "echo" "-e" "$p1" "$p2" 8 | } 9 | "func1" "Hello" "World" 10 | # Global and local variables 11 | v1="Global V1" 12 | v2="Global V2" 13 | v3="Global V3" 14 | function func2 { 15 | local v1 16 | local p 17 | p="$1" 18 | v1="Local ""$p" 19 | "echo" "-e" "$v1" 20 | "echo" "-e" "$v2" 21 | 22 | v3="V3 Modified." 23 | } 24 | "func2" "Var" 25 | "echo" "-e" "$v1" 26 | "echo" "-e" "$v3" 27 | # Return value 28 | function func3 { 29 | local num 30 | num="$1" 31 | "echo" "-ne" $(($num + 41)) 32 | return 33 | } 34 | "func3" $((4)) 35 | "echo" "-e" 36 | ret=$("func3" $((1))) 37 | "echo" "-e" "Returned:" "$ret" 38 | # Argument containing space 39 | function g { 40 | local text 41 | text="$1" 42 | "echo" "-ne" "$text" 43 | return 44 | } 45 | function f { 46 | local text 47 | text="$1" 48 | "echo" "-ne" $("g" "$text") 49 | return 50 | } 51 | test=$("f" "Param with space") 52 | "echo" "-e" "$test" 53 | -------------------------------------------------------------------------------- /test_scripts/bash/if.sh: -------------------------------------------------------------------------------- 1 | if [ $((2 < 10)) == 1 ]; then 2 | "echo" "-e" "Yes" 3 | fi 4 | if [ $((1)) == 1 ]; then 5 | if [ $((0)) == 1 ]; then 6 | v=$((4 + 1)) 7 | else 8 | v=$((2)) 9 | fi 10 | else 11 | - 12 | fi 13 | "echo" "-e" "$v" 14 | if [ $((2 > 1)) == 1 ]; then 15 | "echo" "-e" "True" 16 | fi 17 | if [ $((1 == 12)) == 1 ]; then 18 | "echo" "-e" "No" 19 | fi 20 | if [ "a" == "b" ]; then 21 | "echo" "-e" "No" 22 | else 23 | "echo" "-e" "a is not b" 24 | fi 25 | num=$((43)) 26 | if [ "43" == "$num" ]; then 27 | "echo" "-e" "43 == num" 28 | fi 29 | _0="43" 30 | if [ $(($_0 == $num)) == 1 ]; then 31 | "echo" "-e" "43 === num" 32 | fi 33 | -------------------------------------------------------------------------------- /test_scripts/bash/recursion.sh: -------------------------------------------------------------------------------- 1 | function loop { 2 | local num 3 | num="$1" 4 | "echo" "-e" "$num" 5 | if [ $(($num > 0)) == 1 ]; then 6 | "loop" $(($num - 1)) 7 | fi 8 | } 9 | "loop" $((10)) 10 | function fact { 11 | local num 12 | local _0 13 | num="$1" 14 | if [ $(($num == 0)) == 1 ]; then 15 | "echo" "-ne" $((1)) 16 | return 17 | else 18 | _0=$("fact" $(($num - 1))) 19 | "echo" "-ne" $(($_0 * $num)) 20 | return 21 | fi 22 | } 23 | "echo" "-e" $("fact" $((5))) 24 | function fibonacci { 25 | local _1 26 | local num 27 | local _0 28 | num="$1" 29 | if [ $(($num == 0)) == 1 ]; then 30 | "echo" "-ne" $((0)) 31 | return 32 | else 33 | if [ $(($num == 1)) == 1 ]; then 34 | "echo" "-ne" $((1)) 35 | return 36 | else 37 | _0=$("fibonacci" $(($num - 2))) 38 | _1=$("fibonacci" $(($num - 1))) 39 | "echo" "-ne" $(($_0 + $_1)) 40 | return 41 | fi 42 | fi 43 | } 44 | i=$((0)) 45 | while [ $(($i < 7)) == 1 ]; do 46 | "echo" "-e" $("fibonacci" "$i") 47 | i=$(($i + 1)) 48 | done 49 | -------------------------------------------------------------------------------- /test_scripts/bash/string.sh: -------------------------------------------------------------------------------- 1 | "echo" "-e" "BYVoid" 2 | "echo" "-e" "Slash/" 3 | "echo" "-e" "Backslash\\" 4 | "echo" "-e" "Quote\"'" 5 | "echo" "-e" "Tab Tab" 6 | #println("Newline\nLine2"); 7 | #println("!"); 8 | "echo" "-e" "http://""www.""byvoid"".com" 9 | "echo" "-e" $((6 / 2))"BYVoid"$((3 + 5)) 10 | _0="3" 11 | "echo" "-e" $((3 + $_0)) 12 | _1="3" 13 | "echo" "-e" $((3 + $_1))"2" 14 | _2="3""2" 15 | "echo" "-e" $((3 + $_2)) 16 | [ "BYVoid" == "BYVoid" ] 17 | _3=$((!$?)) 18 | "echo" "-e" "$_3" 19 | -------------------------------------------------------------------------------- /test_scripts/bash/while.sh: -------------------------------------------------------------------------------- 1 | i=$((0)) 2 | while [ $(($i < 5)) == 1 ]; do 3 | "echo" "-ne" "$i"" " 4 | i=$(($i + 1)) 5 | done 6 | "echo" "-e" 7 | # Fibonacci 8 | n=$((0)) 9 | i=$((0)) 10 | j=$((1)) 11 | while [ $(($n < 40)) == 1 ]; do 12 | k=$(($i + $j)) 13 | i="$j" 14 | j="$k" 15 | n=$(($n + 1)) 16 | "echo" "-e" "$k" 17 | done 18 | -------------------------------------------------------------------------------- /test_scripts/batch/arith.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | echo 0 6 | echo 1 7 | echo 42 8 | set /a _0=^(1 + ^(^(4 + 6^) * 3^)^) 9 | echo !_0! 10 | set /a _1=^(8 - ^(3 %% 2^)^) 11 | echo !_1! 12 | set /a _2=^(-9 - 9^) 13 | echo !_2! 14 | set /a _3=^(^(2 + 8^) / 3^) 15 | echo !_3! 16 | if 2 EQU 2 ( 17 | set /a _4=1 18 | ) else ( 19 | set /a _4=0 20 | ) 21 | echo !_4! 22 | if 6 NEQ 8 ( 23 | set /a _5=1 24 | ) else ( 25 | set /a _5=0 26 | ) 27 | echo !_5! 28 | if 3 GTR 2 ( 29 | set /a _6=1 30 | ) else ( 31 | set /a _6=0 32 | ) 33 | echo !_6! 34 | if 4 LSS 5 ( 35 | set /a _7=1 36 | ) else ( 37 | set /a _7=0 38 | ) 39 | echo !_7! 40 | if 6 GEQ 2 ( 41 | set /a _8=1 42 | ) else ( 43 | set /a _8=0 44 | ) 45 | echo !_8! 46 | if 19 LEQ 30 ( 47 | set /a _9=1 48 | ) else ( 49 | set /a _9=0 50 | ) 51 | echo !_9! 52 | if 1 NEQ 1 ( 53 | set /a _10=1 54 | ) else ( 55 | set /a _10=0 56 | ) 57 | echo !_10! 58 | if 0 NEQ 1 ( 59 | set /a _11=1 60 | ) else ( 61 | set /a _11=0 62 | ) 63 | echo !_11! 64 | set /a _12=^(2 - 1^) 65 | if !_12! NEQ 1 ( 66 | set /a _13=1 67 | ) else ( 68 | set /a _13=0 69 | ) 70 | echo !_13! 71 | -------------------------------------------------------------------------------- /test_scripts/batch/array.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | set a_0= 6 | set a_1=y 7 | set /a a_2=-1 8 | set /a a_3=1 9 | set /a a_0=^(2 * 9^) 10 | set a_2=abx 11 | set a_4=5!a_0! 12 | echo !a_0! !a_1! !a_2! !a_3! !a_4! 13 | set /a a_0=1 14 | set /a a_1=2 15 | set /a a_2=3 16 | echo !a_0! !a_1! !a_2! 17 | set _0=10!a_0! 18 | set /a _1=^(!_0! * 2^) 19 | echo !_1! 20 | for /f "delims=" %%i in ('len !a!') do set _2=%%i 21 | echo !_2! 22 | for /f "delims=" %%i in ('len !a!') do set _3=%%i 23 | set /a _4=^(!_3! * 8^) 24 | echo !_4! 25 | rem println([1, 2, 3]); 26 | -------------------------------------------------------------------------------- /test_scripts/batch/assignment.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | set /a _0=^(1 + ^(^(4 + 6^) * 3^)^) 6 | set a=Value: !_0! 7 | echo !a! 8 | set /a b=^(3 + 4^) 9 | echo !b! 10 | set c=!a! 11 | echo !c! 12 | set d=!b!!c! 13 | echo !d! 14 | -------------------------------------------------------------------------------- /test_scripts/batch/block.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | rem Level 0 Start 6 | echo Hello 7 | rem Level 1 Start 8 | echo Lo 9 | rem Level 2 Start 10 | echo and behold 11 | rem Level 2 End 12 | rem Level 1 End 13 | echo End 14 | rem Level 0 End 15 | -------------------------------------------------------------------------------- /test_scripts/batch/command.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | echo Println Called 6 | set cmd=echo 7 | !cmd! Echo Called 8 | for /f "delims=" %%i in ('echo Value 100%%') do set retval=%%i 9 | echo !retval! 10 | -------------------------------------------------------------------------------- /test_scripts/batch/comment.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | set /a a=3 6 | rem This is comment 1 7 | set /a a=^(!a! * 5^) 8 | rem This is comment 2 9 | echo !a! 10 | rem This is comment 3 11 | -------------------------------------------------------------------------------- /test_scripts/batch/exists.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | if exist Makefile ( 6 | set /a ex=1 7 | ) else ( 8 | set /a ex=0 9 | ) 10 | echo !ex! 11 | if exist Makefile ( 12 | 13 | ) else ( 14 | 15 | ) 16 | if exist Makefile ( 17 | echo Yes 18 | ) 19 | if exist none ( 20 | echo Impossible 21 | ) else ( 22 | echo No 23 | ) 24 | -------------------------------------------------------------------------------- /test_scripts/batch/function.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | rem Function call 6 | set _1=World 7 | set _0=Hello 8 | call :func1 _6 0 _0 _1 9 | echo | set /p ^=!_6! 10 | rem Global and local variables 11 | set v1=Global V1 12 | set v2=Global V2 13 | set v3=Global V3 14 | set _2=Var 15 | call :func2 _7 0 _2 16 | echo | set /p ^=!_7! 17 | echo !v1! 18 | echo !v3! 19 | rem Return value 20 | set /a _3=4 21 | call :func3 _8 0 _3 22 | echo | set /p ^=!_8! 23 | echo: 24 | set /a _4=1 25 | call :func3 _9 0 _4 26 | set ret=!_9! 27 | echo Returned: !ret! 28 | rem Argument containing space 29 | set _5=Param with space 30 | call :f _10 0 _5 31 | set test=!_10! 32 | echo !test! 33 | 34 | goto :EOF 35 | :func1 36 | set p1_%~2=!%~3! 37 | set p2_%~2=!%~4! 38 | echo !p1_%~2! !p2_%~2! 39 | 40 | goto :EOF 41 | :func2 42 | set p_%~2=!%~3! 43 | set v1_%~2=Local !p_%~2! 44 | echo !v1_%~2! 45 | echo !v2! 46 | set v3=V3 Modified. 47 | 48 | goto :EOF 49 | :func3 50 | set num_%~2=!%~3! 51 | set /a _0_%~2=^(!num_%~2! + 41^) 52 | set %~1=!_0_%~2! 53 | goto :EOF 54 | 55 | goto :EOF 56 | :g 57 | set text_%~2=!%~3! 58 | set %~1=!text_%~2! 59 | goto :EOF 60 | 61 | goto :EOF 62 | :f 63 | set text_%~2=!%~3! 64 | set _0_%~2=!text_%~2! 65 | set /a _2_%~2=^(1 + %~2^) 66 | call :g _3_%~2 !_2_%~2! _0_%~2 67 | set _1_%~2=!_3_%~2! 68 | set %~1=!_1_%~2! 69 | goto :EOF 70 | -------------------------------------------------------------------------------- /test_scripts/batch/if.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | if 2 LSS 10 ( 6 | echo Yes 7 | ) 8 | if 1 EQU 1 ( 9 | if 1 NEQ 1 ( 10 | set /a v=^(4 + 1^) 11 | ) else ( 12 | set /a v=2 13 | ) 14 | ) else ( 15 | 16 | ) 17 | echo !v! 18 | if 2 GTR 1 ( 19 | echo True 20 | ) 21 | if 1 EQU 12 ( 22 | echo No 23 | ) 24 | if a EQU b ( 25 | echo No 26 | ) else ( 27 | echo a is not b 28 | ) 29 | set /a num=43 30 | if 43 EQU !num! ( 31 | echo 43 ^=^= num 32 | ) 33 | set _0=43 34 | if !_0! EQU !num! ( 35 | echo 43 ^=^=^= num 36 | ) 37 | -------------------------------------------------------------------------------- /test_scripts/batch/recursion.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | set /a _0=10 6 | call :loop _5 0 _0 7 | echo | set /p ^=!_5! 8 | set /a _1=5 9 | call :fact _6 0 _1 10 | set _2=!_6! 11 | echo !_2! 12 | set /a i=0 13 | :WHILE_8 14 | if !i! LSS 7 ( 15 | set _3=!i! 16 | call :fibonacci _7 0 _3 17 | set _4=!_7! 18 | echo !_4! 19 | set /a i=^(!i! + 1^) 20 | goto WHILE_8 21 | ) 22 | 23 | goto :EOF 24 | :loop 25 | set num_%~2=!%~3! 26 | echo !num_%~2! 27 | if !num_%~2! GTR 0 ( 28 | set /a _0_%~2=^(!num_%~2! - 1^) 29 | set /a _1_%~2=^(1 + %~2^) 30 | call :loop _2_%~2 !_1_%~2! _0_%~2 31 | echo | set /p ^=!_2_%~2! 32 | ) 33 | 34 | goto :EOF 35 | :fact 36 | set num_%~2=!%~3! 37 | if !num_%~2! EQU 0 ( 38 | set %~1=1 39 | goto :EOF 40 | ) else ( 41 | set /a _0_%~2=^(!num_%~2! - 1^) 42 | set /a _3_%~2=^(1 + %~2^) 43 | call :fact _4_%~2 !_3_%~2! _0_%~2 44 | set _1_%~2=!_4_%~2! 45 | set /a _2_%~2=^(!_1_%~2! * !num_%~2!^) 46 | set %~1=!_2_%~2! 47 | goto :EOF 48 | ) 49 | 50 | goto :EOF 51 | :fibonacci 52 | set num_%~2=!%~3! 53 | if !num_%~2! EQU 0 ( 54 | set %~1=0 55 | goto :EOF 56 | ) else ( 57 | if !num_%~2! EQU 1 ( 58 | set %~1=1 59 | goto :EOF 60 | ) else ( 61 | set /a _0_%~2=^(!num_%~2! - 2^) 62 | set /a _5_%~2=^(1 + %~2^) 63 | call :fibonacci _6_%~2 !_5_%~2! _0_%~2 64 | set _1_%~2=!_6_%~2! 65 | set /a _2_%~2=^(!num_%~2! - 1^) 66 | set /a _7_%~2=^(1 + %~2^) 67 | call :fibonacci _8_%~2 !_7_%~2! _2_%~2 68 | set _3_%~2=!_8_%~2! 69 | set /a _4_%~2=^(!_1_%~2! + !_3_%~2!^) 70 | set %~1=!_4_%~2! 71 | goto :EOF 72 | ) 73 | ) 74 | -------------------------------------------------------------------------------- /test_scripts/batch/string.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | echo BYVoid 6 | echo Slash/ 7 | echo Backslash\ 8 | echo Quote^"^' 9 | echo Tab Tab 10 | rem println("Newline\nLine2"); 11 | rem println("!"); 12 | echo http://www.byvoid.com 13 | set /a _0=^(6 / 2^) 14 | set /a _1=^(3 + 5^) 15 | echo !_0!BYVoid!_1! 16 | set _2=3 17 | set /a _3=^(3 + !_2!^) 18 | echo !_3! 19 | set _4=3 20 | set /a _5=^(3 + !_4!^) 21 | echo !_5!2 22 | set _6=32 23 | set /a _7=^(3 + !_6!^) 24 | echo !_7! 25 | if BYVoid EQU BYVoid ( 26 | set /a _8=1 27 | ) else ( 28 | set /a _8=0 29 | ) 30 | echo !_8! 31 | -------------------------------------------------------------------------------- /test_scripts/batch/while.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | setlocal EnableDelayedExpansion 3 | setlocal EnableExtensions 4 | 5 | set /a i=0 6 | :WHILE_0 7 | if !i! LSS 5 ( 8 | echo | set /p ^=!i! 9 | set /a i=^(!i! + 1^) 10 | goto WHILE_0 11 | ) 12 | echo: 13 | rem Fibonacci 14 | set /a n=0 15 | set /a i=0 16 | set /a j=1 17 | :WHILE_1 18 | if !n! LSS 40 ( 19 | set /a k=^(!i! + !j!^) 20 | set i=!j! 21 | set j=!k! 22 | set /a n=^(!n! + 1^) 23 | echo !k! 24 | goto WHILE_1 25 | ) 26 | -------------------------------------------------------------------------------- /test_scripts/block.batsh: -------------------------------------------------------------------------------- 1 | //Level 0 Start 2 | println("Hello"); 3 | { 4 | //Level 1 Start 5 | println("Lo"); 6 | { 7 | //Level 2 Start 8 | println("and behold"); 9 | //Level 2 End 10 | } 11 | //Level 1 End 12 | } 13 | println("End"); 14 | //Level 0 End 15 | -------------------------------------------------------------------------------- /test_scripts/command.batsh: -------------------------------------------------------------------------------- 1 | call("println", "Println Called"); 2 | cmd = "ec" ++ "ho"; 3 | call(cmd, "Echo Called"); 4 | retval = echo("Value 100%"); 5 | println(retval); 6 | -------------------------------------------------------------------------------- /test_scripts/comment.batsh: -------------------------------------------------------------------------------- 1 | a = 3; 2 | // This is comment 1 3 | a = a * 5; 4 | // This is comment 2 5 | println(a); 6 | //This is comment 3 7 | -------------------------------------------------------------------------------- /test_scripts/exists.batsh: -------------------------------------------------------------------------------- 1 | ex = exists("Makefile"); 2 | println(ex); 3 | exists("Makefile"); 4 | if (exists("Makefile")) { 5 | println("Yes"); 6 | } 7 | if (exists("none")) { 8 | println("Impossible"); 9 | } else { 10 | println("No"); 11 | } 12 | -------------------------------------------------------------------------------- /test_scripts/function.batsh: -------------------------------------------------------------------------------- 1 | // Function call 2 | function func1(p1, p2) { 3 | println(p1, p2); 4 | } 5 | func1("Hello", "World"); 6 | 7 | // Global and local variables 8 | v1 = "Global V1"; 9 | v2 = "Global V2"; 10 | v3 = "Global V3"; 11 | function func2(p) { 12 | v1 = "Local " ++ p; 13 | println(v1); 14 | println(v2); 15 | global v3; 16 | v3 = "V3 Modified."; 17 | } 18 | func2("Var"); 19 | println(v1); 20 | println(v3); 21 | 22 | // Return value 23 | function func3(num) { 24 | return num + 41; 25 | } 26 | func3(4); 27 | println(); 28 | ret = func3(1); 29 | println("Returned:", ret); 30 | 31 | // Argument containing space 32 | function g(text) { 33 | return text; 34 | } 35 | function f(text) { 36 | return g(text); 37 | } 38 | test = f("Param with space"); 39 | println(test); 40 | -------------------------------------------------------------------------------- /test_scripts/if.batsh: -------------------------------------------------------------------------------- 1 | if (2 < 10) { 2 | println("Yes"); 3 | } 4 | 5 | if (true) { 6 | if (false){ 7 | v=(4 + 1); 8 | } else { 9 | v = 2; 10 | } 11 | } else { 12 | 13 | } 14 | println(v); 15 | 16 | if (2 > 1) 17 | println("True"); 18 | 19 | if (1 === 12) { 20 | println("No"); 21 | } 22 | 23 | if ("a" == "b") { 24 | println("No"); 25 | } else { 26 | println("a is not b"); 27 | } 28 | 29 | num = 43; 30 | if ("43" == num) { 31 | println("43 == num"); 32 | } 33 | if ("43" === num) { 34 | println("43 === num"); 35 | } 36 | -------------------------------------------------------------------------------- /test_scripts/output/arith.txt: -------------------------------------------------------------------------------- 1 | 0 2 | 1 3 | 42 4 | 31 5 | 7 6 | -18 7 | 3 8 | 1 9 | 1 10 | 1 11 | 1 12 | 1 13 | 1 14 | 0 15 | 1 16 | 0 17 | -------------------------------------------------------------------------------- /test_scripts/output/array.txt: -------------------------------------------------------------------------------- 1 | 18 y abx 1 518 2 | 1 2 3 3 | 202 4 | 3 5 | 24 6 | -------------------------------------------------------------------------------- /test_scripts/output/assignment.txt: -------------------------------------------------------------------------------- 1 | Value: 31 2 | 7 3 | Value: 31 4 | 7Value: 31 5 | -------------------------------------------------------------------------------- /test_scripts/output/block.txt: -------------------------------------------------------------------------------- 1 | Hello 2 | Lo 3 | and behold 4 | End 5 | -------------------------------------------------------------------------------- /test_scripts/output/command.txt: -------------------------------------------------------------------------------- 1 | Println Called 2 | Echo Called 3 | Value 100% 4 | -------------------------------------------------------------------------------- /test_scripts/output/comment.txt: -------------------------------------------------------------------------------- 1 | 15 2 | -------------------------------------------------------------------------------- /test_scripts/output/exists.txt: -------------------------------------------------------------------------------- 1 | 1 2 | Yes 3 | No 4 | -------------------------------------------------------------------------------- /test_scripts/output/function.txt: -------------------------------------------------------------------------------- 1 | Hello World 2 | Local Var 3 | Global V2 4 | Global V1 5 | V3 Modified. 6 | 45 7 | Returned: 42 8 | Param with space 9 | -------------------------------------------------------------------------------- /test_scripts/output/if.txt: -------------------------------------------------------------------------------- 1 | Yes 2 | 2 3 | True 4 | a is not b 5 | 43 == num 6 | 43 === num 7 | -------------------------------------------------------------------------------- /test_scripts/output/recursion.txt: -------------------------------------------------------------------------------- 1 | 10 2 | 9 3 | 8 4 | 7 5 | 6 6 | 5 7 | 4 8 | 3 9 | 2 10 | 1 11 | 0 12 | 120 13 | 0 14 | 1 15 | 1 16 | 2 17 | 3 18 | 5 19 | 8 20 | -------------------------------------------------------------------------------- /test_scripts/output/string.txt: -------------------------------------------------------------------------------- 1 | BYVoid 2 | Slash/ 3 | Backslash\ 4 | Quote"' 5 | Tab Tab 6 | http://www.byvoid.com 7 | 3BYVoid8 8 | 6 9 | 62 10 | 35 11 | 1 12 | -------------------------------------------------------------------------------- /test_scripts/output/while.txt: -------------------------------------------------------------------------------- 1 | 0 1 2 3 4 2 | 1 3 | 2 4 | 3 5 | 5 6 | 8 7 | 13 8 | 21 9 | 34 10 | 55 11 | 89 12 | 144 13 | 233 14 | 377 15 | 610 16 | 987 17 | 1597 18 | 2584 19 | 4181 20 | 6765 21 | 10946 22 | 17711 23 | 28657 24 | 46368 25 | 75025 26 | 121393 27 | 196418 28 | 317811 29 | 514229 30 | 832040 31 | 1346269 32 | 2178309 33 | 3524578 34 | 5702887 35 | 9227465 36 | 14930352 37 | 24157817 38 | 39088169 39 | 63245986 40 | 102334155 41 | 165580141 42 | -------------------------------------------------------------------------------- /test_scripts/recursion.batsh: -------------------------------------------------------------------------------- 1 | function loop(num) { 2 | println(num); 3 | if (num > 0) { 4 | loop(num - 1); 5 | } 6 | } 7 | loop(10); 8 | 9 | function fact(num) { 10 | if (num === 0) { 11 | return 1; 12 | } else { 13 | return fact(num - 1) * num; 14 | } 15 | } 16 | println(fact(5)); 17 | 18 | function fibonacci(num) { 19 | if (num === 0) { 20 | return 0; 21 | } else if (num === 1) { 22 | return 1; 23 | } else { 24 | return fibonacci(num - 2) + fibonacci(num - 1); 25 | } 26 | } 27 | 28 | i = 0; 29 | while (i < 7) { 30 | println(fibonacci(i)); 31 | i = i + 1; 32 | } 33 | -------------------------------------------------------------------------------- /test_scripts/string.batsh: -------------------------------------------------------------------------------- 1 | println("BYVoid"); 2 | println("Slash/"); 3 | println("Backslash\\"); 4 | println("Quote\"'"); 5 | println("Tab\tTab"); 6 | //println("Newline\nLine2"); 7 | //println("!"); 8 | println("http://" ++ "www." ++ ("byvoid" ++ ".com")); 9 | println(6 / 2 ++ "BYVoid" ++ 3 + 5); 10 | println(3 + "3"); 11 | println(3 + "3" ++ "2"); 12 | println(3 + ("3" ++ "2")); 13 | println("BYVoid" == "BYVoid"); 14 | -------------------------------------------------------------------------------- /test_scripts/while.batsh: -------------------------------------------------------------------------------- 1 | i = 0; 2 | while (i < 5) { 3 | print(i ++ " "); 4 | i = i + 1; 5 | } 6 | println(); 7 | 8 | // Fibonacci 9 | n = 0; 10 | i = 0; 11 | j = 1; 12 | while (n < 40) { 13 | k = i + j; 14 | i = j; 15 | j = k; 16 | n = n + 1; 17 | println(k); 18 | } 19 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (flags (-w "+a-4-9-29-37-40-42-44-48-50-32")) 4 | (libraries batsh_lib 5 | core 6 | ounit2) 7 | ) 8 | -------------------------------------------------------------------------------- /tests/main.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Unix.Process_channels 3 | open OUnit 4 | open Batsh_lib 5 | 6 | let script_dir = "test_scripts" 7 | 8 | let drop_carrage_return str = 9 | let buffer = Buffer.create (String.length str) in 10 | String.iter str ~f:(fun ch -> 11 | if not (Char.equal ch '\r') then 12 | Buffer.add_char buffer ch 13 | ); 14 | Buffer.contents buffer 15 | 16 | let test_result expected output exit_status = 17 | let exit_message = Unix.Exit_or_signal.to_string_hum exit_status in 18 | assert_equal "exited normally" exit_message ~printer: Fn.id; 19 | assert_equal expected output ~printer: Fn.id 20 | 21 | let test_bash name batsh expected = 22 | let bash = Bash.compile batsh in 23 | let code = (Bash.print bash) ^ "\n" in 24 | (* Code *) 25 | let inx = In_channel.create (script_dir ^ "/bash/" ^ name ^ ".sh") in 26 | let code_expected = In_channel.input_all inx in 27 | In_channel.close inx; 28 | assert_equal code_expected code ~printer: Fn.id; 29 | (* Run result *) 30 | let stdout, stdin = Unix.open_process "bash" in 31 | Out_channel.output_string stdin code; 32 | Out_channel.close stdin; 33 | let output = In_channel.input_all stdout in 34 | let exit_status = Unix.close_process (stdout, stdin) in 35 | test_result expected output exit_status 36 | 37 | let test_winbat name batsh expected = 38 | let winbat = Winbat.compile batsh in 39 | let code = (Winbat.print winbat) ^ "\n" in 40 | (* Code *) 41 | let inx = In_channel.create (script_dir ^ "/batch/" ^ name ^ ".bat") in 42 | let code_expected = In_channel.input_all inx in 43 | In_channel.close inx; 44 | assert_equal code_expected code ~printer: Fn.id; 45 | (* Run result *) 46 | let filename = Filename.temp_file "batsh" ".bat" in 47 | let outx = Out_channel.create filename in 48 | Out_channel.output_string outx code; 49 | Out_channel.close outx; 50 | 51 | let cmd = "wine cmd /c " ^ filename in 52 | let channels = Unix.open_process_full cmd ~env:[||] in 53 | let output_raw = In_channel.input_all channels.stdout in 54 | let output = drop_carrage_return output_raw in 55 | let exit_status = Unix.close_process_full channels in 56 | test_result expected output exit_status 57 | 58 | let get_expected name = 59 | let answer_filename = script_dir ^ "/output/" ^ name ^ ".txt" in 60 | let inx = In_channel.create answer_filename in 61 | let expected = In_channel.input_all inx in 62 | In_channel.close inx; 63 | expected 64 | 65 | let test name func _ = 66 | let expected = get_expected name in 67 | let filename = script_dir ^ "/" ^ name ^ ".batsh" in 68 | let batsh = Parser.create_from_file filename in 69 | func name batsh expected 70 | 71 | let test_cases = "Batsh Unit Tests" >::: [ 72 | "[Bash]Comment" >:: test "comment" test_bash; 73 | "[Bash]Block" >:: test "block" test_bash; 74 | "[Bash]Arith" >:: test "arith" test_bash; 75 | "[Bash]Assignment" >:: test "assignment" test_bash; 76 | "[Bash]Array" >:: test "array" test_bash; 77 | "[Bash]String" >:: test "string" test_bash; 78 | "[Bash]If" >:: test "if" test_bash; 79 | "[Bash]While" >:: test "while" test_bash; 80 | "[Bash]Function" >:: test "function" test_bash; 81 | "[Bash]Recursion" >:: test "recursion" test_bash; 82 | "[Bash]Command" >:: test "command" test_bash; 83 | "[Bash]Exists" >:: test "exists" test_bash; 84 | "[Winbat]Comment" >:: test "comment" test_winbat; 85 | "[Winbat]Block" >:: test "block" test_winbat; 86 | "[Winbat]Arith" >:: test "arith" test_winbat; 87 | "[Winbat]Assignment" >:: test "assignment" test_winbat; 88 | (* "[Winbat]Array" >:: test "array" test_winbat; *) 89 | "[Winbat]String" >:: test "string" test_winbat; 90 | "[Winbat]If" >:: test "if" test_winbat; 91 | "[Winbat]While" >:: test "while" test_winbat; 92 | "[Winbat]Function" >:: test "function" test_winbat; 93 | "[Winbat]Recursion" >:: test "recursion" test_winbat; 94 | "[Winbat]Command" >:: test "command" test_winbat; 95 | "[Winbat]Exists" >:: test "exists" test_winbat; 96 | ] 97 | 98 | let _ = 99 | run_test_tt_main test_cases 100 | --------------------------------------------------------------------------------