├── examples ├── print1.silk ├── arith.silk ├── add2.silk ├── nestfunc.silk ├── func_typespec.silk ├── var.silk ├── id.silk ├── literals.silk └── factorial.silk ├── .gitignore ├── error.ml ├── lib.c ├── main.ml ├── test.sh ├── syntax.ml ├── typ.ml ├── compile.sh ├── lexer.mll ├── README.md ├── OMakeroot ├── parser.mly ├── OMakefile ├── typify.ml └── codegen.ml /examples/print1.silk: -------------------------------------------------------------------------------- 1 | def main() = { 2 | print(1) 3 | } 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | tags* 2 | *.omc 3 | *.ll 4 | .omakedb* 5 | _build/ 6 | -------------------------------------------------------------------------------- /examples/arith.silk: -------------------------------------------------------------------------------- 1 | def main() = { 2 | print((1+3)*4-5*5/5) 3 | } 4 | -------------------------------------------------------------------------------- /examples/add2.silk: -------------------------------------------------------------------------------- 1 | def add(a, b) = a + b 2 | 3 | def main() = { 4 | print(add(1, 2)) 5 | } 6 | -------------------------------------------------------------------------------- /examples/nestfunc.silk: -------------------------------------------------------------------------------- 1 | def main() = { 2 | def f() = 10 # Unit -> I32 3 | print(f() + 1) 4 | } 5 | -------------------------------------------------------------------------------- /error.ml: -------------------------------------------------------------------------------- 1 | exception SilkError of string 2 | exception TypeError of string 3 | exception Unimplemented 4 | -------------------------------------------------------------------------------- /examples/func_typespec.silk: -------------------------------------------------------------------------------- 1 | def f(a: I32) = a 2 | 3 | def main() = { 4 | f(10) 5 | # f(10 == 10) type error 6 | } 7 | -------------------------------------------------------------------------------- /examples/var.silk: -------------------------------------------------------------------------------- 1 | def main() = { 2 | def a : I32 = 10 3 | def a = a + 20 4 | def b = -a + 5 5 | print(b + 5) 6 | } 7 | -------------------------------------------------------------------------------- /examples/id.silk: -------------------------------------------------------------------------------- 1 | # id has type 'x -> 'x 2 | # polymorphism!!!! 3 | def id(x) = x 4 | 5 | def main() = { 6 | print(id(true)) 7 | print(id(1)) 8 | } 9 | -------------------------------------------------------------------------------- /examples/literals.silk: -------------------------------------------------------------------------------- 1 | def main() = { 2 | def i:I32 = 10 3 | def b:Bool = true 4 | def b2:Bool = false 5 | 6 | print(i) 7 | print(b) 8 | print(b2) 9 | } 10 | -------------------------------------------------------------------------------- /examples/factorial.silk: -------------------------------------------------------------------------------- 1 | def fact(n:I32):I32 = { 2 | if n == 0 { 3 | 1 4 | } 5 | else { 6 | n * fact(n-1) 7 | } 8 | } 9 | 10 | def main() = { 11 | print(fact(5)) 12 | } 13 | -------------------------------------------------------------------------------- /lib.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | void print__Int(int n) { 4 | printf("%d\n", n); 5 | } 6 | 7 | void print__Bool(int n) { 8 | if (n) { 9 | printf("true\n"); 10 | } 11 | else { 12 | printf("false\n"); 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /main.ml: -------------------------------------------------------------------------------- 1 | open Codegen 2 | open Typify 3 | open Syntax 4 | open Typ 5 | 6 | (* main *) 7 | let () = 8 | 9 | (* parse input *) 10 | let program = Parser.toplevel Lexer.main (Lexing.from_channel stdin) in 11 | 12 | (* type check *) 13 | let typed_program = Typify.typify program in 14 | 15 | (* codegen *) 16 | let llvm_module = Codegen.codegen typed_program in 17 | 18 | (* output llvm ir *) 19 | let _ = 20 | if Array.length Sys.argv > 1 then 21 | begin 22 | (* assertion *) 23 | Llvm_analysis.assert_valid_module llvm_module; 24 | (* output bitcode to file *) 25 | let oc = open_out Sys.argv.(1) in 26 | Llvm_bitwriter.output_bitcode oc llvm_module |> ignore; 27 | close_out oc; 28 | () 29 | end 30 | else 31 | (* output ir to stderr *) 32 | Llvm.dump_module llvm_module 33 | in 34 | () 35 | 36 | -------------------------------------------------------------------------------- /test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | COMPILE=./compile.sh 4 | 5 | # shouldbe input shouldbeed_output 6 | function shouldbe { 7 | elf=$(mktemp) 8 | echo -e "$1" | $COMPILE - "$elf" 9 | if [ "$?" != "0" ]; then 10 | echo -e "\e[33m compile failed $1\e[m" 11 | return 1 12 | fi 13 | 14 | r=$($elf) 15 | 16 | if [ "$(echo -e "$r"|md5sum)" != "$(echo -e "$2"|md5sum)" ]; then 17 | echo -e "\e[33mexpected:\n\e[m$2\n\e[33moutput:\e[m\n$r\e[m" 18 | return 1 19 | fi 20 | } 21 | 22 | function example { 23 | shouldbe "$(cat "examples/$1")" "$2" && echo -e "\e[32mpass $1\e[m" || echo -e "\e[33mfailed $1\e[m" 24 | } 25 | 26 | 27 | example "print1.silk" "1" 28 | example "arith.silk" "11" 29 | example "var.silk" "-20" 30 | example "add2.silk" "3" 31 | example "id.silk" "true\n1" 32 | example "func_typespec.silk" "" 33 | example "nestfunc.silk" "11" 34 | example "literals.silk" "10\ntrue\nfalse" 35 | example "factorial.silk" "120" 36 | 37 | -------------------------------------------------------------------------------- /syntax.ml: -------------------------------------------------------------------------------- 1 | open Typ 2 | 3 | type typ_exp = string 4 | 5 | type exp = 6 | |Unit 7 | |Int of int 8 | |Bool of bool 9 | 10 | |Call of string * exp list 11 | |Assign of string * typ_exp option * exp 12 | |Var of string 13 | |If of exp * exp * exp 14 | |MultiExpr of exp list 15 | |Defun of string * (string * typ_exp option) list * typ_exp option * exp 16 | 17 | type exp_t = 18 | |TUnit of typ 19 | |TInt of int * typ 20 | |TBool of bool * typ 21 | 22 | |TCall of string * exp_t list * typ 23 | |TAssign of string * exp_t * typ 24 | |TVar of string * typ 25 | |TIf of exp_t * exp_t * exp_t * typ 26 | |TMultiExpr of exp_t list * typ 27 | |TDefun of string * string list * exp_t * typ 28 | 29 | let typeof exp = 30 | match exp with 31 | |TUnit(t) -> t 32 | |TInt (_, t) -> t 33 | |TBool(_, t) -> t 34 | |TCall (_, _, t) -> t 35 | |TAssign (_, _, t) -> t 36 | |TVar (_, t) -> t 37 | |TIf (_, _, _, t) -> t 38 | |TMultiExpr (_, t) -> t 39 | |TDefun (_, _, _, t) -> t 40 | 41 | -------------------------------------------------------------------------------- /typ.ml: -------------------------------------------------------------------------------- 1 | open Error 2 | 3 | type typ = 4 | |UnitT 5 | |IntT 6 | |BoolT 7 | |VarT of string 8 | |FunT of typ * typ 9 | 10 | let is_funt t = 11 | match t with 12 | |FunT(_, _) -> true 13 | |_ -> false 14 | 15 | let arg_type funt = 16 | match funt with 17 | |FunT(argt, _) -> argt 18 | |_ -> raise (TypeError "function type requried") 19 | 20 | let ret_type funt = 21 | match funt with 22 | |FunT(_, rett) -> rett 23 | |_ -> raise (TypeError "function type requried") 24 | 25 | let make_funt argtypes rettype = 26 | let rec make_funt' argtypes rettype = 27 | match argtypes with 28 | |argt::xs -> 29 | FunT(argt, make_funt' xs rettype) 30 | |[] -> rettype 31 | in 32 | match argtypes with 33 | |[] -> make_funt' [UnitT] rettype 34 | |_ -> make_funt' argtypes rettype 35 | 36 | 37 | let rec string_of_type t = 38 | match t with 39 | |UnitT -> "Unit" 40 | |IntT -> "Int" 41 | |BoolT -> "Bool" 42 | |VarT(name) -> name 43 | |FunT(a, r) -> (string_of_type a)^"->"^(string_of_type r) 44 | 45 | -------------------------------------------------------------------------------- /compile.sh: -------------------------------------------------------------------------------- 1 | PROGRAM=./silk 2 | LIBSRC=./lib.c 3 | 4 | function compile { 5 | lib=$(mktemp --suffix .ll) 6 | clang -c -S -emit-llvm "$LIBSRC" -o "$lib" 7 | if [ "$?" != "0" ]; then 8 | echo -e "\e[33m compile failed $1\e[m" 9 | exit 1 10 | fi 11 | 12 | ll=$(mktemp --suffix .ll) 13 | cat "$1" | timeout 5 "$PROGRAM" "$ll" 14 | if [ "$?" != "0" ]; then 15 | echo -e "\e[33m compile failed $1\e[m" 16 | exit 1 17 | fi 18 | 19 | bc=$(mktemp --suffix .bc) 20 | llvm-link "$ll" "$lib" -S -o "$bc" 21 | if [ "$?" != "0" ]; then 22 | echo -e "\e[33m compile failed $1\e[m" 23 | exit 1 24 | fi 25 | 26 | s=$(mktemp --suffix .s) 27 | llc "$bc" -o "$s" 28 | if [ "$?" != "0" ]; then 29 | echo -e "\e[33m compile failed $1\e[m" 30 | exit 1 31 | fi 32 | 33 | clang -no-pie "$s" -o "$2" 34 | if [ "$?" != "0" ]; then 35 | echo -e "\e[33m compile failed $1\e[m" 36 | exit 1 37 | fi 38 | } 39 | function run { 40 | o=$(mktemp) 41 | compile $1 $o 42 | "$o" 43 | } 44 | 45 | case $1 in 46 | "run") run $2;; 47 | *) compile $@ 48 | esac 49 | 50 | -------------------------------------------------------------------------------- /lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | let reserve = [ 3 | ("def", Parser.DEF); 4 | ("if", Parser.IF); 5 | ("else", Parser.ELSE); 6 | 7 | ("true", Parser.TRUE); 8 | ("false", Parser.FALSE); 9 | ] 10 | } 11 | rule main = parse 12 | |[' ' '\n']+ { main lexbuf } (* skip space *) 13 | |['0'-'9']+ as num 14 | { Parser.NUM (int_of_string num) } 15 | 16 | |"#" { comment lexbuf } 17 | 18 | |"=" { Parser.EQUAL } 19 | |"+" { Parser.PLUS } 20 | |"*" { Parser.ASTERISK } 21 | |"-" { Parser.MINUS } 22 | |"/" { Parser.SLASH } 23 | 24 | |"(" { Parser.LPAREN } 25 | |")" { Parser.RPAREN } 26 | |"{" { Parser.LBRACE } 27 | |"}" { Parser.RBRACE } 28 | 29 | |"==" { Parser.EQEQ } 30 | |"!=" { Parser.NOTEQ } 31 | |"<" { Parser.LANGLE } 32 | |">" { Parser.RANGLE } 33 | |"<=" { Parser.LANGLE_EQ } 34 | |">=" { Parser.RANGLE_EQ } 35 | 36 | |"," { Parser.COMMA } 37 | |":" { Parser.COLON } 38 | 39 | |['a'-'z''A'-'z''0'-'9''_']+ as id 40 | { 41 | try List.assoc id reserve 42 | with _ -> Parser.ID (id) 43 | } 44 | 45 | |eof { Parser.EOF } 46 | 47 | and comment = parse 48 | |['\n'] { main lexbuf } 49 | |_ { comment lexbuf } 50 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # silk 2 | 3 | Silk is a practice language based on LLVM which respect to [cotton](https://github.com/eliza0x/cotton/). 4 | 5 | ## try it 6 | 7 | 1. `git clone` 8 | 2. `opam install omake menhir llvm` 9 | 3. `omake` 10 | 4. `./silk` 11 | 12 | ## requirements 13 | 14 | - mehir 15 | - llvm 16 | 17 | ## usage 18 | 19 | If you run `./silk` without any parameters, the binary will read silk program from stdin until EOF. And will output LLVM IR to stdout. 20 | 21 | Also `./silk` can run with oen parameter that filename to output LLVM bitcode. 22 | 23 | ## syntax 24 | 25 | A simple factorial program from [examples](https://github.com/theoldmoon0602/silk/blob/master/examples/factorial.silk). 26 | 27 | ``` 28 | def fact(n:I32):I32 = { 29 | if n == 0 { 30 | 1 31 | } 32 | else { 33 | n * fact(n-1) 34 | } 35 | } 36 | 37 | def main() = { 38 | print(fact(5)) 39 | } 40 | ``` 41 | 42 | this program will output `120`. 43 | 44 | ## features 45 | 46 | - program starts with `main` function 47 | - integer literals have `int32_t` type 48 | - function returns last evaluated value 49 | - if/else are expression 50 | - type inference is available 51 | - fully typed recursive function is available 52 | - mutual recursive function is not available even fully typed 53 | - nested function available (not closure! so could not capture variables) 54 | 55 | ## future works 56 | 57 | - [x] make blocks as expr 58 | - [x] specify type 59 | - [x] boolean 60 | - [ ] float type 61 | - [x] create function scope 62 | 63 | and so on 64 | 65 | - [x] type inference 66 | - [ ] closure 67 | 68 | ## Author 69 | theoldmoon0602 70 | 71 | ## LICENSE 72 | 73 | This repository does not have any licenses (any problems?). 74 | -------------------------------------------------------------------------------- /OMakeroot: -------------------------------------------------------------------------------- 1 | ######################################################################## 2 | # Permission is hereby granted, free of charge, to any person 3 | # obtaining a copy of this file, to deal in the File without 4 | # restriction, including without limitation the rights to use, 5 | # copy, modify, merge, publish, distribute, sublicense, and/or 6 | # sell copies of the File, and to permit persons to whom the 7 | # File is furnished to do so, subject to the following condition: 8 | # 9 | # THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 10 | # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 11 | # OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 12 | # IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, 13 | # DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR 14 | # OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR 15 | # THE USE OR OTHER DEALINGS IN THE FILE. 16 | 17 | ######################################################################## 18 | # The standard OMakeroot file. 19 | # You will not normally need to modify this file. 20 | # By default, your changes should be placed in the 21 | # OMakefile in this directory. 22 | # 23 | # If you decide to modify this file, note that it uses exactly 24 | # the same syntax as the OMakefile. 25 | # 26 | 27 | # 28 | # Include the standard installed configuration files. 29 | # Any of these can be deleted if you are not using them, 30 | # but you probably want to keep the Common file. 31 | # 32 | open build/C 33 | open build/OCaml 34 | open build/LaTeX 35 | 36 | # 37 | # The command-line variables are defined *after* the 38 | # standard configuration has been loaded. 39 | # 40 | DefineCommandVars() 41 | 42 | # 43 | # Include the OMakefile in this directory. 44 | # 45 | .SUBDIRS: . 46 | -------------------------------------------------------------------------------- /parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | open Syntax 3 | %} 4 | 5 | %token EQUAL 6 | %token COMMA COLON 7 | %token PLUS MINUS ASTERISK SLASH 8 | %token LANGLE RANGLE LANGLE_EQ RANGLE_EQ EQEQ NOTEQ 9 | %token LPAREN RPAREN LBRACE RBRACE 10 | %token EOF 11 | %token DEF 12 | %token IF ELSE 13 | %token TRUE FALSE 14 | %token NUM 15 | %token ID 16 | 17 | %start toplevel 18 | %type toplevel 19 | 20 | %% 21 | 22 | toplevel: 23 | |Expr* EOF { MultiExpr($1) } 24 | 25 | Expr: 26 | |AssignExpr { $1 } 27 | 28 | AssignExpr: 29 | |DEF id=ID EQUAL exp=Arithmetic { Assign(id, None, exp) } 30 | |DEF id=ID COLON t=Typ EQUAL exp=Arithmetic { Assign(id, Some(t), exp) } 31 | |Arithmetic { $1 } 32 | 33 | Arithmetic: 34 | |Arithmetic PLUS Term { Call ("+", [$1; $3]) } 35 | |Arithmetic MINUS Term { Call ("-", [$1; $3]) } 36 | |Term { $1 } 37 | 38 | Term: 39 | |Term ASTERISK Factor { Call ("*", [$1; $3]) } 40 | |Term SLASH Factor { Call ("/", [$1; $3]) } 41 | |Compare { $1 } 42 | 43 | Compare: 44 | |Compare EQEQ Factor { Call ("==", [$1; $3]) } 45 | |Compare NOTEQ Factor { Call ("!=", [$1; $3]) } 46 | |Compare LANGLE Factor { Call ("<", [$1; $3]) } 47 | |Compare RANGLE Factor { Call (">", [$1; $3]) } 48 | |Compare LANGLE_EQ Factor { Call ("<=", [$1; $3]) } 49 | |Compare RANGLE_EQ Factor { Call (">=", [$1; $3]) } 50 | |Factor { $1 } 51 | 52 | Factor: 53 | |MINUS Factor { Call("__neg", [$2]) } 54 | |Num { $1 } 55 | |IfExpr { $1 } 56 | |fname = ID LPAREN args = separated_list(COMMA, Expr) RPAREN { Call (fname, args) } 57 | |LBRACE list(Expr) RBRACE { MultiExpr ( $2 ) } 58 | |LPAREN Expr RPAREN { $2 } 59 | |DefunExpr { $1 } 60 | 61 | DefunExpr: 62 | |DEF name = ID LPAREN args = separated_list(COMMA, Arg) 63 | RPAREN EQUAL body = Expr { Defun(name, args, None, body) } 64 | |DEF name = ID LPAREN args = separated_list(COMMA, Arg) 65 | RPAREN COLON rett=Typ EQUAL body = Expr { Defun(name, args, Some(rett), body) } 66 | 67 | Arg: 68 | |name=ID { (name, None) } 69 | |name=ID COLON t=Typ { (name, Some(t)) } 70 | 71 | IfExpr: 72 | |IF cond = Expr t = Expr ELSE e = Expr { If(cond, t, e) } 73 | 74 | Num: 75 | |ID { Var $1 } 76 | |NUM { Int $1 } 77 | |TRUE { Bool(true) } 78 | |FALSE { Bool(false) } 79 | 80 | Typ: 81 | |ID { $1 } 82 | 83 | -------------------------------------------------------------------------------- /OMakefile: -------------------------------------------------------------------------------- 1 | ######################################################################## 2 | # Permission is hereby granted, free of charge, to any person 3 | # obtaining a copy of this file, to deal in the File without 4 | # restriction, including without limitation the rights to use, 5 | # copy, modify, merge, publish, distribute, sublicense, and/or 6 | # sell copies of the File, and to permit persons to whom the 7 | # File is furnished to do so, subject to the following condition: 8 | # 9 | # THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 10 | # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 11 | # OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 12 | # IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, 13 | # DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR 14 | # OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR 15 | # THE USE OR OTHER DEALINGS IN THE FILE. 16 | 17 | ######################################################################## 18 | # The standard OMakefile. 19 | # You will usually need to modify this file for your project. 20 | 21 | # Delete this line once you have configured this file 22 | # eprintln($(CWD)/OMakefile is not configured) 23 | 24 | ######################################################################## 25 | # Phony targets are scoped, so you probably want to declare them first. 26 | # 27 | 28 | # .PHONY: all install clean 29 | 30 | ######################################################################## 31 | # Subdirectories. 32 | # You may want to include some subdirectories in this project. 33 | # If so, define the subdirectory targets and uncomment this section. 34 | # 35 | 36 | # .SUBDIRS: 37 | 38 | ######################################################################## 39 | # C configuration. 40 | # Delete this section if you are not building C files. 41 | # 42 | 43 | ################################################ 44 | # Configuration. You might want to modify any of these 45 | # configuration variables. 46 | # 47 | 48 | # CFLAGS += 49 | # ASFLAGS += 50 | # LDFLAGS += 51 | # INCLUDES += 52 | 53 | ################################################ 54 | # Uncomment the following section if you want 55 | # to build a C program in the current directory. 56 | # 57 | 58 | # CFILES[] = 59 | # file1 60 | # main 61 | # 62 | # MAIN = main 63 | # 64 | # .DEFAULT: $(CProgram $(MAIN), $(CFILES)) 65 | 66 | ################################################ 67 | # Uncomment the following section if you want to build a C library 68 | # in the current directory. 69 | # 70 | 71 | # LIBFILES[] = 72 | # file1 73 | # file2 74 | # 75 | # LIB = libxxx 76 | # 77 | # .DEFAULT: $(StaticCLibrary $(LIB), $(LIBFILES)) 78 | 79 | ######################################################################## 80 | # OCaml configuration. 81 | # Delete this section if you are not building OCaml files. 82 | # 83 | 84 | ################################################ 85 | # Configuration. You may want to modify any of these configuration 86 | # variables. 87 | # 88 | 89 | 90 | # 91 | # Include path 92 | # 93 | # OCAMLINCLUDES += 94 | 95 | # 96 | # Compile native or byte code? 97 | # 98 | # The default values are defined as follows: 99 | # 100 | NATIVE_ENABLED = true # $(OCAMLOPT_EXISTS) 101 | BYTE_ENABLED = true # $(not $(OCAMLOPT_EXISTS)) 102 | 103 | # 104 | # Various options 105 | # 106 | # OCAMLFLAGS += 107 | # OCAMLCFLAGS += 108 | # OCAMLOPTFLAGS += 109 | # OCAML_LINK_FLAGS += 110 | # OCAML_BYTE_LINK_FLAGS += 111 | # OCAML_NATIVE_LINK_FLAGS += 112 | 113 | 114 | ################################################ 115 | # Build an OCaml library 116 | # 117 | 118 | # FILES[] = 119 | # file1 120 | # file2 121 | # 122 | # LIB = main 123 | # 124 | # .DEFAULT: $(OCamlLibrary $(LIB), $(FILES)) 125 | 126 | # 127 | # This project requires ocamlfind (default - false). 128 | # 129 | USE_OCAMLFIND = true 130 | 131 | OCAMLPACKS[] = 132 | llvm 133 | llvm.bitwriter 134 | llvm.analysis 135 | 136 | if $(not $(OCAMLFIND_EXISTS)) 137 | eprintln(This project requires ocamlfind, but is was not found.) 138 | eprintln(You need to install ocamlfind and run "omake --configure".) 139 | exit 1 140 | 141 | ################################################ 142 | # Generated files 143 | # 144 | # Workaround for the fact that ocamldep does not pay attention to .mll 145 | # and .mly files. 146 | # 147 | MENHIR_ENABLED = true 148 | MENHIR_FLAGS += --infer 149 | OCamlGeneratedFiles(parser.mli parser.ml lexer.ml) 150 | ################################################ 151 | # Build an OCaml program 152 | # 153 | 154 | FILES[] = 155 | lexer 156 | parser 157 | error 158 | typ 159 | syntax 160 | typify 161 | codegen 162 | main 163 | 164 | PROGRAM = silk 165 | # OCAML_LIBS += 166 | # OCAML_CLIBS += 167 | # OCAML_OTHER_LIBS += 168 | # OCAML_LIB_FLAGS += 169 | # 170 | .DEFAULT: $(OCamlProgram $(PROGRAM), $(FILES)) 171 | .PHONY: clean test 172 | clean: 173 | rm -rf $(filter-proper-targets $(ls R, .)) 174 | test: $(PROGRAM) test.sh 175 | ./test.sh 176 | -------------------------------------------------------------------------------- /typify.ml: -------------------------------------------------------------------------------- 1 | open Typ 2 | open Syntax 3 | open Error 4 | 5 | type typenv = (string, typ) Hashtbl.t list (* ("x", IntT); ("y", VarT("'y")); ... *) 6 | type typsubst = (string * typ) list (* ("'y", IntT); ("'z", VarT("'y")); ... *) 7 | 8 | let builtin_optypes = [ 9 | ("print", FunT(VarT("'__print"), UnitT) ); 10 | ("+", FunT(IntT, FunT(IntT, IntT)) ); 11 | ("-", FunT(IntT, FunT(IntT, IntT)) ); 12 | ("__neg", FunT(IntT, IntT) ); 13 | ("*", FunT(IntT, FunT(IntT, IntT)) ); 14 | ("/", FunT(IntT, FunT(IntT, IntT)) ); 15 | ("==", FunT(IntT, FunT(IntT, BoolT)) ); 16 | ("!=", FunT(IntT, FunT(IntT, BoolT)) ); 17 | ("<", FunT(IntT, FunT(IntT, BoolT)) ); 18 | (">", FunT(IntT, FunT(IntT, BoolT)) ); 19 | ("<=", FunT(IntT, FunT(IntT, BoolT)) ); 20 | (">=", FunT(IntT, FunT(IntT, BoolT)) ); 21 | ] 22 | 23 | let builtin_types = [ 24 | ("I32", IntT); 25 | ("Bool", BoolT); 26 | ] 27 | 28 | 29 | let rec string_of_typenv typenv = 30 | match typenv with 31 | |typtbl::xs -> 32 | let s = Hashtbl.fold (fun k t s -> s^k^":"^(string_of_type t)^", ") typtbl "" in 33 | s^"\n"^(string_of_typenv xs) 34 | |[] -> "" 35 | 36 | let type_of_name name = 37 | match List.assoc_opt name builtin_types with 38 | |Some(t) -> t 39 | |None -> raise (SilkError ("Undefined type:" ^ name)) 40 | 41 | let type_of_name_opt name = 42 | match name with 43 | |Some(name) -> Some(type_of_name name) 44 | |_ -> None 45 | 46 | (* add var with type into current scope *) 47 | let add_var name typ typenv = 48 | match typenv with 49 | |typtbl::xs -> begin 50 | let typtbl = Hashtbl.copy typtbl in 51 | Hashtbl.add typtbl name typ; 52 | typtbl::xs 53 | end 54 | |[] -> begin 55 | let typtbl = Hashtbl.create 10 in 56 | Hashtbl.add typtbl name typ; 57 | [typtbl] 58 | end 59 | 60 | let lookup_scope name typenv = 61 | match Hashtbl.find_opt (List.hd typenv) name with 62 | |Some(typ) -> Some(typ) 63 | |None -> None 64 | 65 | 66 | let rec lookup name typenv = 67 | match typenv with 68 | |typtbl::xs -> begin 69 | match Hashtbl.find_opt typtbl name with 70 | |Some(typ) -> Some(typ) 71 | |None -> lookup name xs 72 | end 73 | |[] -> None 74 | 75 | 76 | let rec newtypevar name typenv = 77 | match lookup name typenv with 78 | |Some(_) -> newtypevar ("'"^name) typenv 79 | |None -> VarT(name) 80 | 81 | let rec occurs var_name typ = 82 | if var_name = typ then true 83 | else 84 | match typ with 85 | |FunT(argt, rett) -> (occurs var_name argt) || (occurs var_name rett) 86 | |_ -> false 87 | 88 | (* replace t with ty *) 89 | let rec replace_type (t: typ) name (ty: typ): typ = 90 | match t with 91 | |VarT(name') -> if name = name' then ty else t 92 | |FunT(argt, rett) -> FunT(replace_type argt name ty, replace_type rett name ty) 93 | |_ -> t 94 | 95 | let apply_substs (t: typ) (s: typsubst): typ = 96 | List.fold_right (fun (name, ty) t -> replace_type t name ty) s t 97 | 98 | 99 | let rec unify_one (t1: typ) (t2: typ): typsubst = 100 | match (t1, t2) with 101 | |(VarT(name1), VarT(name2)) -> 102 | if name1 = name2 then [] 103 | else [(name2, t1)] 104 | |(VarT(name), _) -> 105 | if occurs t1 t2 then raise (TypeError "not unifiable") 106 | else [(name, t2)] 107 | |(_, VarT(name)) -> 108 | if occurs t2 t1 then raise (TypeError "not unifiable") 109 | else [(name, t1)] 110 | |(FunT(argt1, rett1), FunT(argt2, rett2)) -> 111 | unify [(argt1, argt2); (rett1, rett2)] 112 | |(_, _) -> 113 | if t1 = t2 then [] 114 | else raise (TypeError ("type mismatched:"^(string_of_type t1)^", "^(string_of_type t2))) 115 | 116 | and unify typs = 117 | match typs with 118 | |(t1, t2)::xs -> 119 | let substs = unify xs in 120 | let subst = unify_one (apply_substs t1 substs) (apply_substs t2 substs) in 121 | subst @ substs (* list concatenation *) 122 | |[] -> [] 123 | 124 | let subst_typenv (typenv:typenv) (subst:typsubst) :typenv = 125 | List.map 126 | (fun typtbl -> 127 | Hashtbl.filter_map_inplace 128 | (fun name t -> 129 | let t = (apply_substs t subst) in 130 | Some(t)) 131 | typtbl; 132 | typtbl) 133 | typenv 134 | 135 | let rec typify_expr exp typenv = 136 | match exp with 137 | |Unit -> (TUnit(UnitT), typenv) 138 | |Int(v) -> (TInt(v, IntT), typenv) 139 | |Bool(v) -> (TBool(v, BoolT), typenv) 140 | |Call(name, args) -> 141 | let f = 142 | match List.assoc_opt name builtin_optypes with 143 | |Some(f') -> f' (* builtin *) 144 | |None -> begin 145 | match lookup name typenv with 146 | |Some(f') when is_funt f' -> f' (* user defined *) 147 | |_ -> begin 148 | print_string (string_of_typenv typenv); 149 | raise (SilkError ("Undefined function: " ^ name)) 150 | end 151 | end 152 | in 153 | (* unifying argument types and return ret_t *) 154 | let rec typify_call args f typenv subst = 155 | match args with 156 | |arg::xs -> 157 | let t = arg_type f in 158 | let arg_t, typenv = typify_expr arg typenv in 159 | let subst = subst @ (unify [(t, typeof arg_t)]) in 160 | let argts, r_t, typenv = typify_call xs (ret_type f) typenv subst in 161 | (arg_t::argts, apply_substs r_t subst, typenv) 162 | |[] -> ([], f, typenv) 163 | in 164 | let args = 165 | match args with 166 | |[] -> [Unit] 167 | |_ -> args 168 | in 169 | let argts, rett, typenv = typify_call args f typenv [] in 170 | (TCall(name, argts, rett), typenv) 171 | |If(cond, then_exp, else_exp) -> 172 | let cond_t, typenv = typify_expr cond typenv in 173 | let typenv = subst_typenv typenv (unify [(BoolT, typeof cond_t)]) in 174 | let then_t, typenv = typify_expr then_exp typenv in 175 | let else_t, typenv = typify_expr else_exp typenv in 176 | let typenv = subst_typenv typenv (unify [(typeof then_t, typeof else_t)]) in 177 | let then_t, typenv = typify_expr then_exp typenv in 178 | (TIf(cond_t, then_t, else_t, typeof then_t), typenv) 179 | |Var(name) -> begin 180 | match lookup name typenv with 181 | |Some(t) -> (TVar(name, t), typenv) 182 | |None -> raise (SilkError ("variable is undefined:"^name)) 183 | end 184 | |Assign(name, t_specifier, exp) -> begin 185 | let expt, typenv = typify_expr exp typenv in 186 | let typenv = 187 | match (lookup_scope name typenv, type_of_name_opt t_specifier) with 188 | |(Some(t), None) -> (* reassign (should have same type) *) 189 | subst_typenv typenv (unify [(t, typeof expt)]) 190 | |(Some(t), Some(t')) when t = t' -> (* reassign (same type) *) 191 | subst_typenv typenv (unify [(t, typeof expt)]) 192 | |(None, Some(t)) -> (* new assign with type specifier *) 193 | let typenv = subst_typenv typenv (unify [(t, typeof expt)]) in 194 | add_var name t typenv 195 | |(None, None) -> (* new assign without type specifier *) 196 | add_var name (typeof expt) typenv 197 | |(Some(t), Some(t_specifier)) -> (* reassign (different type) *) 198 | raise (SilkError ("type of variable "^name^" is "^(string_of_type t))) 199 | in 200 | (TAssign(name, expt, typeof expt), typenv) 201 | end 202 | |MultiExpr(exprs) -> begin 203 | let typenv = (Hashtbl.create 10)::typenv in 204 | let rec typify_exprs exprs typenv = 205 | match exprs with 206 | |e::xs -> begin 207 | let e_t, typenv = typify_expr e typenv in 208 | match xs with 209 | |[] -> ([e_t], typeof e_t, typenv) 210 | |_ -> 211 | let e_ts, r_t, typenv = typify_exprs xs typenv in 212 | (e_t::e_ts, r_t, typenv) 213 | end 214 | |[] -> ([], UnitT, typenv) 215 | in 216 | let exprs_t, r_t, typenv = typify_exprs exprs typenv in 217 | let typenv = List.tl typenv in 218 | (TMultiExpr(exprs_t, r_t), typenv) 219 | end 220 | |Defun(name, args, rett, body) -> begin 221 | (* function scope *) 222 | let scopeenv = (Hashtbl.create 10) in 223 | let recursible = ref true in 224 | let argnames = List.map (fun (argname, argtype) -> 225 | let _ = 226 | match argtype with 227 | |Some(t) -> 228 | Hashtbl.add scopeenv argname (type_of_name t) 229 | |None -> begin 230 | let tyvar = newtypevar argname typenv in 231 | Hashtbl.add scopeenv argname tyvar; 232 | recursible := false 233 | end 234 | in 235 | argname) args 236 | in 237 | let rett, recursible = 238 | match rett with 239 | |Some(rett) -> (type_of_name rett), !recursible 240 | |None -> UnitT, false 241 | in 242 | 243 | if recursible then begin 244 | let argtypes = List.map (fun (_, argtype) -> 245 | match argtype with 246 | |Some(argtype) -> (type_of_name argtype) 247 | |None -> raise (SilkError "Program Error")) args 248 | in 249 | let funt = make_funt argtypes rett in 250 | Hashtbl.add scopeenv name funt 251 | end 252 | else (); 253 | 254 | let typenv = scopeenv::typenv in 255 | (* evaluate *) 256 | let bodyt, typenv = typify_expr body typenv in 257 | 258 | (* get evaluated types *) 259 | let argtypes = List.map (fun argname -> 260 | let argtype, _ = typify_expr (Var(argname)) typenv in 261 | typeof argtype) argnames 262 | in 263 | 264 | (* rollback scope *) 265 | let typenv = List.tl typenv in 266 | 267 | (* build function type *) 268 | let funct = make_funt argtypes (typeof bodyt) in 269 | Hashtbl.add (List.hd typenv) name funct; 270 | (TDefun(name, argnames, bodyt, funct), typenv) 271 | end 272 | 273 | let typify exprs = 274 | let typed_expr, _ = typify_expr exprs [Hashtbl.create 10] in 275 | typed_expr 276 | -------------------------------------------------------------------------------- /codegen.ml: -------------------------------------------------------------------------------- 1 | open Llvm 2 | open Syntax 3 | open Error 4 | open Typ 5 | 6 | type llvm_context = { 7 | llvm_ctx : llcontext; 8 | llvm_mod : llmodule; (* bad name! *) 9 | env : (string, llvalue) Hashtbl.t list; 10 | defined_funcs: (string * string) list; 11 | declared_funcs : (string * (string list * exp_t * typ)) list; 12 | builder : llbuilder; 13 | func : llvalue; 14 | namespace : string; 15 | } 16 | 17 | 18 | (* global contexts *) 19 | let llvm_ctx = global_context () 20 | let llvm_module = create_module llvm_ctx "silk" 21 | 22 | (* frequently used type *) 23 | let void_t = void_type llvm_ctx 24 | let i32_t = i32_type llvm_ctx 25 | let i8_t = i8_type llvm_ctx 26 | let bool_t = i1_type llvm_ctx 27 | 28 | let dummy_llvalue = const_int i32_t 0 29 | 30 | (* assoc list of binary operations *) 31 | type op_t = 32 | |UniOp of (llvalue -> string -> llbuilder -> llvalue) 33 | |BinOp of (llvalue -> llvalue -> string -> llbuilder -> llvalue) 34 | |CmpOp of Icmp.t 35 | 36 | let builtin_ops = [ 37 | ("__neg", UniOp(build_neg)); 38 | ("+", BinOp(build_add)); 39 | ("-", BinOp(build_sub)); 40 | ("*", BinOp(build_mul)); 41 | ("/", BinOp(build_sdiv)); 42 | ("==", CmpOp(Icmp.Eq)); 43 | ("!=", CmpOp(Icmp.Ne)); 44 | ("<", CmpOp(Icmp.Slt)); 45 | (">", CmpOp(Icmp.Sgt)); 46 | ("<=", CmpOp(Icmp.Sle)); 47 | (">=", CmpOp(Icmp.Sge)); 48 | ] 49 | 50 | (* lookup name from context *) 51 | let rec lookup name env = 52 | match env with 53 | |cur::paren -> begin 54 | match Hashtbl.find_opt cur name with 55 | |Some(v) -> Some(v) 56 | |None -> lookup name paren 57 | end 58 | |[] -> None 59 | 60 | let rec lltype_of_type typ = 61 | match typ with 62 | |IntT -> i32_t 63 | |BoolT -> bool_t 64 | |UnitT -> i32_t (* dirty: type of dummy_llvalue *) 65 | |_ -> raise (SilkError ("Unsupported type:"^(string_of_type typ))) 66 | 67 | let rec codegen_defun fname arg_names types ret_t body ctx = 68 | let saved_builder = ctx.builder in 69 | let saved_namespace = ctx.namespace in 70 | let saved_func = ctx.func in 71 | let arg_types = Array.of_list (List.map lltype_of_type types) in 72 | let func_t = function_type (lltype_of_type ret_t) arg_types in 73 | let f_id = ctx.namespace ^ "$" ^ fname in 74 | let f = define_function f_id func_t ctx.llvm_mod in 75 | let entry = entry_block f in 76 | let builder = builder_at_end ctx.llvm_ctx entry in 77 | let ctx = { ctx with 78 | builder = builder; 79 | func = f; 80 | defined_funcs = (fname, f_id)::ctx.defined_funcs; 81 | env = (Hashtbl.create 16)::ctx.env; 82 | namespace = f_id; 83 | } in 84 | 85 | (* build parameter list *) 86 | let param_list = Array.to_list (Llvm.params f) in 87 | let rec add_arg argnames argtypes params = 88 | match (argnames, argtypes, params) with 89 | |(argname::an, argtype::at, param::ps) -> begin 90 | set_value_name argname param; 91 | let store = build_alloca argtype argname ctx.builder in 92 | build_store param store ctx.builder |> ignore; 93 | Hashtbl.add (List.hd ctx.env) argname store; (* warning: arugment name will be override *) 94 | add_arg an at ps 95 | end 96 | |([], [], []) -> () 97 | |([], [void_t], [_]) -> () 98 | |_ -> raise (SilkError ("Program Error")) 99 | in 100 | add_arg arg_names (List.map lltype_of_type types) param_list; 101 | 102 | (* body and ret *) 103 | let ret, ctx = codegen_expr body ctx in 104 | build_ret ret builder |> ignore; 105 | 106 | (f, { 107 | ctx with 108 | builder = saved_builder; 109 | func = saved_func; 110 | env = List.tl ctx.env; 111 | namespace = saved_namespace; 112 | }) 113 | 114 | and codegen_expr expr ctx = 115 | match expr with 116 | |TUnit(_) -> (dummy_llvalue, ctx) 117 | |TInt(v, _) -> (const_int i32_t v, ctx) 118 | |TBool(v, _) -> (const_int bool_t (if v then 1 else 0), ctx) 119 | |TVar (name, _) -> begin 120 | match lookup name ctx.env with 121 | |Some(v) -> 122 | let r = build_load v "" ctx.builder in 123 | (r, ctx) 124 | |None -> raise (SilkError ("Undefined variable: " ^ name)) 125 | end 126 | |TAssign(name, exp, t) -> 127 | let v, ctx = codegen_expr exp ctx in 128 | let store = 129 | match t with 130 | |IntT -> build_alloca i32_t name ctx.builder 131 | |BoolT -> build_alloca bool_t name ctx.builder 132 | |UnitT -> raise (SilkError "Unit type has not value") 133 | |_ -> raise (SilkError ("Unspported type: " ^ (string_of_type t))) 134 | in 135 | let _ = build_store v store ctx.builder in 136 | Hashtbl.add (List.hd ctx.env) name store; 137 | (v, ctx) 138 | |TCall(name, args, ret_t) -> begin 139 | let rec codegen_args args ctx = 140 | match args with 141 | |arg::xs -> 142 | let v, ctx = codegen_expr arg ctx in 143 | let vs, ts, ctx = codegen_args xs ctx in 144 | (v::vs, (typeof arg)::ts, ctx) 145 | |[] -> ([], [], ctx) 146 | in 147 | let rec build_fname name types = 148 | match types with 149 | |t::xs -> 150 | build_fname (name^"__"^(string_of_type t)) xs 151 | |[] -> name 152 | in 153 | (* eval args *) 154 | let args, types, ctx = codegen_args args ctx in 155 | (* build function name with types *) 156 | let fname = build_fname name types in 157 | 158 | match List.assoc_opt name builtin_ops with 159 | |Some(UniOp(build_uniop)) -> 160 | let r = build_uniop (List.hd args) "name" ctx.builder in 161 | (r, ctx) 162 | |Some(BinOp(build_binop)) -> 163 | (* arithmetic operators *) 164 | let r = build_binop (List.nth args 0) (List.nth args 1) "name" ctx.builder in 165 | (r, ctx) 166 | |Some(CmpOp(cmp_icmp)) -> 167 | (* compartors *) 168 | let r = build_icmp cmp_icmp (List.hd args) (List.nth args 1) "name" ctx.builder in 169 | (r, ctx) 170 | |None -> begin 171 | (* search functions *) 172 | match List.assoc_opt fname ctx.defined_funcs with 173 | |Some(f_id) -> begin 174 | match lookup_function f_id ctx.llvm_mod with 175 | |Some(f) -> 176 | let r = build_call f (Array.of_list args) "" ctx.builder in 177 | (r, ctx) 178 | |None -> raise (SilkError "Program Error: function id missed") 179 | end 180 | |None -> begin 181 | match List.assoc_opt name ctx.declared_funcs with 182 | |Some(arg_names, body, ftype) -> 183 | let f, ctx = codegen_defun fname arg_names types ret_t body ctx in 184 | let r = build_call f (Array.of_list args) "" ctx.builder in 185 | (r, ctx) 186 | |None -> raise (SilkError ("undefined function (or does not match types): "^fname)) 187 | end 188 | end 189 | end 190 | |TMultiExpr (exprs, _) -> 191 | let ctx_ref = ref {ctx with env = (Hashtbl.create 16)::ctx.env} in 192 | let ret_ref = ref (const_int i32_t 0) in 193 | List.iter (fun e -> 194 | let r, ctx = codegen_expr e !ctx_ref in 195 | ctx_ref := ctx; 196 | ret_ref := r) exprs; 197 | (!ret_ref, {!ctx_ref with env = List.tl (!ctx_ref).env}) 198 | |TDefun(name, arg_names, body, t) -> 199 | if name = "main" then 200 | begin 201 | (* entry point *) 202 | let main_t = function_type void_t [||] in 203 | let main_f = define_function "main" main_t ctx.llvm_mod in 204 | let entry = entry_block main_f in 205 | let builder = builder_at_end ctx.llvm_ctx entry in 206 | let saved_namespace = ctx.namespace in 207 | let ctx = { ctx with builder = builder; func = main_f; env = (Hashtbl.create 16)::ctx.env; namespace = name } in 208 | let _, ctx = codegen_expr body ctx in 209 | build_ret_void builder |> ignore; 210 | (main_f, {ctx with builder = builder; env = List.tl ctx.env; namespace = saved_namespace}) 211 | end 212 | else 213 | (dummy_llvalue, {ctx with declared_funcs = (name, (arg_names, body, t))::ctx.declared_funcs}) 214 | |TIf (cond, then_exp, else_exp, _) -> 215 | begin 216 | let cond_val, ctx = codegen_expr cond ctx in 217 | let then_block = append_block ctx.llvm_ctx "then" ctx.func in 218 | let else_block = append_block ctx.llvm_ctx "else" ctx.func in 219 | let merge_block = append_block ctx.llvm_ctx "merge" ctx.func in 220 | 221 | let then_builder = builder_at_end ctx.llvm_ctx then_block in 222 | let then_ret, _ = codegen_expr then_exp {ctx with builder = then_builder; env = (Hashtbl.create 16)::ctx.env} in 223 | build_br merge_block then_builder |> ignore; 224 | 225 | let else_builder = builder_at_end ctx.llvm_ctx else_block in 226 | let else_ret, _ = codegen_expr else_exp {ctx with builder = else_builder; env = (Hashtbl.create 16)::ctx.env} in 227 | build_br merge_block else_builder |> ignore; 228 | 229 | let merge_builder = builder_at_end ctx.llvm_ctx merge_block in 230 | let merge_val = build_phi [(then_ret, then_block); (else_ret, else_block)] "" merge_builder in 231 | 232 | build_cond_br cond_val then_block else_block ctx.builder |> ignore; 233 | position_at_end merge_block ctx.builder; 234 | (merge_val, ctx) 235 | end 236 | 237 | (* create LLVM IR code from program *) 238 | let codegen exprs = 239 | (* create context *) 240 | let ctx = global_context () in 241 | let context = { 242 | llvm_ctx = ctx; 243 | llvm_mod = create_module llvm_ctx "silk"; 244 | env = []; 245 | defined_funcs = [ 246 | ("print__Int", "print__Int"); 247 | ("print__Bool", "print__Bool"); 248 | ]; 249 | declared_funcs = []; 250 | builder = Llvm.builder ctx; (* dummy *) 251 | func = dummy_llvalue; (* dummy *) 252 | namespace = ""; 253 | } in 254 | 255 | (* declare builtin function *) 256 | let print_int_t = function_type void_t [| i32_t |] in 257 | let _ = declare_function "print__Int" print_int_t context.llvm_mod in 258 | 259 | let print_bool_t = function_type void_t [| bool_t |] in 260 | let _ = declare_function "print__Bool" print_bool_t context.llvm_mod in 261 | let _, context = codegen_expr exprs context in 262 | 263 | context.llvm_mod; (* return *) 264 | 265 | --------------------------------------------------------------------------------