├── .appveyor.yml ├── .codecov.yml ├── .gitignore ├── .travis.yml ├── Guardfile ├── LICENSE ├── Makefile ├── README.md ├── ast ├── example_test.go ├── node.go ├── printer.go ├── printer_test.go ├── visitor.go └── visitor_test.go ├── closure ├── example_test.go ├── fix_apps.go ├── freevars.go ├── transform.go └── transform_test.go ├── codegen ├── block_builder.go ├── debug_info_builder.go ├── emitter.go ├── emitter_test.go ├── example_test.go ├── executable_test.go ├── linker.go ├── linker_test.go ├── module_builder.go ├── targets.go ├── targets_test.go ├── testdata │ ├── argv.ml │ ├── argv.out │ ├── array.ml │ ├── array.out │ ├── array_lit.ml │ ├── array_lit.out │ ├── arrstore_bug.ml │ ├── arrstore_bug.out │ ├── binary_op.ml │ ├── binary_op.out │ ├── builtin_chain.ml │ ├── builtin_chain.out │ ├── builtins.ml │ ├── builtins.out │ ├── closure.ml │ ├── closure.out │ ├── compare_fun.ml │ ├── compare_fun.out │ ├── constants.ml │ ├── constants.out │ ├── external_function_var.ml │ ├── external_function_var.out │ ├── file.ml │ ├── file.out │ ├── function.ml │ ├── function.out │ ├── function_var.ml │ ├── function_var.out │ ├── gc_api.ml │ ├── gc_api.out │ ├── helloworld.ml │ ├── helloworld.out │ ├── issue_15_fixed.ml │ ├── issue_15_fixed.out │ ├── lambda.ml │ ├── lambda.out │ ├── local_function_var.ml │ ├── local_function_var.out │ ├── logical_op.ml │ ├── logical_op.out │ ├── multi_dim_array.ml │ ├── multi_dim_array.out │ ├── multi_functions.ml │ ├── multi_functions.out │ ├── nested_aggregates.ml │ ├── nested_aggregates.out │ ├── nested_block.ml │ ├── nested_block.out │ ├── option_eq.ml │ ├── option_eq.out │ ├── option_values.ml │ ├── option_values.out │ ├── recursive_closure.ml │ ├── recursive_closure.out │ ├── recursive_func.ml │ ├── recursive_func.out │ ├── shadow_names.ml │ ├── shadow_names.out │ ├── string.ml │ ├── string.out │ ├── test.txt │ ├── tuple.ml │ ├── tuple.out │ ├── type_annotation.ml │ ├── type_annotation.out │ ├── type_annotation_fun.ml │ ├── type_annotation_fun.out │ ├── type_decl.ml │ ├── type_decl.out │ ├── unary_op.ml │ ├── unary_op.out │ ├── underscore.ml │ ├── underscore.out │ ├── zero_length_array.ml │ └── zero_length_array.out └── type_builder.go ├── common ├── ordinal.go └── ordinal_test.go ├── driver ├── driver.go └── example_test.go ├── examples ├── brainfxxk.ml ├── bubble_sort.ml ├── compose.ml ├── factorial.ml ├── fib.ml ├── fizzbuzz.ml ├── guessing_game.ml ├── helloworld.ml ├── mandelbrot.ml ├── matmul.ml ├── mt19937ar.ml ├── n-queens.ml ├── quick_sort.ml ├── rust-example.ml ├── sqrt.ml ├── tak.ml └── xorshift128plus.ml ├── main.go ├── mir ├── README.md ├── block.go ├── block_test.go ├── printer.go ├── program.go ├── program_test.go └── val.go ├── mono └── monomorphize.go ├── runtime ├── gocaml.h └── gocamlrt.c ├── scripts ├── install_llvmgo.sh └── travis_install.sh ├── sema ├── algorithm_w_test.go ├── alpha_transform.go ├── alpha_transform_test.go ├── deref.go ├── deref_test.go ├── example_test.go ├── generic.go ├── infer.go ├── infer_test.go ├── node_to_type.go ├── node_to_type_test.go ├── scope.go ├── scope_test.go ├── semantics_check.go ├── semantics_check_test.go ├── testdata │ ├── array.ml │ ├── array_lit.ml │ ├── binop.ml │ ├── external_func.ml │ ├── external_val.ml │ ├── fun.ml │ ├── if.ml │ ├── match.ml │ ├── option.ml │ ├── primitives.ml │ ├── tuple.ml │ ├── type_annotation.ml │ ├── type_annotation_expr.ml │ ├── type_annotation_fun.ml │ ├── type_decl.ml │ ├── unary.ml │ └── underscore.ml ├── to_mir.go ├── to_mir_test.go └── unify.go ├── syntax ├── example_test.go ├── grammar.go.y ├── lexer.go ├── lexer_test.go ├── parser.go ├── parser_test.go └── testdata │ ├── array.ml │ ├── array_lit.ml │ ├── binop.ml │ ├── constant.ml │ ├── external.ml │ ├── external_func_unknown_ret_type.ml │ ├── float.ml │ ├── fun_type_annotate.ml │ ├── get.ml │ ├── ident.ml │ ├── if.ml │ ├── lambda.ml │ ├── let.ml │ ├── let_rec.ml │ ├── lexer │ └── invalid │ │ ├── array.ml │ │ ├── array2.ml │ │ ├── array3.ml │ │ ├── float.ml │ │ ├── ident.ml │ │ ├── invalid_utf8.ml │ │ ├── logical_and.ml │ │ ├── unclosed_comment.ml │ │ ├── unclosed_comment2.ml │ │ ├── unclosed_string.ml │ │ ├── unknown_char.ml │ │ └── utf8.ml │ ├── logicop.ml │ ├── match.ml │ ├── none_keyword.ml │ ├── option.ml │ ├── print.ml │ ├── put.ml │ ├── relational.ml │ ├── strings.ml │ ├── tuple.ml │ ├── type_annotation.ml │ ├── type_decl.ml │ └── unary_op.ml ├── testdata └── from-mincaml │ ├── LICENSE │ ├── README.md │ ├── ack.ml │ ├── adder.ml │ ├── cls-bug.ml │ ├── cls-bug2.ml │ ├── cls-rec.ml │ ├── cls-reg-bug.ml │ ├── even-odd.ml │ ├── fib.ml │ ├── float.ml │ ├── funcomp.ml │ ├── gcd.ml │ ├── inprod-loop.ml │ ├── inprod-rec.ml │ ├── inprod.ml │ ├── join-reg.ml │ ├── join-reg2.ml │ ├── join-stack.ml │ ├── join-stack2.ml │ ├── join-stack3.ml │ ├── manyargs.ml │ ├── matmul-flat.ml │ ├── matmul.ml │ ├── non-tail-if.ml │ ├── non-tail-if2.ml │ ├── print.ml │ ├── shuffle.ml │ ├── spill.ml │ ├── spill2.ml │ ├── spill3.ml │ ├── sum-tail.ml │ ├── sum.ml │ └── toomanyargs.ml ├── token ├── token.go └── token_test.go └── types ├── builtins.go ├── env.go ├── env_test.go ├── equals.go ├── equals_test.go ├── type.go ├── type_test.go ├── visitor.go └── visitor_test.go /.appveyor.yml: -------------------------------------------------------------------------------- 1 | version: "{build}" 2 | clone_depth: 1 3 | clone_folder: c:\gopath\src\github.com\rhysd\gocaml 4 | environment: 5 | GOPATH: c:\gopath 6 | install: 7 | - echo %PATH% 8 | - echo %GOPATH% 9 | - go version 10 | - go env 11 | - go get -v -t -d ./ast ./closure ./mir ./syntax ./token ./sema ./common ./mono 12 | - go get golang.org/x/tools/cmd/goyacc 13 | - go get github.com/haya14busa/goverage 14 | - set PATH=%PATH%;%GOPATH%\bin 15 | build: off 16 | test_script: 17 | - goyacc -o syntax/grammar.go syntax/grammar.go.y 18 | - go test -v ./ast ./closure ./mir ./syntax ./token ./sema ./common ./mono 19 | - goverage -coverprofile=coverage.txt -covermode=count ./ast ./mir ./closure ./syntax ./token ./sema ./common ./mono 20 | - go tool cover -func coverage.txt 21 | after_test: 22 | - "SET PATH=C:\\Python34;C:\\Python34\\Scripts;%PATH%" 23 | - pip install codecov 24 | - codecov -f "coverage.txt" 25 | deploy: off 26 | -------------------------------------------------------------------------------- /.codecov.yml: -------------------------------------------------------------------------------- 1 | coverage: 2 | status: 3 | project: 4 | threshold: 20% 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /gocaml 2 | /y.output 3 | /cover.out 4 | /syntax/grammar.go 5 | /runtime/gocamlrt.o 6 | /runtime/gocamlrt.a 7 | /cpu.prof 8 | /codegen.test 9 | /prof.png 10 | /codegen/testdata/piyo.txt 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: go 2 | go: 1.x 3 | dist: trusty 4 | os: 5 | - linux 6 | - osx 7 | install: 8 | - bash ./scripts/travis_install.sh 9 | script: 10 | - make test VERBOSE=true 11 | after_success: 12 | - make cover.out 13 | - go tool cover -func cover.out 14 | - mv cover.out coverage.txt 15 | - bash <(curl -s https://codecov.io/bash) 16 | addons: 17 | apt: 18 | sources: 19 | - llvm-toolchain-trusty-5.0 20 | packages: 21 | - libllvm5.0 22 | - llvm-5.0-dev 23 | - clang-5.0 24 | - libgc-dev 25 | - cmake 26 | - time 27 | cache: 28 | apt: true 29 | directories: 30 | - $GOPATH/src/llvm.org/llvm 31 | - $GOPATH/pkg/linux_amd64/llvm.org/llvm 32 | -------------------------------------------------------------------------------- /Guardfile: -------------------------------------------------------------------------------- 1 | def run_test(file) 2 | dir = file.match(%r[^[^/]+])[0] 3 | sources = Dir["./#{dir}/*.go"].reject{|p| p.end_with? '_test.go'}.join(' ') 4 | if file.end_with? 'node_to_type_test.go' 5 | # XXX 6 | sources += " ./sema/deref_test.go" 7 | end 8 | result = run_tests "./#{file} #{sources}" 9 | puts_out result 10 | end 11 | 12 | def puts_out(out) 13 | puts out.gsub(/\bRUN\b/, "\e[1;93mRUN\e[0m").gsub(/\bPASS\b/, "\e[1;92mPASS\e[0m").gsub(/\bFAIL\b/, "\e[1;91mFAIL\e[0m") 14 | end 15 | 16 | def sep(f) 17 | puts "\033[93m#{Time.now}: #{File.basename f}\033[0m" 18 | end 19 | 20 | def run_tests(args) 21 | `CGO_LDFLAGS_ALLOW='-Wl,(-search_paths_first|-headerpad_max_install_names)' go test -v #{args}` 22 | end 23 | 24 | guard :shell do 25 | watch /\.go$/ do |m| 26 | sep m[0] 27 | case m[0] 28 | when /_test\.go$/ 29 | run_test m[0] 30 | else 31 | system "make build" 32 | end 33 | end 34 | watch /(.*)\/testdata\/.+\.(:?ml|out)$/ do |m| 35 | sep m[0] 36 | puts_out run_tests("./#{m[1]}") 37 | end 38 | watch /\.c$/ do |m| 39 | sep m[0] 40 | system "make build" 41 | end 42 | watch /\.go\.y$/ do |m| 43 | sep m[0] 44 | system "make build" 45 | end 46 | end 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | the MIT License 2 | 3 | Copyright (c) 2017 rhysd 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 9 | of the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 16 | INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 17 | PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 18 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR 20 | THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | SRCS := \ 2 | main.go \ 3 | ast/node.go \ 4 | ast/printer.go \ 5 | ast/visitor.go \ 6 | driver/driver.go \ 7 | syntax/lexer.go \ 8 | syntax/grammar.go \ 9 | syntax/parser.go \ 10 | token/token.go \ 11 | types/builtins.go \ 12 | types/env.go \ 13 | types/type.go \ 14 | types/visitor.go \ 15 | types/equals.go \ 16 | sema/unify.go \ 17 | sema/generic.go \ 18 | sema/deref.go \ 19 | sema/infer.go \ 20 | sema/node_to_type.go \ 21 | sema/semantics_check.go \ 22 | sema/to_mir.go \ 23 | sema/alpha_transform.go \ 24 | sema/scope.go \ 25 | mir/val.go \ 26 | mir/block.go \ 27 | mir/printer.go \ 28 | mir/program.go \ 29 | closure/transform.go \ 30 | closure/freevars.go \ 31 | closure/fix_apps.go \ 32 | mono/monomorphize.go \ 33 | codegen/emitter.go \ 34 | codegen/module_builder.go \ 35 | codegen/type_builder.go \ 36 | codegen/block_builder.go \ 37 | codegen/debug_info_builder.go \ 38 | codegen/linker.go \ 39 | codegen/targets.go \ 40 | common/ordinal.go \ 41 | 42 | TESTS := \ 43 | ast/example_test.go \ 44 | ast/visitor_test.go \ 45 | ast/printer_test.go \ 46 | closure/example_test.go \ 47 | closure/transform_test.go \ 48 | driver/example_test.go \ 49 | syntax/lexer_test.go \ 50 | syntax/example_test.go \ 51 | syntax/parser_test.go \ 52 | token/token_test.go \ 53 | types/env_test.go \ 54 | types/type_test.go \ 55 | types/visitor_test.go \ 56 | sema/example_test.go \ 57 | sema/infer_test.go \ 58 | sema/deref_test.go \ 59 | sema/node_to_type_test.go \ 60 | sema/to_mir_test.go \ 61 | sema/semantics_check_test.go \ 62 | sema/scope_test.go \ 63 | sema/alpha_transform_test.go \ 64 | sema/algorithm_w_test.go \ 65 | mir/block_test.go \ 66 | mir/program_test.go \ 67 | codegen/example_test.go \ 68 | codegen/executable_test.go \ 69 | codegen/linker_test.go \ 70 | codegen/targets_test.go \ 71 | common/ordinal_test.go \ 72 | 73 | all: build test 74 | 75 | build: gocaml runtime/gocamlrt.a 76 | 77 | gocaml: $(SRCS) 78 | ./scripts/install_llvmgo.sh 79 | go get -t -d ./... 80 | if which time > /dev/null; then\ 81 | CGO_LDFLAGS_ALLOW='-Wl,(-search_paths_first|-headerpad_max_install_names)' time go build;\ 82 | else\ 83 | CGO_LDFLAGS_ALLOW='-Wl,(-search_paths_first|-headerpad_max_install_names)' go build;\ 84 | fi 85 | 86 | syntax/grammar.go: syntax/grammar.go.y 87 | go get golang.org/x/tools/cmd/goyacc 88 | goyacc -o syntax/grammar.go syntax/grammar.go.y 89 | 90 | runtime/gocamlrt.o: runtime/gocamlrt.c runtime/gocaml.h 91 | $(CC) -Wall -Wextra -std=c99 -I/usr/local/include -I./runtime $(CFLAGS) -c runtime/gocamlrt.c -o runtime/gocamlrt.o 92 | runtime/gocamlrt.a: runtime/gocamlrt.o 93 | ar -r runtime/gocamlrt.a runtime/gocamlrt.o 94 | 95 | test: $(TESTS) 96 | ifdef VERBOSE 97 | CGO_LDFLAGS_ALLOW='-Wl,(-search_paths_first|-headerpad_max_install_names)' go test -v ./... 98 | else 99 | CGO_LDFLAGS_ALLOW='-Wl,(-search_paths_first|-headerpad_max_install_names)' go test ./... 100 | endif 101 | 102 | cover.out: $(TESTS) 103 | go get github.com/haya14busa/goverage 104 | CGO_LDFLAGS_ALLOW='-Wl,(-search_paths_first|-headerpad_max_install_names)' goverage -coverprofile=cover.out -covermode=count ./ast ./mir ./closure ./syntax ./token ./sema ./codegen ./common ./mono 105 | 106 | cov: cover.out 107 | go get golang.org/x/tools/cmd/cover 108 | go tool cover -html=cover.out 109 | 110 | cpu.prof codegen.test: $(SRCS) codegen/executable_test.go 111 | CGO_LDFLAGS_ALLOW='-Wl,(-search_paths_first|-headerpad_max_install_names)' go test -cpuprofile cpu.prof -bench . -run '^$$' ./codegen 112 | 113 | prof: cpu.prof codegen.test 114 | go tool pprof codegen.test cpu.prof 115 | 116 | prof.png: cpu.prof codegen.test 117 | go tool pprof -png codegen.test cpu.prof > prof.png 118 | 119 | gocaml-darwin-x86_64.zip: gocaml runtime/gocamlrt.a 120 | rm -rf gocaml-darwin-x86_64 gocaml-darwin-x86_64.zip 121 | mkdir -p gocaml-darwin-x86_64/runtime 122 | mkdir -p gocaml-darwin-x86_64/include 123 | cp gocaml gocaml-darwin-x86_64/ 124 | cp runtime/gocamlrt.a gocaml-darwin-x86_64/runtime/ 125 | cp runtime/gocaml.h gocaml-darwin-x86_64/include/ 126 | cp README.md LICENSE gocaml-darwin-x86_64/ 127 | zip gocaml-darwin-x86_64.zip -r gocaml-darwin-x86_64 128 | rm -rf gocaml-darwin-x86_64 129 | 130 | release: gocaml-darwin-x86_64.zip 131 | 132 | clean: 133 | rm -f gocaml y.output syntax/grammar.go runtime/gocamlrt.o runtime/gocamlrt.a cover.out cpu.prof codegen.test prof.png gocaml-darwin-x86_64.zip 134 | 135 | .PHONY: all build clean test cov prof release 136 | -------------------------------------------------------------------------------- /ast/example_test.go: -------------------------------------------------------------------------------- 1 | package ast 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/token" 6 | "github.com/rhysd/locerr" 7 | ) 8 | 9 | // Visitor which counts number of nodes in AST 10 | type printPath struct { 11 | total int 12 | } 13 | 14 | // VisitTopdown method is called before children are visited 15 | func (v *printPath) VisitTopdown(e Expr) Visitor { 16 | fmt.Printf("\n -> %s (topdown)", e.Name()) 17 | return v 18 | } 19 | 20 | // VisitBottomup method is called after children were visited 21 | func (v *printPath) VisitBottomup(e Expr) { 22 | fmt.Printf("\n -> %s (bottomup)", e.Name()) 23 | } 24 | 25 | func Example() { 26 | src := locerr.NewDummySource("") 27 | 28 | // AST which usually comes from syntax.Parse() function. 29 | rootOfAST := &Let{ 30 | LetToken: &token.Token{File: src}, 31 | Symbol: NewSymbol("test"), 32 | Bound: &Int{ 33 | Token: &token.Token{File: src}, 34 | Value: 42, 35 | }, 36 | Body: &Add{ 37 | Left: &VarRef{ 38 | Token: &token.Token{File: src}, 39 | Symbol: NewSymbol("test"), 40 | }, 41 | Right: &Float{ 42 | Token: &token.Token{File: src}, 43 | Value: 3.14, 44 | }, 45 | }, 46 | } 47 | 48 | ast := &AST{Root: rootOfAST} 49 | 50 | // Apply visitor to root node of AST 51 | v := &printPath{0} 52 | fmt.Println("ROOT") 53 | 54 | Visit(v, ast.Root) 55 | // Output: 56 | // ROOT 57 | // -> Let (test) (topdown) 58 | // -> Int (topdown) 59 | // -> Int (bottomup) 60 | // -> Add (topdown) 61 | // -> VarRef (test) (topdown) 62 | // -> VarRef (test) (bottomup) 63 | // -> Float (topdown) 64 | // -> Float (bottomup) 65 | // -> Add (bottomup) 66 | // -> Let (test) (bottomup) 67 | 68 | // Print AST 69 | Println(ast) 70 | } 71 | -------------------------------------------------------------------------------- /ast/printer.go: -------------------------------------------------------------------------------- 1 | package ast 2 | 3 | import ( 4 | "fmt" 5 | "io" 6 | "os" 7 | "strings" 8 | ) 9 | 10 | // Printer is a visitor to print AST to io.Writer 11 | type Printer struct { 12 | indent int 13 | out io.Writer 14 | } 15 | 16 | func (p Printer) VisitTopdown(e Expr) Visitor { 17 | fmt.Fprintf(p.out, "\n%s%s (%d:%d-%d:%d)", strings.Repeat("- ", p.indent), e.Name(), e.Pos().Line, e.Pos().Column, e.End().Line, e.End().Column) 18 | return Printer{p.indent + 1, p.out} 19 | } 20 | 21 | func (p Printer) VisitBottomup(Expr) { 22 | return 23 | } 24 | 25 | // Fprint outputs a structure of AST to given io.Writer object 26 | func Fprint(out io.Writer, a *AST) { 27 | fmt.Fprintf(out, "AST for %s:", a.File().Path) 28 | p := Printer{1, out} 29 | for _, t := range a.TypeDecls { 30 | Visit(p, t) 31 | } 32 | for _, e := range a.Externals { 33 | Visit(p, e) 34 | } 35 | Visit(p, a.Root) 36 | } 37 | 38 | // Print outputs a structure of AST to stdout. 39 | func Print(a *AST) { 40 | Fprint(os.Stdout, a) 41 | } 42 | 43 | // Println does the same as Print and append newline at the end of output. 44 | func Println(a *AST) { 45 | Print(a) 46 | fmt.Println() 47 | } 48 | -------------------------------------------------------------------------------- /ast/visitor.go: -------------------------------------------------------------------------------- 1 | package ast 2 | 3 | // Visitor is an interface for the structs which is used for traversing AST. 4 | type Visitor interface { 5 | // VisitTopdown defines the process when a node is visited. This method is called before 6 | // children are visited. 7 | // Returned value is a next visitor to use for succeeding visit. When wanting to stop 8 | // visiting, please return nil. 9 | // A visitor visits in depth-first order. 10 | VisitTopdown(e Expr) Visitor 11 | // VisitBottomup defines the process when a node is visited. This method is called after 12 | // children were visited. When VisitTopdown returned nil, this method won't be caled for the node. 13 | VisitBottomup(e Expr) 14 | } 15 | 16 | // Visit visits the tree with the visitor. 17 | func Visit(vis Visitor, e Expr) { 18 | v := vis.VisitTopdown(e) 19 | if v == nil { 20 | return 21 | } 22 | 23 | switch n := e.(type) { 24 | case *Not: 25 | Visit(v, n.Child) 26 | case *Neg: 27 | Visit(v, n.Child) 28 | case *Add: 29 | Visit(v, n.Left) 30 | Visit(v, n.Right) 31 | case *Sub: 32 | Visit(v, n.Left) 33 | Visit(v, n.Right) 34 | case *Mul: 35 | Visit(v, n.Left) 36 | Visit(v, n.Right) 37 | case *Div: 38 | Visit(v, n.Left) 39 | Visit(v, n.Right) 40 | case *Mod: 41 | Visit(v, n.Left) 42 | Visit(v, n.Right) 43 | case *FNeg: 44 | Visit(v, n.Child) 45 | case *FAdd: 46 | Visit(v, n.Left) 47 | Visit(v, n.Right) 48 | case *FSub: 49 | Visit(v, n.Left) 50 | Visit(v, n.Right) 51 | case *FMul: 52 | Visit(v, n.Left) 53 | Visit(v, n.Right) 54 | case *FDiv: 55 | Visit(v, n.Left) 56 | Visit(v, n.Right) 57 | case *Eq: 58 | Visit(v, n.Left) 59 | Visit(v, n.Right) 60 | case *NotEq: 61 | Visit(v, n.Left) 62 | Visit(v, n.Right) 63 | case *Less: 64 | Visit(v, n.Left) 65 | Visit(v, n.Right) 66 | case *LessEq: 67 | Visit(v, n.Left) 68 | Visit(v, n.Right) 69 | case *Greater: 70 | Visit(v, n.Left) 71 | Visit(v, n.Right) 72 | case *GreaterEq: 73 | Visit(v, n.Left) 74 | Visit(v, n.Right) 75 | case *And: 76 | Visit(v, n.Left) 77 | Visit(v, n.Right) 78 | case *Or: 79 | Visit(v, n.Left) 80 | Visit(v, n.Right) 81 | case *If: 82 | Visit(v, n.Cond) 83 | Visit(v, n.Then) 84 | Visit(v, n.Else) 85 | case *Let: 86 | if n.Type != nil { 87 | Visit(v, n.Type) 88 | } 89 | Visit(v, n.Bound) 90 | Visit(v, n.Body) 91 | case *LetRec: 92 | for _, p := range n.Func.Params { 93 | if p.Type != nil { 94 | Visit(v, p.Type) 95 | } 96 | } 97 | if n.Func.RetType != nil { 98 | Visit(v, n.Func.RetType) 99 | } 100 | Visit(v, n.Func.Body) 101 | Visit(v, n.Body) 102 | case *Apply: 103 | Visit(v, n.Callee) 104 | for _, e := range n.Args { 105 | Visit(v, e) 106 | } 107 | case *Tuple: 108 | for _, e := range n.Elems { 109 | Visit(v, e) 110 | } 111 | case *LetTuple: 112 | if n.Type != nil { 113 | Visit(v, n.Type) 114 | } 115 | Visit(v, n.Bound) 116 | Visit(v, n.Body) 117 | case *ArrayMake: 118 | Visit(v, n.Size) 119 | Visit(v, n.Elem) 120 | case *ArraySize: 121 | Visit(v, n.Target) 122 | case *ArrayGet: 123 | Visit(v, n.Array) 124 | Visit(v, n.Index) 125 | case *ArrayPut: 126 | Visit(v, n.Array) 127 | Visit(v, n.Index) 128 | Visit(v, n.Assignee) 129 | case *Match: 130 | Visit(v, n.Target) 131 | Visit(v, n.IfSome) 132 | Visit(v, n.IfNone) 133 | case *Some: 134 | Visit(v, n.Child) 135 | case *ArrayLit: 136 | for _, e := range n.Elems { 137 | Visit(v, e) 138 | } 139 | case *FuncType: 140 | for _, e := range n.ParamTypes { 141 | Visit(v, e) 142 | } 143 | Visit(v, n.RetType) 144 | case *TupleType: 145 | for _, e := range n.ElemTypes { 146 | Visit(v, e) 147 | } 148 | case *CtorType: 149 | for _, e := range n.ParamTypes { 150 | Visit(v, e) 151 | } 152 | case *Typed: 153 | Visit(v, n.Child) 154 | Visit(v, n.Type) 155 | case *TypeDecl: 156 | Visit(v, n.Type) 157 | case *External: 158 | Visit(v, n.Type) 159 | } 160 | 161 | vis.VisitBottomup(e) 162 | } 163 | -------------------------------------------------------------------------------- /ast/visitor_test.go: -------------------------------------------------------------------------------- 1 | package ast 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/token" 5 | "testing" 6 | ) 7 | 8 | var testTree = &Let{ 9 | LetToken: &token.Token{}, 10 | Symbol: NewSymbol("test"), 11 | Bound: &Int{ 12 | Token: &token.Token{}, 13 | Value: 42, 14 | }, 15 | Body: &Add{ 16 | Left: &VarRef{ 17 | Token: &token.Token{}, 18 | Symbol: NewSymbol("test"), 19 | }, 20 | Right: &Float{ 21 | Token: &token.Token{}, 22 | Value: 3.14, 23 | }, 24 | }, 25 | } 26 | 27 | type testNumAllNodes struct { 28 | tdTotal int 29 | buTotal int 30 | } 31 | 32 | func (v *testNumAllNodes) VisitTopdown(e Expr) Visitor { 33 | v.tdTotal++ 34 | return v 35 | } 36 | 37 | func (v *testNumAllNodes) VisitBottomup(e Expr) { 38 | v.buTotal++ 39 | } 40 | 41 | type testNumRootChildren struct { 42 | numChildren int 43 | rootVisited bool 44 | } 45 | 46 | func (v *testNumRootChildren) VisitTopdown(e Expr) Visitor { 47 | v.numChildren++ 48 | if v.rootVisited { 49 | return nil 50 | } 51 | v.rootVisited = true 52 | return v 53 | } 54 | 55 | func (v *testNumRootChildren) VisitBottomup(Expr) { 56 | } 57 | 58 | func TestVisitorVisit(t *testing.T) { 59 | v := &testNumAllNodes{0, 0} 60 | Visit(v, testTree) 61 | if v.tdTotal != 5 { 62 | t.Fatalf("5 is expected as total nodes but actually %d", v.tdTotal) 63 | } 64 | } 65 | 66 | func TestVisitorCancelVisit(t *testing.T) { 67 | v := &testNumRootChildren{0, false} 68 | Visit(v, testTree) 69 | if v.numChildren != 3 { 70 | t.Fatalf("3 is expected as number of root children but actually %d", v.numChildren) 71 | } 72 | } 73 | -------------------------------------------------------------------------------- /closure/example_test.go: -------------------------------------------------------------------------------- 1 | package closure 2 | 3 | import ( 4 | "os" 5 | "path/filepath" 6 | 7 | "github.com/rhysd/gocaml/sema" 8 | "github.com/rhysd/gocaml/syntax" 9 | "github.com/rhysd/locerr" 10 | ) 11 | 12 | func Example() { 13 | file := filepath.FromSlash("../testdata/from-mincaml/ack.ml") 14 | src, err := locerr.NewSourceFromFile(file) 15 | if err != nil { 16 | // File not found 17 | panic(err) 18 | } 19 | 20 | ast, err := syntax.Parse(src) 21 | if err != nil { 22 | // When parse failed 23 | panic(err) 24 | } 25 | 26 | // Resolving symbols, type analysis and converting AST into MIR instruction block 27 | env, block, err := sema.SemanticsCheck(ast) 28 | if err != nil { 29 | // Type error detected 30 | panic(err) 31 | } 32 | 33 | // Closure transform. 34 | // Move all nested function to toplevel with resolving closures and known 35 | // function optimization. 36 | // Returned value will represents converted whole program. 37 | // It contains entry point of program, some toplevel functions and closure 38 | // information. 39 | program := Transform(block) 40 | 41 | // For debug purpose, you can show MIR representation after conversion 42 | program.Println(os.Stdout, env) 43 | // Output: 44 | // ack$t1 = recfun x$t2,y$t3 ; type=int -> int -> int 45 | // BEGIN: body (ack$t1) 46 | // $k2 = int 0 ; type=int 47 | // $k3 = binary <= x$t2 $k2 ; type=bool 48 | // $k28 = if $k3 ; type=int 49 | // BEGIN: then 50 | // $k5 = int 1 ; type=int 51 | // $k6 = binary + y$t3 $k5 ; type=int 52 | // END: then 53 | // BEGIN: else 54 | // $k8 = int 0 ; type=int 55 | // $k9 = binary <= y$t3 $k8 ; type=bool 56 | // $k27 = if $k9 ; type=int 57 | // BEGIN: then 58 | // $k12 = int 1 ; type=int 59 | // $k13 = binary - x$t2 $k12 ; type=int 60 | // $k14 = int 1 ; type=int 61 | // $k15 = app ack$t1 $k13,$k14 ; type=int 62 | // END: then 63 | // BEGIN: else 64 | // $k18 = int 1 ; type=int 65 | // $k19 = binary - x$t2 $k18 ; type=int 66 | // $k23 = int 1 ; type=int 67 | // $k24 = binary - y$t3 $k23 ; type=int 68 | // $k25 = app ack$t1 x$t2,$k24 ; type=int 69 | // $k26 = app ack$t1 $k19,$k25 ; type=int 70 | // END: else 71 | // END: else 72 | // END: body (ack$t1) 73 | // 74 | // BEGIN: program 75 | // $k31 = int 3 ; type=int 76 | // $k32 = int 10 ; type=int 77 | // $k33 = app ack$t1 $k31,$k32 ; type=int 78 | // $k34 = appx print_int $k33 ; type=unit 79 | // END: program 80 | } 81 | -------------------------------------------------------------------------------- /closure/fix_apps.go: -------------------------------------------------------------------------------- 1 | package closure 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/mir" 5 | ) 6 | 7 | // As post process of closure transform, CLOSURE_CALL flag is set to each 'app' instruction 8 | type appFixer struct { 9 | closures mir.Closures 10 | funcs mir.Toplevel 11 | fixingFuncName string 12 | fixingFunc *mir.Fun 13 | } 14 | 15 | // TODO: 16 | // Reveal how each adhoc polymorphic types should be instantiated. 17 | // e.g. 18 | // let o = None in o = (o = Some 10) || (o = Some true) in ... 19 | // In expression `None`, it's type is 'a option and 'a should be instantiated as int and bool. 20 | // In this process, collect the actual instantiated types for adhoc polymorphic type variables 21 | // (in above example, they're int and bool). 22 | // It also corrects captured values. In above case, when capturing `o`, the type of capture 23 | // value is 'a option. However, it actually needs to capture two values typed as int option and 24 | // bool option because we introduce code duplication to generate code for polymorphic type 25 | // expressions. 26 | 27 | // TODO: 28 | // Rearrange basic blocks to represents actual DAG. 29 | // All blocks should be flattened in a function. 30 | // 31 | // e.g. 32 | // 33 | // From: 34 | // block { 35 | // // entry block 36 | // if 37 | // then { 38 | // // then block 39 | // } 40 | // else { 41 | // // else block 42 | // } 43 | // insns... 44 | // } 45 | // 46 | // To: 47 | // block { 48 | // // entry block 49 | // if 50 | // } 51 | // then { 52 | // // then block 53 | // } 54 | // else { 55 | // // else block 56 | // } 57 | // precede { 58 | // // rest block 59 | // insns... 60 | // } 61 | 62 | func (fix *appFixer) fixApp(insn *mir.Insn) { 63 | switch val := insn.Val.(type) { 64 | case *mir.App: 65 | if val.Callee == fix.fixingFuncName && fix.fixingFunc != nil { 66 | fix.fixingFunc.IsRecursive = true 67 | } 68 | if val.Kind == mir.EXTERNAL_CALL { 69 | break 70 | } 71 | if _, ok := fix.closures[val.Callee]; ok { 72 | val.Kind = mir.CLOSURE_CALL 73 | break 74 | } 75 | if _, ok := fix.funcs[val.Callee]; ok { 76 | // Callee register name is a name of function, but not a closure. 77 | // So it must be known function. 78 | break 79 | } 80 | // It's not an external symbol, closure nor known function. So it must be a function 81 | // variable. All function variables are closures. So the callee must be a closure. 82 | val.Kind = mir.CLOSURE_CALL 83 | case *mir.If: 84 | fix.fixAppsInBlock(val.Then) 85 | fix.fixAppsInBlock(val.Else) 86 | case *mir.Fun: 87 | panic("unreachable") 88 | } 89 | } 90 | 91 | func (fix *appFixer) fixAppsInBlock(block *mir.Block) { 92 | begin, end := block.WholeRange() 93 | for i := begin; i != end; i = i.Next { 94 | fix.fixApp(i) 95 | } 96 | } 97 | 98 | func (fix *appFixer) fixAppsInFun(n string, f *mir.Fun, b *mir.Block) { 99 | fix.fixingFuncName = n 100 | fix.fixingFunc = f 101 | fix.fixAppsInBlock(b) 102 | } 103 | 104 | func fixAppsInProg(prog *mir.Program) { 105 | pp := &appFixer{ 106 | prog.Closures, 107 | prog.Toplevel, 108 | "", 109 | nil, 110 | } 111 | for n, f := range prog.Toplevel { 112 | pp.fixAppsInFun(n, f.Val, f.Val.Body) 113 | } 114 | pp.fixAppsInFun("", nil, prog.Entry) 115 | } 116 | -------------------------------------------------------------------------------- /closure/freevars.go: -------------------------------------------------------------------------------- 1 | package closure 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/mir" 6 | ) 7 | 8 | type freeVarsGatherer struct { 9 | found nameSet 10 | transform *transformWithKFO 11 | } 12 | 13 | func (fvg *freeVarsGatherer) add(name string) { 14 | fvg.found[name] = struct{}{} 15 | } 16 | 17 | func (fvg *freeVarsGatherer) exploreBlock(block *mir.Block) { 18 | // Traverse instructions in the block in reverse order. 19 | // First and last instructions are NOP, so skipped. 20 | for i := block.Bottom.Prev; i.Prev != nil; i = i.Prev { 21 | fvg.exploreInsn(i) 22 | } 23 | } 24 | 25 | func (fvg *freeVarsGatherer) exploreTillTheEnd(insn *mir.Insn) { 26 | end := insn 27 | for end.Next.Next != nil { 28 | // Find the last instruction before NOP 29 | end = end.Next 30 | } 31 | for i := end; i != insn.Prev; i = i.Prev { 32 | fvg.exploreInsn(i) 33 | } 34 | } 35 | 36 | func (fvg *freeVarsGatherer) exploreInsn(insn *mir.Insn) { 37 | switch val := insn.Val.(type) { 38 | case *mir.Unary: 39 | fvg.add(val.Child) 40 | case *mir.Binary: 41 | fvg.add(val.LHS) 42 | fvg.add(val.RHS) 43 | case *mir.Ref: 44 | fvg.add(val.Ident) 45 | case *mir.If: 46 | fvg.add(val.Cond) 47 | fvg.exploreBlock(val.Then) 48 | fvg.exploreBlock(val.Else) 49 | case *mir.App: 50 | // Should not add val.Callee to free variables if it is not a closure 51 | // because a normal function is treated as label, not a variable 52 | // (label is a constant). 53 | // `_, ok := fvg.transform.closures[val.Callee]; ok` cannot be used 54 | // because callee may be a function variable, which also must be treated 55 | // as closure call. 56 | if _, ok := fvg.transform.knownFuns[val.Callee]; !ok && val.Kind != mir.EXTERNAL_CALL { 57 | fvg.add(val.Callee) 58 | } 59 | for _, a := range val.Args { 60 | fvg.add(a) 61 | } 62 | case *mir.Tuple: 63 | for _, e := range val.Elems { 64 | fvg.add(e) 65 | } 66 | case *mir.Array: 67 | fvg.add(val.Size) 68 | fvg.add(val.Elem) 69 | case *mir.ArrLit: 70 | for _, e := range val.Elems { 71 | fvg.add(e) 72 | } 73 | case *mir.TplLoad: 74 | fvg.add(val.From) 75 | case *mir.ArrLoad: 76 | fvg.add(val.From) 77 | fvg.add(val.Index) 78 | case *mir.ArrStore: 79 | fvg.add(val.To) 80 | fvg.add(val.Index) 81 | fvg.add(val.RHS) 82 | case *mir.ArrLen: 83 | fvg.add(val.Array) 84 | case *mir.Some: 85 | fvg.add(val.Elem) 86 | case *mir.IsSome: 87 | fvg.add(val.OptVal) 88 | case *mir.DerefSome: 89 | fvg.add(val.SomeVal) 90 | case *mir.Fun: 91 | make, ok := fvg.transform.replacedFuns[insn] 92 | if !ok { 93 | panic(fmt.Sprintf("Visiting function '%s' for gathering free vars is not visit by transformWithKFO: %v", insn.Ident, val)) 94 | } 95 | if make == nil { 96 | // The function is not a closure. Need not to be visit because it is 97 | // simply moved to toplevel 98 | break 99 | } 100 | fv, ok := fvg.transform.closureBlockFreeVars[make.Fun] 101 | if !ok { 102 | panic(fmt.Sprintf("Applying unknown closure '%s'", insn.Ident)) 103 | } 104 | for v := range fv { 105 | fvg.add(v) 106 | } 107 | for _, v := range make.Vars { 108 | fvg.add(v) 109 | } 110 | delete(fvg.found, make.Fun) 111 | case *mir.MakeCls: 112 | panic("unreachable") 113 | } 114 | 115 | // Note: 116 | // Functions in tree will be moved to toplevel. So they should be ignored here. 117 | 118 | delete(fvg.found, insn.Ident) 119 | } 120 | 121 | func gatherFreeVars(block *mir.Block, trans *transformWithKFO) nameSet { 122 | v := &freeVarsGatherer{map[string]struct{}{}, trans} 123 | v.exploreBlock(block) 124 | return v.found 125 | } 126 | 127 | func gatherFreeVarsTillTheEnd(insn *mir.Insn, trans *transformWithKFO) nameSet { 128 | v := &freeVarsGatherer{map[string]struct{}{}, trans} 129 | v.exploreTillTheEnd(insn) 130 | return v.found 131 | } 132 | -------------------------------------------------------------------------------- /codegen/emitter_test.go: -------------------------------------------------------------------------------- 1 | package codegen 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/closure" 5 | "github.com/rhysd/gocaml/sema" 6 | "github.com/rhysd/gocaml/syntax" 7 | "github.com/rhysd/locerr" 8 | "os" 9 | "path/filepath" 10 | "strings" 11 | "testing" 12 | ) 13 | 14 | func testCreateEmitter(code string, optimize OptLevel, debug bool) (e *Emitter, err error) { 15 | s := locerr.NewDummySource(code) 16 | ast, err := syntax.Parse(s) 17 | if err != nil { 18 | return 19 | } 20 | env, ir, err := sema.SemanticsCheck(ast) 21 | if err != nil { 22 | return 23 | } 24 | prog := closure.Transform(ir) 25 | opts := EmitOptions{optimize, "", "", debug} 26 | e, err = NewEmitter(prog, env, s, opts) 27 | if err != nil { 28 | return 29 | } 30 | e.RunOptimizationPasses() 31 | return 32 | } 33 | 34 | func TestEmitLLVMIR(t *testing.T) { 35 | e, err := testCreateEmitter("let rec f x = x + x in println_int (f 42)", OptimizeDefault, false) 36 | if err != nil { 37 | t.Fatal(err) 38 | } 39 | defer e.Dispose() 40 | ir := e.EmitLLVMIR() 41 | if !strings.Contains(ir, "ModuleID = ''") { 42 | t.Fatalf("Module ID is not contained: %s", ir) 43 | } 44 | if !strings.Contains(ir, "target datalayout = ") { 45 | t.Fatalf("Data layout is not contained: %s", ir) 46 | } 47 | } 48 | 49 | func TestEmitAssembly(t *testing.T) { 50 | e, err := testCreateEmitter("let rec f x = x + x in println_int (f 42)", OptimizeDefault, false) 51 | if err != nil { 52 | t.Fatal(err) 53 | } 54 | defer e.Dispose() 55 | asm, err := e.EmitAsm() 56 | if err != nil { 57 | t.Fatal(err) 58 | } 59 | if !strings.Contains(asm, ".section") { 60 | t.Fatalf("Assembly was not emitted: %s", asm) 61 | } 62 | } 63 | 64 | func TestEmitObject(t *testing.T) { 65 | e, err := testCreateEmitter("let rec f x = x + x in println_int (f 42)", OptimizeDefault, false) 66 | if err != nil { 67 | t.Fatal(err) 68 | } 69 | defer e.Dispose() 70 | obj, err := e.EmitObject() 71 | if err != nil { 72 | t.Fatal(err) 73 | } 74 | if len(obj) == 0 { 75 | t.Fatalf("Emitted object file is empty") 76 | } 77 | } 78 | 79 | func TestEmitExecutable(t *testing.T) { 80 | e, err := testCreateEmitter("let rec f x = x + x in println_int (f 42)", OptimizeDefault, false) 81 | if err != nil { 82 | t.Fatal(err) 83 | } 84 | defer e.Dispose() 85 | outfile, err := filepath.Abs("__test_a.out") 86 | if err != nil { 87 | panic(err) 88 | } 89 | if err := e.EmitExecutable(outfile); err != nil { 90 | t.Fatal(err) 91 | } 92 | defer os.Remove(outfile) 93 | stats, err := os.Stat(outfile) 94 | if err != nil { 95 | t.Fatal("Cannot stat emitted executable", err) 96 | } 97 | if stats.IsDir() { 98 | t.Fatalf("File was not emitted actually") 99 | } 100 | if stats.Size() == 0 { 101 | t.Errorf("Emitted executable is empty") 102 | } 103 | } 104 | 105 | func TestEmitUnoptimizedLLVMIR(t *testing.T) { 106 | e, err := testCreateEmitter("let rec f x = x + x in println_int (f 42)", OptimizeNone, false) 107 | if err != nil { 108 | t.Fatal(err) 109 | } 110 | defer e.Dispose() 111 | ir := e.EmitLLVMIR() 112 | if !strings.Contains(ir, `define private i64 @"f$t1"(i64 %"x$t2")`) { 113 | t.Fatal("Function 'f' was inlined with OptimizeNone config:", ir) 114 | } 115 | } 116 | 117 | func TestEmitLLVMIRWithDebugInfo(t *testing.T) { 118 | e, err := testCreateEmitter("let rec f x = x + x in println_int (f 42)", OptimizeNone, true) 119 | if err != nil { 120 | t.Fatal(err) 121 | } 122 | defer e.Dispose() 123 | ir := e.EmitLLVMIR() 124 | if !strings.Contains(ir, "!llvm.dbg.cu = ") { 125 | t.Fatalf("Debug information is not contained: %s", ir) 126 | } 127 | } 128 | 129 | func TestEmitOptimizedAggressive(t *testing.T) { 130 | e, err := testCreateEmitter("let rec f x = x + x in println_int (f 42)", OptimizeAggressive, false) 131 | if err != nil { 132 | t.Fatal(err) 133 | } 134 | defer e.Dispose() 135 | ir := e.EmitLLVMIR() 136 | if strings.Contains(ir, `define private i64 @"f$t1"(i64 %"x$t2")`) { 137 | t.Fatalf("Function 'f' was not inlined with OptimizeAggressive config: %s", ir) 138 | } 139 | } 140 | 141 | func TestEmitIRContainingExternalSymbols(t *testing.T) { 142 | code := ` 143 | external f: int -> unit = "c_f"; 144 | external x: int = "c_x"; 145 | external y: int = "c_y"; 146 | x; y; f (x + y)` 147 | e, err := testCreateEmitter(code, OptimizeDefault, true) 148 | if err != nil { 149 | t.Fatal(err) 150 | } 151 | defer e.Dispose() 152 | ir := e.EmitLLVMIR() 153 | expects := []string{ 154 | "@c_x = external local_unnamed_addr global i64", 155 | "@c_y = external local_unnamed_addr global i64", 156 | "declare void @c_f(i64)", 157 | } 158 | for _, expect := range expects { 159 | if !strings.Contains(ir, expect) { 160 | t.Errorf("IR does not contain external symbol declaration '%s': %s", expect, ir) 161 | } 162 | } 163 | } 164 | 165 | func TestDisposeEmitter(t *testing.T) { 166 | code := ` 167 | external f: int -> unit = "c_f"; 168 | external g: bool -> unit = "c_g"; 169 | external x: int = "c_x"; 170 | external y: int = "c_y"; 171 | x; y; f (x + y); g (x < y) 172 | ` 173 | e, err := testCreateEmitter(code, OptimizeDefault, true) 174 | if err != nil { 175 | t.Fatal(err) 176 | } 177 | if e.Disposed { 178 | t.Fatal("Unexpectedly emitter was disposed") 179 | } 180 | e.Dispose() 181 | if !e.Disposed { 182 | t.Fatal("Emitter was not disposed by calling emitter.Dispose()") 183 | } 184 | // Do not crash when it's called twice 185 | e.Dispose() 186 | } 187 | -------------------------------------------------------------------------------- /codegen/example_test.go: -------------------------------------------------------------------------------- 1 | package codegen 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/closure" 6 | "github.com/rhysd/gocaml/sema" 7 | "github.com/rhysd/gocaml/syntax" 8 | "github.com/rhysd/locerr" 9 | "path/filepath" 10 | ) 11 | 12 | func Example() { 13 | file := filepath.FromSlash("../testdata/from-mincaml/ack.ml") 14 | src, err := locerr.NewSourceFromFile(file) 15 | if err != nil { 16 | // File not found 17 | panic(err) 18 | } 19 | 20 | ast, err := syntax.Parse(src) 21 | if err != nil { 22 | // When parse failed 23 | panic(err) 24 | } 25 | 26 | // Resolving symbols, type analysis and converting AST into MIR instruction block 27 | env, block, err := sema.SemanticsCheck(ast) 28 | if err != nil { 29 | // Type error detected 30 | panic(err) 31 | } 32 | 33 | // Create MIR compilation unit 34 | program := closure.Transform(block) 35 | 36 | // Make options to emit the result 37 | options := EmitOptions{ 38 | Optimization: OptimizeDefault, // Optimization level 39 | Triple: "x86_64-apple-darwin16.4.0", // Compilation target (Empty string means default target on your machine) 40 | DebugInfo: true, // Add debug information to the result or not 41 | } 42 | 43 | // Emitter object, which compiles MIR to LLVM IR and emits assembly, object file or executable 44 | // In factory function, given MIR code is already converted to LLVM IR 45 | emitter, err := NewEmitter(program, env, src, options) 46 | if err != nil { 47 | panic(err) 48 | } 49 | 50 | // You need to defer finalization 51 | defer emitter.Dispose() 52 | 53 | // Run LLVM IR level optimizations 54 | emitter.RunOptimizationPasses() 55 | 56 | // Show LLVM IR compiled from `program` 57 | fmt.Println("LLVMIR:\n" + emitter.EmitLLVMIR()) 58 | 59 | // Emit platform-dependant assembly file 60 | asm, err := emitter.EmitAsm() 61 | if err != nil { 62 | panic(err) 63 | } 64 | fmt.Println("Assembly:\n" + asm) 65 | 66 | // Emit object file contents as bytes (MIR -> LLVM IR -> object file) 67 | object, err := emitter.EmitObject() 68 | if err != nil { 69 | panic(err) 70 | } 71 | fmt.Printf("Object file:\n%v\n", object) 72 | 73 | // Emit executable file as "a.out". This is the final result we want! 74 | // It links the object file and runtime with a linker. 75 | // (MIR -> LLVM IR -> assembly -> object -> executable) 76 | if err := emitter.EmitExecutable("a.out"); err != nil { 77 | panic(err) 78 | } 79 | } 80 | -------------------------------------------------------------------------------- /codegen/executable_test.go: -------------------------------------------------------------------------------- 1 | package codegen 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/closure" 6 | "github.com/rhysd/gocaml/sema" 7 | "github.com/rhysd/gocaml/syntax" 8 | "github.com/rhysd/locerr" 9 | "io/ioutil" 10 | "os" 11 | "os/exec" 12 | "path/filepath" 13 | "strings" 14 | "testing" 15 | ) 16 | 17 | func TestExecutable(t *testing.T) { 18 | inputs, err := filepath.Glob("testdata/*.ml") 19 | if err != nil { 20 | panic(err) 21 | } 22 | outputs, err := filepath.Glob("testdata/*.out") 23 | if err != nil { 24 | panic(err) 25 | } 26 | if len(inputs) == 0 { 27 | panic("No test found") 28 | } 29 | for _, input := range inputs { 30 | base := filepath.Base(input) 31 | expect := "" 32 | outputFile := strings.TrimSuffix(input, filepath.Ext(input)) + ".out" 33 | for _, e := range outputs { 34 | if e == outputFile { 35 | expect = e 36 | break 37 | } 38 | } 39 | if expect == "" { 40 | panic(fmt.Sprintf("Expected output file '%s' was not found for code '%s'", outputFile, input)) 41 | } 42 | t.Run(base, func(t *testing.T) { 43 | defer func() { 44 | err := recover() 45 | if err != nil { 46 | t.Fatal(err) 47 | } 48 | }() 49 | 50 | s, err := locerr.NewSourceFromFile(input) 51 | if err != nil { 52 | t.Fatal(err) 53 | } 54 | 55 | ast, err := syntax.Parse(s) 56 | if err != nil { 57 | t.Fatal(err) 58 | } 59 | 60 | env, ir, err := sema.SemanticsCheck(ast) 61 | if err != nil { 62 | t.Fatal(err) 63 | } 64 | prog := closure.Transform(ir) 65 | 66 | opts := EmitOptions{OptimizeDefault, "", "", true} 67 | emitter, err := NewEmitter(prog, env, s, opts) 68 | if err != nil { 69 | t.Fatal(err) 70 | } 71 | defer emitter.Dispose() 72 | emitter.RunOptimizationPasses() 73 | outfile, err := filepath.Abs(fmt.Sprintf("test.%s.a.out", base)) 74 | if err != nil { 75 | panic(err) 76 | } 77 | if err := emitter.EmitExecutable(outfile); err != nil { 78 | t.Fatal(err) 79 | } 80 | defer os.Remove(outfile) 81 | 82 | bytes, err := exec.Command(outfile).Output() 83 | if err != nil { 84 | t.Fatal(err) 85 | } 86 | got := string(bytes) 87 | bytes, err = ioutil.ReadFile(expect) 88 | if err != nil { 89 | panic(err) 90 | } 91 | want := "" 92 | if len(bytes) > 0 { 93 | want = string(bytes[:len(bytes)-1]) // Trim EOL (newline at the end of file) 94 | } 95 | 96 | if got != want { 97 | t.Fatalf("Unexpected output from executable:\n\nGot: '%s'\nWant: '%s'", got, want) 98 | } 99 | }) 100 | } 101 | } 102 | 103 | func BenchmarkExecutableCreation(b *testing.B) { 104 | inputs, err := filepath.Glob("testdata/*.ml") 105 | if err != nil { 106 | panic(err) 107 | } 108 | if len(inputs) == 0 { 109 | panic("No test found") 110 | } 111 | sources := make(map[string]*locerr.Source, len(inputs)) 112 | for _, input := range inputs { 113 | source, err := locerr.NewSourceFromFile(input) 114 | if err != nil { 115 | b.Fatal(err) 116 | } 117 | base := filepath.Base(input) 118 | sources[base] = source 119 | } 120 | 121 | makeEmitter := func(source *locerr.Source) *Emitter { 122 | ast, err := syntax.Parse(source) 123 | if err != nil { 124 | b.Fatal(err) 125 | } 126 | 127 | env, ir, err := sema.SemanticsCheck(ast) 128 | if err != nil { 129 | b.Fatal(err) 130 | } 131 | prog := closure.Transform(ir) 132 | 133 | opts := EmitOptions{OptimizeDefault, "", "", true} 134 | emitter, err := NewEmitter(prog, env, source, opts) 135 | if err != nil { 136 | b.Fatal(err) 137 | } 138 | return emitter 139 | } 140 | 141 | b.Run("emit executable", func(b *testing.B) { 142 | for i := 0; i < b.N; i++ { 143 | for base, source := range sources { 144 | emitter := makeEmitter(source) 145 | defer emitter.Dispose() 146 | emitter.RunOptimizationPasses() 147 | outfile, err := filepath.Abs(fmt.Sprintf("test.%s.a.out", base)) 148 | if err != nil { 149 | panic(err) 150 | } 151 | if err := emitter.EmitExecutable(outfile); err != nil { 152 | b.Fatal(err) 153 | } 154 | defer os.Remove(outfile) 155 | } 156 | } 157 | }) 158 | b.Run("build LLVM IR", func(b *testing.B) { 159 | for i := 0; i < b.N; i++ { 160 | for _, source := range sources { 161 | e := makeEmitter(source) 162 | defer e.Dispose() 163 | } 164 | } 165 | }) 166 | } 167 | 168 | func TestExamples(t *testing.T) { 169 | examples, err := filepath.Glob("../examples/*.ml") 170 | if err != nil { 171 | panic(err) 172 | } 173 | for _, example := range examples { 174 | t.Run(example, func(t *testing.T) { 175 | s, err := locerr.NewSourceFromFile(example) 176 | if err != nil { 177 | t.Fatal(err) 178 | } 179 | 180 | ast, err := syntax.Parse(s) 181 | if err != nil { 182 | t.Fatal(err) 183 | } 184 | 185 | env, ir, err := sema.SemanticsCheck(ast) 186 | if err != nil { 187 | t.Fatal(err) 188 | } 189 | prog := closure.Transform(ir) 190 | 191 | opts := EmitOptions{OptimizeDefault, "", "", true} 192 | emitter, err := NewEmitter(prog, env, s, opts) 193 | if err != nil { 194 | t.Fatal(err) 195 | } 196 | defer emitter.Dispose() 197 | emitter.RunOptimizationPasses() 198 | }) 199 | } 200 | } 201 | -------------------------------------------------------------------------------- /codegen/linker.go: -------------------------------------------------------------------------------- 1 | package codegen 2 | 3 | import ( 4 | "github.com/rhysd/locerr" 5 | "go/build" 6 | "os" 7 | "os/exec" 8 | "path/filepath" 9 | "runtime" 10 | "strings" 11 | ) 12 | 13 | func gopaths() []string { 14 | s := os.Getenv("GOPATH") 15 | if s == "" { 16 | // Note: 17 | // build.Default.GOPATH considers $GOPATH environment variable, but it's not sufficient in 18 | // this case. It makes build.Default.GOPATH variable before running main() function. 19 | // However, we want to change $GOPATH for testing after main() function starts. 20 | // So we need to look $GOPATH here. 21 | s = build.Default.GOPATH 22 | } 23 | return filepath.SplitList(s) 24 | } 25 | 26 | func detectRuntimePath() (string, error) { 27 | // XXX: 28 | // Need to investigate solid way to get runtime library path 29 | 30 | fromBuildDir, err := filepath.Abs(filepath.Join(filepath.Dir(os.Args[0]), "runtime/gocamlrt.a")) 31 | if err != nil { 32 | return "", err 33 | } 34 | if _, err := os.Stat(fromBuildDir); err == nil { 35 | return fromBuildDir, nil 36 | } 37 | 38 | candidates := []string{fromBuildDir} 39 | 40 | for _, gopath := range gopaths() { 41 | fromGopath := filepath.Join(gopath, "src/github.com/rhysd/gocaml/runtime/gocamlrt.a") 42 | if _, err := os.Stat(fromGopath); err == nil { 43 | return fromGopath, nil 44 | } 45 | candidates = append(candidates, fromGopath) 46 | } 47 | 48 | return "", locerr.Errorf("Runtime library (gocamlrt.a) was not found. Candidates: %s", strings.Join(candidates, ", ")) 49 | } 50 | 51 | func detectLibgcPath() string { 52 | if runtime.GOOS == "darwin" { 53 | brewLib := filepath.Clean("/usr/local/opt/bdw-gc/lib") 54 | if _, err := os.Stat(brewLib); err == nil { 55 | return brewLib 56 | } 57 | } 58 | 59 | return "" 60 | } 61 | 62 | type linker struct { 63 | linkerCmd string 64 | ldflags string 65 | } 66 | 67 | func newDefaultLinker(ldflags string) *linker { 68 | cmd := os.Getenv("GOCAML_LINKER_CMD") 69 | if cmd == "" { 70 | cmd = "clang" 71 | } 72 | return &linker{cmd, ldflags} 73 | } 74 | 75 | func (lnk *linker) cmdFailed(args []string, msg string) error { 76 | return locerr.Errorf("Linker command failed: %s %s:\n%s", lnk.linkerCmd, strings.Join(args, " "), msg) 77 | } 78 | 79 | func (lnk *linker) link(executable string, objFiles []string) error { 80 | // TODO: Consider Windows environment 81 | 82 | runtimePath, err := detectRuntimePath() 83 | if err != nil { 84 | return err 85 | } 86 | 87 | args := append(objFiles, "-o", executable, runtimePath, "-L/usr/local/lib", "-L/usr/lib") 88 | if path := detectLibgcPath(); path != "" { 89 | args = append(args, "-L"+path) 90 | } 91 | args = append(args, "-lgc", lnk.ldflags) 92 | 93 | if _, err := exec.Command(lnk.linkerCmd, args...).Output(); err != nil { 94 | if exiterr, ok := err.(*exec.ExitError); ok { 95 | return lnk.cmdFailed(args, string(exiterr.Stderr)) 96 | } 97 | return lnk.cmdFailed(args, err.Error()) 98 | } 99 | 100 | return nil 101 | } 102 | -------------------------------------------------------------------------------- /codegen/linker_test.go: -------------------------------------------------------------------------------- 1 | package codegen 2 | 3 | import ( 4 | "os" 5 | "strings" 6 | "testing" 7 | ) 8 | 9 | func TestLinkFailed(t *testing.T) { 10 | l := newDefaultLinker("") 11 | err := l.link("dummy", []string{"not-exist.o"}) 12 | if err == nil { 13 | t.Fatalf("No error occurred") 14 | } 15 | msg := err.Error() 16 | if !strings.Contains(msg, "Linker command failed: ") { 17 | t.Fatalf("Unexpected error message '%s'", msg) 18 | } 19 | } 20 | 21 | func TestMultiGOPATH(t *testing.T) { 22 | gopath := os.Getenv("GOPATH") 23 | defer os.Setenv("GOPATH", gopath) 24 | os.Setenv("GOPATH", "unknown-path:"+gopath) 25 | 26 | l := newDefaultLinker("") 27 | err := l.link("dummy", []string{"not-exist.o"}) 28 | if !strings.Contains(err.Error(), "Linker command failed: ") { 29 | t.Fatalf("Unexpected error message '%s'", err.Error()) 30 | } 31 | } 32 | 33 | func TestRuntimeNotFound(t *testing.T) { 34 | gopath := os.Getenv("GOPATH") 35 | defer os.Setenv("GOPATH", gopath) 36 | os.Setenv("GOPATH", "/unknown/path/to/somewhere") 37 | 38 | l := newDefaultLinker("") 39 | err := l.link("dummy", []string{"not-exist.o"}) 40 | if !strings.Contains(err.Error(), "Runtime library (gocamlrt.a) was not found") { 41 | t.Fatalf("Unexpected error message '%s'", err.Error()) 42 | } 43 | } 44 | 45 | func TestCustomizeLinkerCommand(t *testing.T) { 46 | saved := os.Getenv("GOCAML_LINKER_CMD") 47 | defer os.Setenv("GOCAML_LINKER_CMD", saved) 48 | os.Setenv("GOCAML_LINKER_CMD", "linker-command-for-test") 49 | l := newDefaultLinker("") 50 | if l.linkerCmd != "linker-command-for-test" { 51 | t.Fatalf("Wanted 'linker-command-for-test' as linker command but had '%s'", l.linkerCmd) 52 | } 53 | } 54 | -------------------------------------------------------------------------------- /codegen/targets.go: -------------------------------------------------------------------------------- 1 | package codegen 2 | 3 | import ( 4 | "llvm.org/llvm/bindings/go/llvm" 5 | ) 6 | 7 | type Target struct { 8 | Name string 9 | Description string 10 | } 11 | 12 | func AllTargets() []Target { 13 | targets := []Target{} 14 | for t := llvm.FirstTarget(); t.C != nil; t = t.NextTarget() { 15 | targets = append(targets, Target{t.Name(), t.Description()}) 16 | } 17 | return targets 18 | } 19 | -------------------------------------------------------------------------------- /codegen/targets_test.go: -------------------------------------------------------------------------------- 1 | package codegen 2 | 3 | import ( 4 | "testing" 5 | ) 6 | 7 | func TestAllTargets(t *testing.T) { 8 | targets := AllTargets() 9 | if len(targets) == 0 { 10 | t.Fatalf("No target was found") 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /codegen/testdata/argv.ml: -------------------------------------------------------------------------------- 1 | print_str "argc: "; println_int (Array.length argv); 2 | let prog = argv.(0) in 3 | let size = str_length prog in 4 | (* prog is a full path to executable. Check only file extension. *) 5 | print_str "prog: "; print_str (str_sub prog (size - 4) size) 6 | -------------------------------------------------------------------------------- /codegen/testdata/argv.out: -------------------------------------------------------------------------------- 1 | argc: 1 2 | prog: .out 3 | -------------------------------------------------------------------------------- /codegen/testdata/array.ml: -------------------------------------------------------------------------------- 1 | let a = Array.make 3 3.14 in 2 | let e0 = a.(0) in 3 | let e1 = a.(1) in 4 | let e2 = a.(2) in 5 | println_float e0; 6 | println_float e1; 7 | println_float e2; 8 | println_float (a.(0) +. a.(1) +. a.(2)); 9 | 10 | let b = Array.make 3 true in 11 | let rec first x = x.(0) in 12 | println_bool ((first b) = true); 13 | 14 | let c = Array.make 3 1.14 in 15 | let rec g x = c.(0) -. x.(1) in 16 | println_float (g a); 17 | 18 | let d = Array.make 3 first in 19 | println_bool ((d.(0)) b); 20 | 21 | let rec getarr _ = Array.make 7 (-1) in 22 | println_int (getarr ()).(1); 23 | 24 | a.(1) <- 1.1; 25 | println_float (a.(1)); 26 | 27 | b.(1) <- false; 28 | println_bool (b.(1)); 29 | 30 | a.(0) <- (a.(1)) +. a.(0) +. c.(0); 31 | println_float (a.(0)); 32 | 33 | println_int (Array.length b); 34 | print_int (Array.length (getarr())) 35 | -------------------------------------------------------------------------------- /codegen/testdata/array.out: -------------------------------------------------------------------------------- 1 | 3.14 2 | 3.14 3 | 3.14 4 | 9.42 5 | true 6 | -2 7 | true 8 | -1 9 | 1.1 10 | false 11 | 5.38 12 | 3 13 | 7 14 | -------------------------------------------------------------------------------- /codegen/testdata/array_lit.ml: -------------------------------------------------------------------------------- 1 | let a = [| 1; 2; 3; |] in 2 | println_int (Array.length a); 3 | println_int a.(0); 4 | println_int a.(1); 5 | println_int a.(2); 6 | 7 | let rec f _: int array = [| |] in 8 | println_int (Array.length (f ())); 9 | 10 | let a = [| [| 1 |]; [| 10; 11; |]; [| 20; 21; 22; |] |] in 11 | println_int a.(0).(0); 12 | println_int a.(1).(1); 13 | println_int a.(2).(2); 14 | 15 | let rec f b = 16 | let x = [| a.(1).(0) |] in 17 | [| x.(0) + a.(2).(1) + b.(1) |] 18 | in 19 | println_int (f [| 100; 200 |]).(0); 20 | 21 | let a = [| (1, 3.14); (10, 1.0) |] in 22 | let (i, f) = a.(1) in 23 | a.(0) <- (i + 33, f); 24 | let (i, _) = a.(0) in 25 | println_int i; 26 | 27 | let a = [| [| true |]; [| |]; [| false |] |] in 28 | println_bool a.(0).(0); 29 | println_bool a.(2).(0); 30 | a.(1) <- [| false |]; 31 | println_int (Array.length a.(1)); 32 | println_bool a.(1).(0) 33 | -------------------------------------------------------------------------------- /codegen/testdata/array_lit.out: -------------------------------------------------------------------------------- 1 | 3 2 | 1 3 | 2 4 | 3 5 | 0 6 | 1 7 | 11 8 | 22 9 | 231 10 | 43 11 | true 12 | false 13 | 1 14 | false 15 | 16 | -------------------------------------------------------------------------------- /codegen/testdata/arrstore_bug.ml: -------------------------------------------------------------------------------- 1 | let arr = Array.make 1 0 in 2 | let rec f x = 3 | arr.(0) <- 42 4 | in 5 | f 0; 6 | print_int arr.(0) 7 | -------------------------------------------------------------------------------- /codegen/testdata/arrstore_bug.out: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /codegen/testdata/binary_op.ml: -------------------------------------------------------------------------------- 1 | println_int (1 + 2); 2 | println_int (1 - 2); 3 | println_float (1.0 +. 2.0); 4 | println_float (1.0 -. 2.0); 5 | println_float (1.0 *. 2.0); 6 | println_float (1.0 /. 2.0); 7 | println_bool (1 < 2); 8 | println_bool (1 > 2); 9 | println_bool (1 <= 2); 10 | println_bool (1 >= 2); 11 | println_bool (1 = 2); 12 | println_bool (1 <> 2); 13 | println_bool (1.0 < 2.0); 14 | println_bool (1.0 > 2.0); 15 | println_bool (1.0 <= 2.0); 16 | println_bool (1.0 >= 2.0); 17 | println_bool (1.0 = 2.0); 18 | println_bool (1.0 <> 2.0); 19 | println_bool (true <> false); 20 | println_bool (true = false); 21 | println_bool ((1, 2) = (3, 4)); 22 | println_bool ((1, 2) <> (3, 4)); 23 | println_int ((1 + 2) - (3 + 4)); 24 | println_bool ((1 - 2) = (3 - 4)); 25 | println_bool ((1 - 2) > (3 - 6)); 26 | println_bool (() <> ()); 27 | println_int (3 * 9); 28 | println_int (10 / 3); 29 | println_int (3 * 9 + 10 / 3 - 4); 30 | print_bool (() = ()) 31 | -------------------------------------------------------------------------------- /codegen/testdata/binary_op.out: -------------------------------------------------------------------------------- 1 | 3 2 | -1 3 | 3 4 | -1 5 | 2 6 | 0.5 7 | true 8 | false 9 | true 10 | false 11 | false 12 | true 13 | true 14 | false 15 | true 16 | false 17 | false 18 | true 19 | true 20 | false 21 | false 22 | true 23 | -4 24 | true 25 | true 26 | false 27 | 27 28 | 3 29 | 26 30 | true 31 | -------------------------------------------------------------------------------- /codegen/testdata/builtin_chain.ml: -------------------------------------------------------------------------------- 1 | print_int (str_length (str_sub (str_concat "foo" "bar") 2 4)) 2 | -------------------------------------------------------------------------------- /codegen/testdata/builtin_chain.out: -------------------------------------------------------------------------------- 1 | 2 2 | -------------------------------------------------------------------------------- /codegen/testdata/builtins.ml: -------------------------------------------------------------------------------- 1 | print_int 42; 2 | print_bool true; 3 | print_float 3.14; 4 | print_str "PIYOOO"; 5 | println_bool false; 6 | println_int 10; 7 | println_float 3.14; 8 | println_str "POYOOO"; 9 | 10 | println_int (float_to_int 3.14); 11 | println_float ((int_to_float 3) +. 1.1); 12 | println_int (str_length "aiueo"); 13 | 14 | let a = int_to_str 42 in 15 | println_str a; 16 | println_int (str_length a); 17 | let a = int_to_str (-10) in 18 | println_str a; 19 | println_int (str_length a); 20 | 21 | let a = float_to_str 3.14 in 22 | println_str a; 23 | println_int (str_length a); 24 | let a = float_to_str (-.1.123) in 25 | println_str a; 26 | println_int (str_length a); 27 | 28 | println_int (str_to_int "1234"); 29 | println_int (str_to_int "-1234"); 30 | 31 | println_float (str_to_float "3.14"); 32 | println_float (str_to_float "-1.4142"); 33 | 34 | println_int (bit_and 2 1); 35 | println_int (bit_or 3 1); 36 | println_int (bit_xor 3 1); 37 | println_int (bit_lsft 1 10); 38 | println_int (bit_rsft 256 4); 39 | println_int (bit_inv 0); 40 | 41 | () 42 | -------------------------------------------------------------------------------- /codegen/testdata/builtins.out: -------------------------------------------------------------------------------- 1 | 42true3.14PIYOOOfalse 2 | 10 3 | 3.14 4 | POYOOO 5 | 3 6 | 4.1 7 | 5 8 | 42 9 | 2 10 | -10 11 | 3 12 | 3.14 13 | 4 14 | -1.123 15 | 6 16 | 1234 17 | -1234 18 | 3.14 19 | -1.4142 20 | 0 21 | 3 22 | 2 23 | 1024 24 | 16 25 | -1 26 | 27 | -------------------------------------------------------------------------------- /codegen/testdata/closure.ml: -------------------------------------------------------------------------------- 1 | let a = 42 in 2 | let rec f x = a + x in 3 | print_int (f 42) 4 | -------------------------------------------------------------------------------- /codegen/testdata/closure.out: -------------------------------------------------------------------------------- 1 | 84 2 | -------------------------------------------------------------------------------- /codegen/testdata/compare_fun.ml: -------------------------------------------------------------------------------- 1 | let rec f x = x + x in 2 | let rec g x = x + x in 3 | let a = 42 in 4 | let rec h x = a + x in 5 | let rec i x = a + x in 6 | let rec getf _ = f in 7 | let rec geth _ = h in 8 | let rec dummy b = () in 9 | let rec dummycl b = a; () in 10 | println_bool (f = f); 11 | println_bool (f <> f); 12 | println_bool (f = g); 13 | println_bool (f <> g); 14 | println_bool (h = h); 15 | println_bool (h <> h); 16 | println_bool (h = i); 17 | println_bool (h <> i); 18 | println_bool (g = h); 19 | println_bool (g <> h); 20 | println_bool ((getf ()) = f); 21 | println_bool ((getf ()) <> f); 22 | println_bool ((getf ()) = g); 23 | println_bool ((getf ()) <> g); 24 | println_bool ((geth ()) = h); 25 | println_bool ((geth ()) = g); 26 | println_bool (dummy = println_bool); 27 | print_bool (dummycl = println_bool) 28 | 29 | -------------------------------------------------------------------------------- /codegen/testdata/compare_fun.out: -------------------------------------------------------------------------------- 1 | true 2 | false 3 | false 4 | true 5 | true 6 | false 7 | false 8 | true 9 | false 10 | true 11 | true 12 | false 13 | false 14 | true 15 | true 16 | false 17 | false 18 | false 19 | -------------------------------------------------------------------------------- /codegen/testdata/constants.ml: -------------------------------------------------------------------------------- 1 | let a = 42 in 2 | let b = 3.14 in 3 | let c = true in 4 | let d = false in 5 | let e = () in 6 | println_int a; 7 | println_float b; 8 | println_bool c; 9 | print_bool d 10 | -------------------------------------------------------------------------------- /codegen/testdata/constants.out: -------------------------------------------------------------------------------- 1 | 42 2 | 3.14 3 | true 4 | false 5 | -------------------------------------------------------------------------------- /codegen/testdata/external_function_var.ml: -------------------------------------------------------------------------------- 1 | let rec ext_fun _ = print_int in 2 | (ext_fun ()) 42 3 | -------------------------------------------------------------------------------- /codegen/testdata/external_function_var.out: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /codegen/testdata/file.ml: -------------------------------------------------------------------------------- 1 | let f = read_file "unknown_file" in 2 | println_str (match f with Some c -> "found" | None -> "not found"); 3 | 4 | let f = read_file "testdata/test.txt" in 5 | print_str (match f with Some c -> c | None -> "not found"); 6 | 7 | let b = write_file "testdata/piyo.txt" "this is test for write_file()" in 8 | if not b then println_str "failed to write!" else 9 | let f = read_file "testdata/piyo.txt" in 10 | println_str (match f with Some c -> c | None -> "failed to open file") 11 | -------------------------------------------------------------------------------- /codegen/testdata/file.out: -------------------------------------------------------------------------------- 1 | not found 2 | this is test for read_file() 3 | this is test for write_file() 4 | 5 | -------------------------------------------------------------------------------- /codegen/testdata/function.ml: -------------------------------------------------------------------------------- 1 | let rec f x = x + x in 2 | print_int (f 21) 3 | -------------------------------------------------------------------------------- /codegen/testdata/function.out: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /codegen/testdata/function_var.ml: -------------------------------------------------------------------------------- 1 | let a = 42 in 2 | let rec f x = a + x in 3 | let rec getf _ = f in 4 | print_int ((getf ()) 13) 5 | -------------------------------------------------------------------------------- /codegen/testdata/function_var.out: -------------------------------------------------------------------------------- 1 | 55 2 | -------------------------------------------------------------------------------- /codegen/testdata/gc_api.ml: -------------------------------------------------------------------------------- 1 | let rec f _ = 2 | let a = Array.make 100 "aaa" in 3 | a.(10) 4 | in 5 | let s = f () in 6 | do_garbage_collection (); 7 | println_str s; 8 | disable_garbage_collection (); 9 | let s = f () in 10 | do_garbage_collection (); 11 | println_str s; 12 | enable_garbage_collection () 13 | -------------------------------------------------------------------------------- /codegen/testdata/gc_api.out: -------------------------------------------------------------------------------- 1 | aaa 2 | aaa 3 | 4 | -------------------------------------------------------------------------------- /codegen/testdata/helloworld.ml: -------------------------------------------------------------------------------- 1 | print_int 42 2 | -------------------------------------------------------------------------------- /codegen/testdata/helloworld.out: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /codegen/testdata/issue_15_fixed.ml: -------------------------------------------------------------------------------- 1 | let rec go xs f = 2 | let x = xs.(0) in 3 | (f xs.(0)) + (f x) 4 | in 5 | let a = Array.make 1 3 in 6 | let b = go a (fun x -> x) in 7 | print_int b 8 | -------------------------------------------------------------------------------- /codegen/testdata/issue_15_fixed.out: -------------------------------------------------------------------------------- 1 | 6 2 | -------------------------------------------------------------------------------- /codegen/testdata/lambda.ml: -------------------------------------------------------------------------------- 1 | let foo = fun x y -> x + y in 2 | let i = 42 in 3 | let clo = fun x y -> (foo x y) - i in 4 | let rec print f a b = println_int(f a b) in 5 | print foo 10 42; 6 | print (fun x y -> x - y) 10 42; 7 | print clo 100 42 8 | -------------------------------------------------------------------------------- /codegen/testdata/lambda.out: -------------------------------------------------------------------------------- 1 | 52 2 | -32 3 | 100 4 | 5 | -------------------------------------------------------------------------------- /codegen/testdata/local_function_var.ml: -------------------------------------------------------------------------------- 1 | let rec compose f g = 2 | let rec h x = f (g x) in 3 | h in 4 | let rec twice x = x + x in 5 | let rec plus10 x = x + 10 in 6 | let f = compose twice plus10 in 7 | print_int (f 20) 8 | 9 | -------------------------------------------------------------------------------- /codegen/testdata/local_function_var.out: -------------------------------------------------------------------------------- 1 | 60 2 | -------------------------------------------------------------------------------- /codegen/testdata/logical_op.ml: -------------------------------------------------------------------------------- 1 | println_bool (true && true); 2 | println_bool (true && false); 3 | println_bool (false && true); 4 | println_bool (false && false); 5 | println_bool (true || true); 6 | println_bool (true || false); 7 | println_bool (false || true); 8 | println_bool (false || false); 9 | 10 | let a = true || true && false in 11 | let b = true || false && false in 12 | let c = false && true || true in 13 | let d = false && false || true in 14 | println_bool a; 15 | println_bool b; 16 | println_bool c; 17 | println_bool d; 18 | 19 | let e = false || true || false in 20 | let f = true && true && false in 21 | println_bool e; 22 | println_bool f; 23 | 24 | let rec t _ = true in 25 | let rec f _ = false in 26 | println_bool ((t ()) && (f ())); 27 | print_bool ((t ()) || (f ())) 28 | -------------------------------------------------------------------------------- /codegen/testdata/logical_op.out: -------------------------------------------------------------------------------- 1 | true 2 | false 3 | false 4 | false 5 | true 6 | true 7 | true 8 | false 9 | true 10 | true 11 | true 12 | true 13 | true 14 | false 15 | false 16 | true 17 | -------------------------------------------------------------------------------- /codegen/testdata/multi_dim_array.ml: -------------------------------------------------------------------------------- 1 | (* Shallow multi-dimension array *) 2 | let rec shallow_dim2 m n x = Array.make m (Array.make n x) in 3 | let a = shallow_dim2 3 2 42 in 4 | println_int a.(0).(1); 5 | 6 | a.(0).(1) <- 21; 7 | println_int a.(0).(1); 8 | println_int a.(1).(1); 9 | 10 | a.(1).(1) <- a.(0).(1) + a.(1).(1); 11 | println_int a.(1).(1); 12 | println_int a.(2).(1); 13 | println_int a.(0).(1); 14 | 15 | (* Deep-copied multi-dimension array *) 16 | let rec deep_dim2 m n x = 17 | let dummy = Array.make 0 x in 18 | let buf = Array.make m dummy in 19 | let rec set_elems m = 20 | if m < 0 then () else ( 21 | buf.(m) <- Array.make n x; 22 | set_elems (m - 1) 23 | ) 24 | in 25 | set_elems (m - 1); 26 | buf 27 | in 28 | 29 | let b = deep_dim2 3 2 42 in 30 | println_int b.(0).(1); 31 | 32 | b.(0).(1) <- 21; 33 | println_int b.(0).(1); 34 | 35 | b.(1).(1) <- b.(0).(1) + b.(1).(1); 36 | println_int b.(1).(1); 37 | println_int b.(2).(0); 38 | println_int b.(0).(1); 39 | 40 | (* Assign dynbamic length array to 2-dim array *) 41 | b.(2) <- Array.make 11 99; 42 | println_int b.(2).(0); 43 | println_int b.(2).(8); 44 | 45 | println_int (Array.length b); 46 | println_int (Array.length (b.(0))); 47 | print_int (Array.length (b.(2))) 48 | 49 | -------------------------------------------------------------------------------- /codegen/testdata/multi_dim_array.out: -------------------------------------------------------------------------------- 1 | 42 2 | 21 3 | 21 4 | 42 5 | 42 6 | 42 7 | 42 8 | 21 9 | 63 10 | 42 11 | 21 12 | 99 13 | 99 14 | 3 15 | 2 16 | 11 17 | -------------------------------------------------------------------------------- /codegen/testdata/multi_functions.ml: -------------------------------------------------------------------------------- 1 | let rec f x = x + x in 2 | let rec g x = (f x) + (f x) in 3 | let a = 42 in 4 | let rec h x = a + x in 5 | let rec i x = a + (h x) in 6 | let rec j x = 7 | let rec p x = f (g x) in 8 | let rec q x = h (i x) in 9 | (p x) + (q x) in 10 | println_int (f 10); 11 | println_int (g 10); 12 | println_int (h 10); 13 | println_int (i 10); 14 | print_int (j 10) 15 | -------------------------------------------------------------------------------- /codegen/testdata/multi_functions.out: -------------------------------------------------------------------------------- 1 | 20 2 | 40 3 | 52 4 | 94 5 | 216 6 | -------------------------------------------------------------------------------- /codegen/testdata/nested_aggregates.ml: -------------------------------------------------------------------------------- 1 | let pairs = Array.make 4 (1, true, 3.14) in 2 | let rec show t = 3 | let (a, b, c) = t in 4 | println_int a; 5 | println_bool b; 6 | println_float c; 7 | () 8 | in 9 | show (pairs.(1)); 10 | 11 | pairs.(1) <- (42, false, 1.1); 12 | show (pairs.(0)); 13 | show (pairs.(1)); 14 | 15 | let arrays = (Array.make 2 true, Array.make 3 42, Array.make 4 1.1) in 16 | let rec show x = 17 | let (a, b, c) = x in 18 | println_bool a.(0); 19 | println_int b.(1); 20 | println_float c.(2); 21 | () 22 | in 23 | show arrays; 24 | let (a, b, c) = arrays in 25 | a.(0) <- false; 26 | b.(1) <- -3; 27 | c.(2) <- 3.14; 28 | show arrays; 29 | 30 | let rec f x = 31 | let (a, b, c) = pairs.(0) in x + a 32 | in 33 | println_int (f 10); 34 | let rec g x = let (a, b, c) = arrays in c.(3) *. x in 35 | println_float (g 3.3); 36 | 37 | let nested = Array.make 3 (true, Array.make 2 (false, Array.make 1 (1, 3.14))) in 38 | let (_, a) = nested.(1) in 39 | let (_, a) = a.(0) in 40 | let (_, f) = a.(0) in 41 | println_float f; 42 | 43 | let zero_length = Array.make 0 (true, Array.make 0 (false, true)) in 44 | 45 | () 46 | -------------------------------------------------------------------------------- /codegen/testdata/nested_aggregates.out: -------------------------------------------------------------------------------- 1 | 1 2 | true 3 | 3.14 4 | 1 5 | true 6 | 3.14 7 | 42 8 | false 9 | 1.1 10 | true 11 | 42 12 | 1.1 13 | false 14 | -3 15 | 3.14 16 | 11 17 | 3.63 18 | 3.14 19 | 20 | -------------------------------------------------------------------------------- /codegen/testdata/nested_block.ml: -------------------------------------------------------------------------------- 1 | let b = true in 2 | let r = if b then 3.14 else 1.0 in 3 | print_float r 4 | -------------------------------------------------------------------------------- /codegen/testdata/nested_block.out: -------------------------------------------------------------------------------- 1 | 3.14 2 | -------------------------------------------------------------------------------- /codegen/testdata/option_eq.ml: -------------------------------------------------------------------------------- 1 | (* Make a function for the case where both side is None *) 2 | let rec f a b = 3 | a = b 4 | in 5 | println_bool (f (Some 42) (Some 42)); 6 | println_bool (f (Some 21) (Some 42)); 7 | println_bool (f None (Some 42)); 8 | println_bool (f (Some 42) None); 9 | println_bool (f None None); 10 | println_str ""; 11 | let rec f a b = 12 | a <> b 13 | in 14 | println_bool (f (Some 42) (Some 42)); 15 | println_bool (f (Some 21) (Some 42)); 16 | println_bool (f None (Some 42)); 17 | println_bool (f (Some 42) None); 18 | println_bool (f None None); 19 | println_str ""; 20 | 21 | println_bool ((Some (Some 42)) = (Some (Some 42))); 22 | println_bool ((Some (Some 42)) = (Some (Some 21))); 23 | println_bool ((Some None) = (Some (Some 21))); 24 | println_bool (None = (Some (Some 21))); 25 | println_str ""; 26 | 27 | println_bool ((Some 3.14) = (Some 3.14)); 28 | println_bool ((Some f) = (Some f)); 29 | println_bool ((Some true) = (Some true)); 30 | println_bool ((Some "foo") = (Some "foo")); 31 | println_bool ((Some ()) = (Some ())); 32 | () 33 | -------------------------------------------------------------------------------- /codegen/testdata/option_eq.out: -------------------------------------------------------------------------------- 1 | true 2 | false 3 | false 4 | false 5 | true 6 | 7 | false 8 | true 9 | true 10 | true 11 | false 12 | 13 | true 14 | false 15 | false 16 | false 17 | 18 | true 19 | true 20 | true 21 | true 22 | true 23 | 24 | -------------------------------------------------------------------------------- /codegen/testdata/option_values.ml: -------------------------------------------------------------------------------- 1 | (* basic *) 2 | let o = Some 42 in 3 | let rec f x = match x with 4 | | Some i -> println_int i 5 | | None -> println_str "none" 6 | in 7 | f None; (* can be inferred from signature of println_int *) 8 | f o; 9 | 10 | (* nested *) 11 | let rec f x = match x with 12 | | Some x -> match x with 13 | | Some i -> println_int i 14 | | None -> println_str "none2" 15 | | None -> println_str "none1" 16 | in 17 | let o = Some (Some 42) in 18 | f o; 19 | let o = Some None in 20 | f o; 21 | f None; 22 | 23 | (* return option *) 24 | let rec f x = Some x in 25 | match f 10 with Some(i) -> println_int i | None -> println_str "oops"; 26 | 27 | (* capture option value *) 28 | let o = Some 3.14 in 29 | let rec f x = match o with 30 | | Some f -> f +. x 31 | | None -> -.x 32 | in 33 | println_float (f 1.1); 34 | 35 | (* capture dereferenced variable *) 36 | let rec f o = match o with 37 | | Some i -> let rec f x = x + i in f 38 | | None -> let rec f x = -x in f 39 | in 40 | println_int ((f (Some 42)) 11); 41 | println_int ((f None) 11); 42 | 43 | (* check contents with 'match' expression *) 44 | let rec is_some o = match o with Some _ -> true | None -> false in 45 | println_bool (is_some (Some f)); 46 | println_bool (is_some None); 47 | 48 | (* check contents with operator <> (not equal) *) 49 | let rec is_some o = o <> None in 50 | println_bool (is_some (Some true)); 51 | println_bool (is_some None); 52 | 53 | (* tuple *) 54 | let t = (Some 4, None, Some (1, "one")) in 55 | let (a, b, c) = t in 56 | println_int (match a with Some i -> i | None -> -99); 57 | println_int (match b with Some i -> i | None -> -99); 58 | match c with 59 | | Some pair -> 60 | let (i, s) = pair in 61 | println_int i; 62 | println_str s 63 | | None -> 64 | println_str "ooooops!"; 65 | let o = None in 66 | match o with Some p -> let (_, _): int * int = p in () | None -> println_str "none of tuple!"; 67 | 68 | (* array *) 69 | let arr = Array.make 7 None in 70 | arr.(3) <- Some (Array.make 7 3.14); 71 | println_float (match arr.(1) with Some a -> a.(0) | None -> 0.1); 72 | println_float (match arr.(3) with Some a -> a.(0) | None -> 0.1); 73 | () 74 | 75 | -------------------------------------------------------------------------------- /codegen/testdata/option_values.out: -------------------------------------------------------------------------------- 1 | none 2 | 42 3 | 42 4 | none2 5 | none1 6 | 10 7 | 4.24 8 | 53 9 | -11 10 | true 11 | false 12 | true 13 | false 14 | 4 15 | -99 16 | 1 17 | one 18 | none of tuple! 19 | 0.1 20 | 3.14 21 | 22 | -------------------------------------------------------------------------------- /codegen/testdata/recursive_closure.ml: -------------------------------------------------------------------------------- 1 | let a = 42 in 2 | let rec f x = if x = 0 then 0 else a + (f (x - 1)) in 3 | print_int (f 3) 4 | -------------------------------------------------------------------------------- /codegen/testdata/recursive_closure.out: -------------------------------------------------------------------------------- 1 | 126 2 | -------------------------------------------------------------------------------- /codegen/testdata/recursive_func.ml: -------------------------------------------------------------------------------- 1 | let rec f x = if x = 0 then 0 else x + (f (x - 1)) in 2 | print_int (f 10) 3 | -------------------------------------------------------------------------------- /codegen/testdata/recursive_func.out: -------------------------------------------------------------------------------- 1 | 55 2 | -------------------------------------------------------------------------------- /codegen/testdata/shadow_names.ml: -------------------------------------------------------------------------------- 1 | let x = 3.14 in 2 | let x = false in 3 | println_bool x; 4 | 5 | let b = x in 6 | let rec x a = a = a in 7 | let x = x b in 8 | print_bool x 9 | -------------------------------------------------------------------------------- /codegen/testdata/shadow_names.out: -------------------------------------------------------------------------------- 1 | false 2 | true 3 | -------------------------------------------------------------------------------- /codegen/testdata/string.ml: -------------------------------------------------------------------------------- 1 | let a = "aaa" in 2 | let b = "bbb" in 3 | println_str a; 4 | println_str b; 5 | 6 | let c = str_concat a b in 7 | println_str c; 8 | 9 | let d = str_sub c 2 4 in 10 | println_str d; 11 | 12 | (* do not break previous strings *) 13 | println_str a; 14 | println_str b; 15 | println_str c; 16 | 17 | let e = "abcdef" in 18 | println_str (str_sub e 0 2); 19 | println_str (str_sub e 0 6); 20 | println_str (str_sub e 0 8); 21 | println_str (str_sub e 0 (-1)); 22 | println_str (str_sub e 0 0); 23 | println_str (str_sub e 9 3); 24 | println_str (str_sub e (-1) 4); 25 | println_str (str_sub e 9 99); 26 | println_str (str_sub e 5 6); 27 | println_str (str_sub e 5 5); 28 | println_str (str_sub e 0 1); 29 | 30 | let rec addfoo s = str_concat s "foo" in 31 | println_str (addfoo "piyo"); 32 | 33 | let rec add_a s = str_concat s a in 34 | println_str (add_a "poyo"); 35 | 36 | let rec str_sub2 s a b = str_sub s a b in 37 | println_str (str_sub2 e 2 4); 38 | 39 | println_bool (a = b); 40 | println_bool (a <> b); 41 | println_bool (a = a); 42 | println_bool (a <> a); 43 | (* different length string *) 44 | println_bool (a = e); 45 | println_bool (a <> e); 46 | 47 | (* compare string slice *) 48 | println_bool ((str_sub e 2 4) = "cd"); 49 | println_bool ("cd" = (str_sub e 2 4)); 50 | println_bool ((str_sub e 2 4) = (str_sub e 2 4)); 51 | 52 | println_str ""; 53 | println_str (str_concat "" ""); 54 | println_str "foo\tbar\tbaz"; 55 | println_str "これは日本語です"; 56 | println_str "つらい\t😭"; 57 | 58 | () 59 | -------------------------------------------------------------------------------- /codegen/testdata/string.out: -------------------------------------------------------------------------------- 1 | aaa 2 | bbb 3 | aaabbb 4 | ab 5 | aaa 6 | bbb 7 | aaabbb 8 | ab 9 | abcdef 10 | abcdef 11 | 12 | 13 | 14 | abcd 15 | 16 | f 17 | 18 | a 19 | piyofoo 20 | poyoaaa 21 | cd 22 | false 23 | true 24 | true 25 | false 26 | false 27 | true 28 | true 29 | true 30 | true 31 | 32 | 33 | foo bar baz 34 | これは日本語です 35 | つらい 😭 36 | 37 | -------------------------------------------------------------------------------- /codegen/testdata/test.txt: -------------------------------------------------------------------------------- 1 | this is test for read_file() 2 | -------------------------------------------------------------------------------- /codegen/testdata/tuple.ml: -------------------------------------------------------------------------------- 1 | let t = (1, true) in 2 | let (i, b) = t in 3 | println_int i; 4 | println_bool b; 5 | 6 | let (i, b, f) = (12, false, 3.14) in 7 | println_int i; 8 | println_bool b; 9 | println_float f; 10 | 11 | let t = (1, 2, (true, false)) in 12 | let (i, j, t) = t in 13 | let (_, b) = t in 14 | println_bool b; 15 | 16 | let rec first t = let (x, y) = t in x in 17 | let x = first (3.14, true) in 18 | println_float x; 19 | 20 | let rec triple x y z = (x, y, z) in 21 | let (b, i, f) = triple true 42 3.14 in 22 | println_int i; 23 | 24 | let t = (30, false) in 25 | let rec add10fst t = let (i, x) = t in (i+10, x) in 26 | let (i, _) = add10fst t in 27 | println_int i; 28 | 29 | let t = (10, 20) in 30 | let rec add x = let (i, j) = x in let (p, q) = t in (i+p, j+q) in 31 | let (i, j) = add (11, 22) in 32 | println_int i; 33 | println_int j; 34 | 35 | let t = (1, (3.1, true)) in 36 | let rec get _ = let (_, x) = t in x in 37 | let (f, b) = get () in 38 | println_float f; 39 | println_bool b; 40 | 41 | println_bool ((3.1, (1, true)) = (3.1, (1, true))); 42 | println_bool (t <> (3, (1.0, false))) 43 | -------------------------------------------------------------------------------- /codegen/testdata/tuple.out: -------------------------------------------------------------------------------- 1 | 1 2 | true 3 | 12 4 | false 5 | 3.14 6 | false 7 | 3.14 8 | 42 9 | 40 10 | 21 11 | 42 12 | 3.1 13 | true 14 | true 15 | true 16 | 17 | -------------------------------------------------------------------------------- /codegen/testdata/type_annotation.ml: -------------------------------------------------------------------------------- 1 | let i: int = (42: int) in 2 | print_int i 3 | -------------------------------------------------------------------------------- /codegen/testdata/type_annotation.out: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /codegen/testdata/type_annotation_fun.ml: -------------------------------------------------------------------------------- 1 | let rec f (x:int): float = int_to_float x in 2 | let g = fun (a:_ array) -> a.(0) in 3 | let x = Array.make 1 42 in 4 | print_int (g x) 5 | -------------------------------------------------------------------------------- /codegen/testdata/type_annotation_fun.out: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /codegen/testdata/type_decl.ml: -------------------------------------------------------------------------------- 1 | type point = int * int; 2 | let rec x (p:point): int = let (x, _) = p in x in 3 | let rec y (p:point): int = let (_, y) = p in y in 4 | let p: point = (10, 20) in 5 | println_int (x p); 6 | print_int (y p) 7 | -------------------------------------------------------------------------------- /codegen/testdata/type_decl.out: -------------------------------------------------------------------------------- 1 | 10 2 | 20 3 | -------------------------------------------------------------------------------- /codegen/testdata/unary_op.ml: -------------------------------------------------------------------------------- 1 | let a = not true in 2 | let b = -42 in 3 | let c = -.3.14 in 4 | println_bool a; 5 | println_int b; 6 | print_float c 7 | -------------------------------------------------------------------------------- /codegen/testdata/unary_op.out: -------------------------------------------------------------------------------- 1 | false 2 | -42 3 | -3.14 4 | -------------------------------------------------------------------------------- /codegen/testdata/underscore.ml: -------------------------------------------------------------------------------- 1 | let a = 10 in 2 | let b = 12 in 3 | let _ = a + b in 4 | let rec _ _ = a in 5 | let rec f _ = b in 6 | println_int (f ()); 7 | let t = 1, "aaa", true in 8 | let (_, s, _) = t in 9 | println_str s; 10 | let rec f _ = 42 in 11 | println_int (f true); 12 | let f = fun _ -> true in 13 | print_bool (f 3.14) 14 | 15 | -------------------------------------------------------------------------------- /codegen/testdata/underscore.out: -------------------------------------------------------------------------------- 1 | 12 2 | aaa 3 | 42 4 | true 5 | -------------------------------------------------------------------------------- /codegen/testdata/zero_length_array.ml: -------------------------------------------------------------------------------- 1 | let a = Array.make 0 42 in 2 | let rec nest x = Array.make 0 x in 3 | let rec nest_a _ = Array.make 0 a in 4 | let b = nest a in 5 | let c = nest_a () in 6 | let d = Array.make 0 nest in 7 | print_int (Array.length d) 8 | 9 | 10 | -------------------------------------------------------------------------------- /codegen/testdata/zero_length_array.out: -------------------------------------------------------------------------------- 1 | 0 2 | -------------------------------------------------------------------------------- /common/ordinal.go: -------------------------------------------------------------------------------- 1 | package common 2 | 3 | import ( 4 | "fmt" 5 | ) 6 | 7 | func Ordinal(i int) string { 8 | suffix := "th" 9 | switch i % 10 { 10 | case 1: 11 | if i%100 != 11 { 12 | suffix = "st" 13 | } 14 | case 2: 15 | if i%100 != 12 { 16 | suffix = "nd" 17 | } 18 | case 3: 19 | if i%100 != 13 { 20 | suffix = "rd" 21 | } 22 | } 23 | return fmt.Sprintf("%d%s", i, suffix) 24 | } 25 | -------------------------------------------------------------------------------- /common/ordinal_test.go: -------------------------------------------------------------------------------- 1 | package common 2 | 3 | import ( 4 | "fmt" 5 | "testing" 6 | ) 7 | 8 | func TestOrdinal(t *testing.T) { 9 | for _, tc := range []struct { 10 | input int 11 | suffix string 12 | }{ 13 | {1, "st"}, 14 | {2, "nd"}, 15 | {3, "rd"}, 16 | {4, "th"}, 17 | {11, "th"}, 18 | {13, "th"}, 19 | {20, "th"}, 20 | {21, "st"}, 21 | {33, "rd"}, 22 | {100, "th"}, 23 | {101, "st"}, 24 | {102, "nd"}, 25 | {111, "th"}, 26 | {112, "th"}, 27 | {141, "st"}, 28 | } { 29 | want := fmt.Sprintf("%d%s", tc.input, tc.suffix) 30 | had := Ordinal(tc.input) 31 | if want != had { 32 | t.Errorf("Ordinal(%d) == %s (want %s)", tc.input, had, want) 33 | } 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /driver/driver.go: -------------------------------------------------------------------------------- 1 | // Package driver is amediator to glue all packages for GoCaqml. provides a compiler function for GoCaml codes. 2 | // It provides compiler functinalities for GoCaml. 3 | package driver 4 | 5 | import ( 6 | "fmt" 7 | "github.com/rhysd/gocaml/ast" 8 | "github.com/rhysd/gocaml/closure" 9 | "github.com/rhysd/gocaml/codegen" 10 | "github.com/rhysd/gocaml/mir" 11 | "github.com/rhysd/gocaml/mono" 12 | "github.com/rhysd/gocaml/sema" 13 | "github.com/rhysd/gocaml/syntax" 14 | "github.com/rhysd/gocaml/token" 15 | "github.com/rhysd/gocaml/types" 16 | "github.com/rhysd/locerr" 17 | "io/ioutil" 18 | "os" 19 | "path/filepath" 20 | ) 21 | 22 | type OptLevel int 23 | 24 | const ( 25 | O0 OptLevel = iota 26 | O1 27 | O2 28 | O3 29 | ) 30 | 31 | // Driver instance to compile GoCaml code into other representations. 32 | type Driver struct { 33 | Optimization OptLevel 34 | LinkFlags string 35 | TargetTriple string 36 | DebugInfo bool 37 | } 38 | 39 | // PrintTokens returns the lexed tokens for a source code. 40 | func (d *Driver) Lex(src *locerr.Source) chan token.Token { 41 | l := syntax.NewLexer(src) 42 | l.Error = func(msg string, pos locerr.Pos) { 43 | err := locerr.ErrorAt(pos, msg) 44 | err.PrintToFile(os.Stderr) 45 | fmt.Fprintln(os.Stderr) 46 | } 47 | go l.Lex() 48 | return l.Tokens 49 | } 50 | 51 | // PrintTokens show list of tokens lexed. 52 | func (d *Driver) PrintTokens(src *locerr.Source) { 53 | tokens := d.Lex(src) 54 | for { 55 | select { 56 | case t := <-tokens: 57 | fmt.Println(t.String()) 58 | switch t.Kind { 59 | case token.EOF, token.ILLEGAL: 60 | return 61 | } 62 | } 63 | } 64 | } 65 | 66 | // Parse parses the source and returns the parsed AST. 67 | func (d *Driver) Parse(src *locerr.Source) (*ast.AST, error) { 68 | return syntax.Parse(src) 69 | } 70 | 71 | // PrintAST outputs AST structure to stdout. 72 | func (d *Driver) PrintAST(src *locerr.Source) { 73 | a, err := d.Parse(src) 74 | if err != nil { 75 | fmt.Fprintln(os.Stderr, err.Error()) 76 | return 77 | } 78 | ast.Println(a) 79 | } 80 | 81 | // SemanticAnalysis checks symbol duplicates, infers types and so on. It returns analyzed type 82 | // environment and inferred types of AST node. 83 | func (d *Driver) SemanticAnalysis(src *locerr.Source) (*types.Env, sema.InferredTypes, error) { 84 | a, err := syntax.Parse(src) 85 | if err != nil { 86 | return nil, nil, err 87 | } 88 | 89 | return sema.Analyze(a) 90 | } 91 | 92 | func (d *Driver) DumpEnvToStdout(src *locerr.Source) error { 93 | env, inferred, err := d.SemanticAnalysis(src) 94 | if err != nil { 95 | return err 96 | } 97 | env.Dump() 98 | fmt.Println("\nType Information:\n") 99 | for expr, ty := range inferred { 100 | fmt.Printf(" %s: %s (%s-%s)\n", expr.Name(), ty.String(), expr.Pos().String(), expr.End().String()) 101 | } 102 | return nil 103 | } 104 | 105 | // EmitMIR emits MIR tree representation. 106 | func (d *Driver) EmitMIR(src *locerr.Source) (*mir.Program, *types.Env, error) { 107 | parsed, err := d.Parse(src) 108 | if err != nil { 109 | return nil, nil, err 110 | } 111 | env, ir, err := sema.SemanticsCheck(parsed) 112 | if err != nil { 113 | return nil, nil, err 114 | } 115 | prog := closure.Transform(ir) 116 | prog = mono.Monomorphize(prog, env) 117 | return prog, env, nil 118 | } 119 | 120 | func (d *Driver) emitterFromSource(src *locerr.Source) (*codegen.Emitter, error) { 121 | prog, env, err := d.EmitMIR(src) 122 | if err != nil { 123 | return nil, err 124 | } 125 | 126 | level := codegen.OptimizeDefault 127 | switch d.Optimization { 128 | case O0: 129 | level = codegen.OptimizeNone 130 | case O1: 131 | level = codegen.OptimizeLess 132 | case O3: 133 | level = codegen.OptimizeAggressive 134 | } 135 | opts := codegen.EmitOptions{level, d.TargetTriple, d.LinkFlags, d.DebugInfo} 136 | 137 | return codegen.NewEmitter(prog, env, src, opts) 138 | } 139 | 140 | func (d *Driver) EmitObjFile(src *locerr.Source) error { 141 | emitter, err := d.emitterFromSource(src) 142 | if err != nil { 143 | return err 144 | } 145 | defer emitter.Dispose() 146 | emitter.RunOptimizationPasses() 147 | obj, err := emitter.EmitObject() 148 | if err != nil { 149 | return err 150 | } 151 | filename := fmt.Sprintf("%s.o", src.BaseName()) 152 | return ioutil.WriteFile(filename, obj, 0666) 153 | } 154 | 155 | func (d *Driver) EmitLLVMIR(src *locerr.Source) (string, error) { 156 | emitter, err := d.emitterFromSource(src) 157 | if err != nil { 158 | return "", err 159 | } 160 | defer emitter.Dispose() 161 | emitter.RunOptimizationPasses() 162 | 163 | return emitter.EmitLLVMIR(), nil 164 | } 165 | 166 | func (d *Driver) EmitAsm(src *locerr.Source) (string, error) { 167 | emitter, err := d.emitterFromSource(src) 168 | if err != nil { 169 | return "", err 170 | } 171 | defer emitter.Dispose() 172 | emitter.RunOptimizationPasses() 173 | 174 | return emitter.EmitAsm() 175 | } 176 | 177 | func (d *Driver) Compile(source *locerr.Source) error { 178 | emitter, err := d.emitterFromSource(source) 179 | if err != nil { 180 | return err 181 | } 182 | defer emitter.Dispose() 183 | emitter.RunOptimizationPasses() 184 | var executable string 185 | if source.Exists { 186 | executable = source.BaseName() 187 | } else { 188 | executable, err = filepath.Abs("a.out") 189 | if err != nil { 190 | return err 191 | } 192 | } 193 | return emitter.EmitExecutable(executable) 194 | } 195 | -------------------------------------------------------------------------------- /driver/example_test.go: -------------------------------------------------------------------------------- 1 | package driver 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/locerr" 6 | "path/filepath" 7 | ) 8 | 9 | func Example() { 10 | // Compile testdata/from-mincaml/ack.ml 11 | file := filepath.FromSlash("../testdata/from-mincaml/ack.ml") 12 | src, err := locerr.NewSourceFromFile(file) 13 | if err != nil { 14 | // File not found 15 | panic(err) 16 | } 17 | 18 | d := Driver{} 19 | 20 | // Show list of tokens 21 | d.PrintTokens(src) 22 | 23 | // Show AST nodes 24 | d.PrintAST(src) 25 | 26 | // Parse file into AST 27 | parsed, err := d.Parse(src) 28 | if err != nil { 29 | panic(err) 30 | } 31 | fmt.Println(parsed) 32 | 33 | // Resolving symbols and type analysis 34 | env, inferred, err := d.SemanticAnalysis(src) 35 | if err != nil { 36 | panic(err) 37 | } 38 | 39 | // Show environment of type analysis 40 | env.Dump() 41 | 42 | // Show inferred types of all AST nodes 43 | for e, t := range inferred { 44 | fmt.Printf("Node '%s' at '%s' => Type '%s'", e.Name(), e.Pos(), t.String()) 45 | } 46 | 47 | // Show LLVM IR for the source 48 | ir, err := d.EmitLLVMIR(src) 49 | if err != nil { 50 | panic(err) 51 | } 52 | fmt.Println(ir) 53 | 54 | // Show native assembly code for the source 55 | asm, err := d.EmitAsm(src) 56 | if err != nil { 57 | panic(err) 58 | } 59 | fmt.Println(asm) 60 | 61 | // Compile the source into an executable 62 | if err := d.Compile(src); err != nil { 63 | panic(err) 64 | } 65 | } 66 | -------------------------------------------------------------------------------- /examples/brainfxxk.ml: -------------------------------------------------------------------------------- 1 | let rec char_at s idx = str_sub s idx (idx + 1) in 2 | 3 | let rec program tape = 4 | let mem = Array.make 30000 0 in 5 | let tape_size = str_length tape in 6 | let rec jump_fwd pc stack = 7 | let op = char_at tape pc in 8 | if op = "[" then jump_fwd (pc + 1) (stack + 1) else 9 | if op = "]" then 10 | if stack = 0 then pc else jump_fwd (pc + 1) (stack - 1) 11 | else 12 | jump_fwd (pc + 1) stack 13 | in 14 | let rec jump_bkwd pc stack = 15 | let op = char_at tape pc in 16 | if op = "[" then 17 | if stack = 0 then pc else jump_bkwd (pc - 1) (stack - 1) 18 | else 19 | if op = "]" then jump_bkwd (pc - 1) (stack + 1) else 20 | jump_bkwd (pc - 1) stack 21 | in 22 | let rec step pc ptr = 23 | if pc >= tape_size then () else 24 | let op = char_at tape pc in 25 | if op = ">" then step (pc + 1) (ptr + 1) else 26 | if op = "<" then step (pc + 1) (ptr - 1) else 27 | let pc = 28 | if op = "+" then 29 | mem.(ptr) <- (mem.(ptr) + 1); 30 | pc 31 | else 32 | if op = "-" then 33 | mem.(ptr) <- (mem.(ptr) - 1); 34 | pc 35 | else 36 | if op = "." then 37 | print_str (from_char_code mem.(ptr)); 38 | pc 39 | else 40 | if op = "," then 41 | mem.(ptr) <- (to_char_code (get_char ())); 42 | pc 43 | else 44 | if op = "[" then 45 | if mem.(ptr) = 0 then 46 | jump_fwd (pc + 1) 0 47 | else 48 | pc 49 | else 50 | if op = "]" then 51 | if mem.(ptr) <> 0 then 52 | jump_bkwd (pc - 1) 0 53 | else 54 | pc 55 | else 56 | pc 57 | in 58 | step (pc + 1) ptr 59 | in 60 | step 0 0 61 | in 62 | program "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+." 63 | -------------------------------------------------------------------------------- /examples/bubble_sort.ml: -------------------------------------------------------------------------------- 1 | let rec show_array a = 2 | let size = Array.length a in 3 | let rec show_elems idx = 4 | if idx >= size then () else 5 | (print_int a.(idx); print_str " "; show_elems (idx + 1)) 6 | in 7 | print_str "[ "; 8 | show_elems 0; 9 | println_str "]" 10 | in 11 | let rec bubble_sort xs = 12 | let len = Array.length xs in 13 | let rec swap idx max = 14 | if max - 1 <= idx then () else 15 | let l = xs.(idx) in 16 | let r = xs.(idx+1) in 17 | if l <= r then swap (idx+1) max else 18 | (xs.(idx) <- r; 19 | xs.(idx+1) <- l; 20 | swap (idx+1) max) 21 | in 22 | let rec go idx = 23 | if idx >= (len - 1) then () else 24 | (swap 0 (len - idx); go (idx + 1)) 25 | in 26 | go 0; 27 | xs 28 | in 29 | let a = [| 4; 8; 1; 8; 3; 0; 5; 6; 3; 0 |] in 30 | show_array (bubble_sort a) 31 | -------------------------------------------------------------------------------- /examples/compose.ml: -------------------------------------------------------------------------------- 1 | let rec twice x = x *. 2.0 in 2 | let rec squre x = x *. x in 3 | let rec compose f g = 4 | let rec h x = (f (g x)) in 5 | h 6 | in 7 | let f = compose (compose squre twice) twice in 8 | println_float (f 10.0) 9 | (* Output: 1600 *) 10 | -------------------------------------------------------------------------------- /examples/factorial.ml: -------------------------------------------------------------------------------- 1 | let rec fact n = 2 | if n <= 0 then 1 else 3 | n * (fact (n - 1)) 4 | in 5 | println_int (fact 10) 6 | -------------------------------------------------------------------------------- /examples/fib.ml: -------------------------------------------------------------------------------- 1 | let rec fib n = 2 | if n <= 1 then 1 else 3 | (fib (n - 1)) + (fib (n - 2)) 4 | in 5 | println_int (fib 10) 6 | -------------------------------------------------------------------------------- /examples/fizzbuzz.ml: -------------------------------------------------------------------------------- 1 | let rec fizzbuzz max = 2 | let rec fb n = 3 | if n % 15 = 0 then println_str "fizzbuzz" else 4 | if n % 3 = 0 then println_str "fizz" else 5 | if n % 5 = 0 then println_str "buzz" else 6 | println_int n 7 | in 8 | let rec go n = 9 | if n = max then () else 10 | (fb n; go (n+1)) 11 | in 12 | go 1 13 | in 14 | let max = 100 in 15 | fizzbuzz max 16 | -------------------------------------------------------------------------------- /examples/guessing_game.ml: -------------------------------------------------------------------------------- 1 | let rec rand x = 2 | let high = x / 127773 in 3 | let low = x % 127773 in 4 | let t = 16807 * low - 2836 * high in 5 | if t <= 0 then t + 9223372036854775807 else t 6 | in 7 | let n = rand (time_now ()) % 100 + 1 in 8 | let rec play count = 9 | print_str "Guess a number (1~100): "; 10 | let input = str_to_int (get_line ()) in 11 | if input > 100 || 0 >= input then 12 | println_str "Please enter 1~100"; 13 | play count 14 | else 15 | let msg = 16 | if input > n then "Too large!" else 17 | if input < n then "Too small!" else 18 | "gotcha!" 19 | in 20 | println_str msg; 21 | if input = n then count else play (count+1) 22 | in 23 | let tried = play 1 in 24 | print_str "You hit a correct answer in "; print_int tried; println_str " times" 25 | -------------------------------------------------------------------------------- /examples/helloworld.ml: -------------------------------------------------------------------------------- 1 | println_str "Hello, world!" 2 | -------------------------------------------------------------------------------- /examples/mandelbrot.ml: -------------------------------------------------------------------------------- 1 | let rec density_str d = 2 | if d > 8.0 then " " else 3 | if d > 4.0 then "." else 4 | if d > 2.0 then "*" else 5 | "+" 6 | in 7 | let rec converge r i = 8 | let rec go real imag iter creal cimag = 9 | if iter > 255.0 || (real *. real +. imag *. imag) >= 4.0 then 10 | iter 11 | else 12 | go (real *. real -. imag *. imag +. creal) (2.0 *. real *. imag +. cimag) (iter +. 1.0) creal cimag 13 | in 14 | go r i 0.0 r i 15 | in 16 | let rec mandel realstart imagstart realmag imagmag = 17 | let rec plot x xmax xstep y ymax ystep = 18 | let rec plot_line x y = 19 | if x >= xmax then () else 20 | let dens = converge x y in 21 | print_str (density_str dens); 22 | plot_line (x +. xstep) y 23 | in 24 | if y >= ymax then () else 25 | (plot_line x y; 26 | println_str ""; 27 | plot x xmax xstep (y +. ystep) ymax ystep) 28 | in 29 | plot realstart (realstart +. realmag *. 78.0) realmag imagstart (imagstart +. imagmag *. 40.0) imagmag 30 | in 31 | mandel (-.2.3) (-.1.3) 0.05 0.07 32 | 33 | (* Output: 34 | 35 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 36 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 37 | ++++++++++++++++++++++++++++++++++++++++******++++++++++++++++++++++++++++++++ 38 | ++++++++++++++++++++++++++++++++++++*****...******++++++++++++++++++++++++++++ 39 | +++++++++++++++++++++++++++++++++********.. ...*****++++++++++++++++++++++++++ 40 | +++++++++++++++++++++++++++++++**********.. ..*****+++++++++++++++++++++++++ 41 | ++++++++++++++++++++++++++++++**********. ..******++++++++++++++++++++++++ 42 | ++++++++++++++++++++++++++++*********.... ..******+++++++++++++++++++++++ 43 | ++++++++++++++++++++++++++********....... .....****++++++++++++++++++++++ 44 | +++++++++++++++++++++++++********. . ... .**+++++++++++++++++++++ 45 | +++++++++++++++++++++++********... **+++++++++++++++++++++ 46 | +++++++++++++++++++++*********.... .***++++++++++++++++++++ 47 | ++++++++++++++++++***..*****.... ..***+++++++++++++++++++ 48 | ++++++++++++++******. .......... ***+++++++++++++++++++ 49 | +++++++++++********.. .. .**+++++++++++++++++++ 50 | +++++++++**********... .****++++++++++++++++++ 51 | ++++++++**********.. .****++++++++++++++++++ 52 | +++++++******..... ..****++++++++++++++++++ 53 | +++++++*........ ...****++++++++++++++++++ 54 | +++++++*... .... ...****++++++++++++++++++ 55 | +++++++*****...... ..****++++++++++++++++++ 56 | +++++++**********... .****++++++++++++++++++ 57 | +++++++++**********... ****++++++++++++++++++ 58 | ++++++++++*********.. .. ..**+++++++++++++++++++ 59 | +++++++++++++******.. .......... ***+++++++++++++++++++ 60 | ++++++++++++++++++***...***..... ..***+++++++++++++++++++ 61 | +++++++++++++++++++++*********.... ..**++++++++++++++++++++ 62 | +++++++++++++++++++++++********... ***++++++++++++++++++++ 63 | +++++++++++++++++++++++++*******.. . ... .**+++++++++++++++++++++ 64 | ++++++++++++++++++++++++++********....... ......***++++++++++++++++++++++ 65 | ++++++++++++++++++++++++++++*********.... ..******+++++++++++++++++++++++ 66 | +++++++++++++++++++++++++++++**********.. ..******++++++++++++++++++++++++ 67 | +++++++++++++++++++++++++++++++**********.. ...*****+++++++++++++++++++++++++ 68 | +++++++++++++++++++++++++++++++++********.. ...*****++++++++++++++++++++++++++ 69 | +++++++++++++++++++++++++++++++++++******....*****++++++++++++++++++++++++++++ 70 | +++++++++++++++++++++++++++++++++++++++********+++++++++++++++++++++++++++++++ 71 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 72 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 73 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 74 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 75 | 76 | *) 77 | -------------------------------------------------------------------------------- /examples/matmul.ml: -------------------------------------------------------------------------------- 1 | let rec each arr pred = 2 | let n = Array.length arr in 3 | let rec f i = 4 | if i = n then () else 5 | (pred arr.(i) i; f (i + 1)) 6 | in 7 | f 0 8 | in 9 | 10 | let rec make_mat n m v = 11 | let ret = Array.make n (Array.make 0 v) in 12 | each ret (fun _ i -> ret.(i) <- Array.make m v); 13 | ret 14 | in 15 | 16 | let rec each2 arr pred = 17 | let m = Array.length arr in 18 | let n = Array.length arr.(0) in 19 | let rec f i = 20 | if i = m then () else 21 | let rec g j = 22 | if j = n then () else 23 | (pred arr.(i).(j) i j; g (j + 1)) 24 | in 25 | (g 0; 26 | f (i + 1)) 27 | in 28 | f 0 29 | in 30 | 31 | let rec transpose arr = 32 | let row = Array.length arr in 33 | let col = Array.length arr.(0) in 34 | let ret = make_mat col row 0.0 in 35 | each2 arr (fun e i j -> ret.(j).(i) <- arr.(i).(j)); 36 | ret 37 | in 38 | 39 | let rec multiplication a b = 40 | let n = Array.length a.(0) in 41 | let ret = make_mat (Array.length a) (Array.length b) 0.0 in 42 | each a (fun ai i -> 43 | each b (fun bj j -> 44 | let rec h k = 45 | if k < 0 then 0.0 else 46 | (h (k - 1)) +. ai.(k) *. bj.(k) 47 | in 48 | ret.(i).(j) <- h n 49 | ) 50 | ); 51 | ret 52 | in 53 | 54 | let rec matmul a b = 55 | let b = transpose b in 56 | multiplication a b 57 | in 58 | 59 | let rec matgen n = 60 | let f = int_to_float n in 61 | let tmp = 1.0 /. f /. f in 62 | let a = make_mat n n 0.0 in 63 | each2 a (fun _ i j -> 64 | let x = int_to_float (i - j) in 65 | let y = int_to_float (i + j) in 66 | a.(i).(j) <- tmp *. x *. y 67 | ); 68 | a 69 | in 70 | 71 | let n = 500 in 72 | let a = matgen n in 73 | let b = matgen n in 74 | let c = matmul a b in 75 | println_float c.(n / 2).(n / 2) 76 | -------------------------------------------------------------------------------- /examples/mt19937ar.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * 64bit Mersenne Twister random number generator. 3 | * http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/VERSIONS/C-LANG/mt19937-64.c 4 | *) 5 | let rec make_rng seeds = 6 | let NN = 312 in 7 | let MM = 156 in 8 | let MATRIX_A = -5403634167711393303 (* 0xB5026F5AA96619E9 *) in 9 | let UM = -2147483648 (* 0xFFFFFFFF80000000 *) in 10 | let LM = 2147483647 (* 0x7FFFFFFF *) in 11 | let mt = Array.make NN 0 in 12 | let rec init_genrand64 seed = 13 | mt.(0) <- seed; 14 | let rec f n = 15 | if n = NN then () else 16 | (mt.(n) <- 6364136223846793005 * (bit_xor mt.(n-1) (bit_rsft mt.(n-1) 62)) + n; f (n+1)) 17 | in 18 | f 1 19 | in 20 | let rec init_by_array64 init_key = 21 | let key_length = Array.length init_key in 22 | init_genrand64 19650218; 23 | let rec f i j k = 24 | if k = 0 then i else ( 25 | mt.(i) <- (bit_xor mt.(i) ((bit_xor mt.(i-1) (bit_rsft mt.(i-1) 62)) * 3935559000370003845)) + init_key.(j) + j; 26 | let i = i + 1 in 27 | let j = j + 1 in 28 | if i >= NN then 29 | mt.(0) <- mt.(NN-1); 30 | f 1 j (k-1) 31 | else if j >= key_length then 32 | f i 0 (k-1) 33 | else 34 | f i j (k-1) 35 | ) 36 | in 37 | let i = f 1 0 (if NN > key_length then NN else key_length) in 38 | let rec f i k = 39 | if k = 0 then () else ( 40 | mt.(i) <- (bit_xor mt.(i) ((bit_xor mt.(i-1) (bit_rsft mt.(i-1) 62)) * 2862933555777941757)) - i; 41 | if i+1 >= NN then 42 | mt.(0) <- mt.(NN-1); 43 | f 1 (k-1) 44 | else 45 | f (i+1) (k-1) 46 | ) 47 | in 48 | f i (NN-1); 49 | mt.(0) <- bit_lsft 1 63 (*MSB is 1; assuring non-zero initial array*) 50 | in 51 | let mag01 = [| 0; MATRIX_A |] in 52 | let mti = [| NN+1 |] in 53 | let rec genrand64 _ = 54 | if mti.(0) >= NN then 55 | let rec f i = 56 | if i = (NN - MM) then () else 57 | let x = bit_or (bit_and mt.(i) UM) (bit_and mt.(i+1) LM) in 58 | mt.(i) <- bit_xor (bit_xor mt.(i + MM) (bit_rsft x 1)) mag01.(bit_and x 1); 59 | f (i+1) 60 | in 61 | f 0; 62 | let rec f i = 63 | if i = (NN-1) then () else 64 | let x = bit_or (bit_and mt.(i) UM) (bit_and mt.(i+1) LM) in 65 | mt.(i) <- bit_xor (bit_xor mt.(i + (MM - NN)) (bit_rsft x 1)) mag01.(bit_and x 1); 66 | f (i + 1) 67 | in 68 | f (NN-MM); 69 | let x = bit_or (bit_and mt.(NN-1) UM) (bit_and mt.(0) LM) in 70 | mt.(NN-1) <- bit_xor (bit_xor mt.(MM-1) (bit_rsft x 1)) mag01.(bit_and x 1); 71 | mti.(0) <- 0 72 | else (); 73 | let x = mt.(mti.(0)) in 74 | let x = bit_xor x (bit_and (bit_rsft x 29) 6148914691236517205 (* 0x5555555555555555 *)) in 75 | let x = bit_xor x (bit_and (bit_lsft x 17) 8202884508482404352 (* 0x71D67FFFEDA60000 *)) in 76 | let x = bit_xor x (bit_and (bit_lsft x 37) (-2270628950310912) (* 0xFFF7EEE000000000 *)) in 77 | let x = bit_xor x (bit_rsft x 43) in 78 | mti.(0) <- mti.(0) + 1; 79 | x 80 | in 81 | init_by_array64 seeds; 82 | genrand64 83 | in 84 | 85 | let seeds = [| 123; 234; 345; 456 |] in 86 | let gen = make_rng seeds in 87 | 88 | println_int (gen ()); 89 | println_int (gen ()); 90 | println_int (gen ()); 91 | println_int (gen ()); 92 | println_int (gen ()); 93 | println_int (gen ()) 94 | -------------------------------------------------------------------------------- /examples/n-queens.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Solve N-Queens puzzle with back-tracking 3 | * https://en.wikipedia.org/wiki/Eight_queens_puzzle 4 | *) 5 | let rec make_board size = 6 | let ret = Array.make size (Array.make 0 0) in 7 | let rec set idx = 8 | if idx < 0 then () else 9 | (ret.(idx) <- Array.make size 0; 10 | set (idx - 1)) 11 | in 12 | set (size - 1); 13 | ret 14 | in 15 | let rec n_queens n = 16 | let SOLVED = true in 17 | let FAILED = false in 18 | let QUEEN = -1 in 19 | let board = make_board n in 20 | let rec in_board x y = x >= 0 && y >= 0 && n > x && n > y in 21 | let rec update x y delta = 22 | let rec f x y dx dy = 23 | let x = x + dx in 24 | let y = y + dy in 25 | if not (in_board x y) then () else 26 | (board.(x).(y) <- board.(x).(y) + delta; f x y dx dy) 27 | in 28 | f x y 1 0; 29 | f x y 1 1; 30 | f x y 0 1; 31 | f x y (-1) 1; 32 | f x y (-1) 0; 33 | f x y (-1) (-1); 34 | f x y 0 (-1); 35 | f x y 1 (-1); 36 | board.(x).(y) <- board.(x).(y) + delta 37 | in 38 | let rec put_queen x y = update x y 1 in 39 | let rec remove_queen x y = update x y (-1) in 40 | let rec solve nth x y = 41 | if not in_board x y then FAILED else 42 | let rec go_next _ = 43 | if x < n then 44 | solve nth (x+1) y 45 | else 46 | solve nth 0 (y+1) 47 | in 48 | if board.(x).(y) > 0 then 49 | go_next () 50 | else ( 51 | put_queen x y; 52 | let nth = nth + 1 in 53 | if nth >= n || solve nth 0 (y+1) then 54 | board.(x).(y) <- QUEEN; 55 | SOLVED 56 | else 57 | (remove_queen x y; go_next ()) 58 | ) 59 | in 60 | if solve 0 0 0 then 61 | (* When answer was found, show fancy output. *) 62 | let rec show _ = 63 | let rec show_cell v = print_str (if v = QUEEN then "x" else "."); print_str " " in 64 | let rec show_y y = 65 | if y >= n then () else 66 | let rec show_x x = 67 | if x >= n then () else (show_cell board.(x).(y); show_x (x+1)) 68 | in 69 | (show_x 0; print_str "\n"; show_y (y+1)) 70 | in 71 | show_y 0 72 | in 73 | show () 74 | else 75 | println_str "No answer" 76 | in 77 | let rec usage _ = print_str "Usage: "; print_str argv.(0); println_str " NUMBER" in 78 | if Array.length argv = 1 then usage () else 79 | let n = str_to_int (argv.(1)) in 80 | if n = 0 then usage () else 81 | n_queens n 82 | 83 | (* Output of `./n-queens 8`: 84 | 85 | x . . . . . . . 86 | . . . . x . . . 87 | . . . . . . . x 88 | . . . . . x . . 89 | . . x . . . . . 90 | . . . . . . x . 91 | . x . . . . . . 92 | . . . x . . . . 93 | 94 | *) 95 | -------------------------------------------------------------------------------- /examples/quick_sort.ml: -------------------------------------------------------------------------------- 1 | let rec show_array a = 2 | let size = Array.length a in 3 | let rec show_elems idx = 4 | if idx >= size then () else 5 | (print_int a.(idx); print_str " "; show_elems (idx + 1)) 6 | in 7 | print_str "[ "; 8 | show_elems 0; 9 | println_str "]" 10 | in 11 | let rec quick_sort xs less = 12 | let rec swap i j = 13 | let tmp = xs.(i) in 14 | xs.(i) <- xs.(j); 15 | xs.(j) <- tmp 16 | in 17 | let rec go left right = 18 | if left >= right then () else 19 | let pivot = xs.((left + right) / 2) in 20 | let rec partition l r = 21 | let rec next_left i = 22 | (* pivot <= xs.(i) *) 23 | if not (less xs.(i) pivot) then i else 24 | next_left (i+1) 25 | in 26 | let rec next_right i = 27 | (* pivot >= xs.(i) *) 28 | if not (less pivot xs.(i)) then i else 29 | next_right (i-1) 30 | in 31 | let l = next_left l in 32 | let r = next_right r in 33 | if l >= r then (l, r) else 34 | (swap l r; partition (l+1) (r-1)) 35 | in 36 | let (l, r) = partition left right in 37 | go left (l-1); 38 | go (r+1) right 39 | in 40 | go 0 (Array.length xs - 1); 41 | xs 42 | in 43 | let a = [| 4; 8; 1; 8; 3; 0; 5; 6; 3; 0 |] in 44 | let sorted = quick_sort a (fun x y -> x < y) in 45 | show_array sorted 46 | -------------------------------------------------------------------------------- /examples/rust-example.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Rust example written in gocaml 3 | * http://www.rust-lang.org/ 4 | *) 5 | 6 | let prog = "+ + * - /" in 7 | let finish = str_length prog in 8 | let rec char_at s idx = str_sub s idx (idx + 1) in 9 | 10 | let rec calc acc pc = 11 | if pc = finish then acc else 12 | let ch = char_at prog pc in 13 | if ch = "+" then calc (acc+1) (pc+1) else 14 | if ch = "-" then calc (acc-1) (pc+1) else 15 | if ch = "*" then calc (acc*2) (pc+1) else 16 | if ch = "/" then calc (acc/2) (pc+1) else 17 | calc acc (pc+1) 18 | in 19 | print_str "The problem \""; 20 | print_str prog; 21 | print_str "\" calculates the value "; 22 | println_int (calc 0 0) 23 | -------------------------------------------------------------------------------- /examples/sqrt.ml: -------------------------------------------------------------------------------- 1 | let rec sqrt x = 2 | let rec abs x = if x > 0.0 then x else -.x in 3 | let rec go z p = 4 | if abs (p -. z) <= 0.00001 then z else 5 | let (p, z) = z, z -. (z *. z -. x) /. (2.0 *. z) in 6 | go z p 7 | in 8 | go x 0.0 9 | in 10 | println_float (sqrt 10.0) 11 | -------------------------------------------------------------------------------- /examples/tak.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Tak function to measure the performance 3 | * https://en.wikipedia.org/wiki/Tak_(function) 4 | * 5 | * This is a very lower level benchmark only using recursion. 6 | * 7 | * Note: 8 | * After passing LLVM optimization passes, the outer tak() function call is transformed to a loop. 9 | *) 10 | 11 | let rec tak x y z = 12 | if x <= y then y else 13 | tak (tak (x-1) y z) (tak(y-1) z x) (tak(z-1) x y) 14 | in 15 | println_int (tak 12 6 0) 16 | 17 | -------------------------------------------------------------------------------- /examples/xorshift128plus.ml: -------------------------------------------------------------------------------- 1 | let rec xorshift128plus seed = 2 | let state = Array.make 2 0 in 3 | state.(0) <- bit_xor seed (-6314187572093295703) (* 0xAF4100491F9D38AF *); 4 | state.(1) <- bit_xor seed (-7552163386978529546) (* 0xD19D592CBD21E214 *); 5 | let rec gen _ = 6 | let x = state.(0) in 7 | let y = state.(1) in 8 | state.(0) <- y; 9 | let x = bit_lsft x 23 in 10 | state.(1) <- bit_xor x (bit_xor y (bit_xor (bit_rsft x 17) (bit_rsft y 26))); 11 | state.(1) + y 12 | in 13 | gen 14 | in 15 | let rand = xorshift128plus (time_now ()) in 16 | println_int (rand ()); 17 | println_int (rand ()); 18 | println_int (rand ()); 19 | println_int (rand ()); 20 | println_int (rand ()); 21 | println_int (rand ()); 22 | println_int (rand ()); 23 | println_int (rand ()); 24 | () 25 | 26 | -------------------------------------------------------------------------------- /main.go: -------------------------------------------------------------------------------- 1 | package main 2 | 3 | import ( 4 | "flag" 5 | "fmt" 6 | "github.com/rhysd/gocaml/codegen" 7 | "github.com/rhysd/gocaml/driver" 8 | "github.com/rhysd/locerr" 9 | "os" 10 | "strings" 11 | ) 12 | 13 | var ( 14 | help = flag.Bool("help", false, "Show this help") 15 | showTokens = flag.Bool("tokens", false, "Show tokens for input") 16 | showAST = flag.Bool("ast", false, "Show AST for input") 17 | analyze = flag.Bool("analyze", false, "Dump analyzed symbols and types information to stdout") 18 | showMIR = flag.Bool("mir", false, "Emit GoCaml Intermediate Language representation to stdout") 19 | check = flag.Bool("check", false, "Check code (syntax, types, ...) and report errors if exist") 20 | llvm = flag.Bool("llvm", false, "Emit LLVM IR to stdout") 21 | asm = flag.Bool("asm", false, "Emit assembler code to stdout") 22 | opt = flag.Int("opt", -1, "Optimization level (0~3). 0: none, 1: less, 2: default, 3: aggressive") 23 | obj = flag.Bool("obj", false, "Compile to object file") 24 | ldflags = flag.String("ldflags", "", "Flags passed to underlying linker") 25 | debug = flag.Bool("g", false, "Compile with debug information") 26 | target = flag.String("target", "", "Target architecture triple") 27 | showTargets = flag.Bool("show-targets", false, "Show all available targets") 28 | ) 29 | 30 | const usageHeader = `Usage: gocaml [flags] [file] 31 | 32 | Compiler for GoCaml. 33 | When file is given as argument, compiler will compile it. Otherwise, compiler 34 | attempt to read from STDIN as source code to compile. 35 | 36 | Flags:` 37 | 38 | func usage() { 39 | fmt.Fprintln(os.Stderr, usageHeader) 40 | flag.PrintDefaults() 41 | } 42 | 43 | func getOptLevel() driver.OptLevel { 44 | switch *opt { 45 | case 0: 46 | return driver.O0 47 | case 1: 48 | return driver.O1 49 | case 2: 50 | return driver.O2 51 | case 3: 52 | return driver.O3 53 | default: 54 | if *llvm { 55 | return driver.O0 56 | } 57 | return driver.O2 58 | } 59 | } 60 | 61 | func main() { 62 | flag.Usage = usage 63 | flag.Parse() 64 | 65 | if *help { 66 | usage() 67 | os.Exit(0) 68 | } 69 | 70 | if *showTargets { 71 | for _, t := range codegen.AllTargets() { 72 | tabs := (23 - (len(t.Name) + 1)) / 8 73 | if tabs <= 0 { 74 | tabs = 1 75 | } 76 | pad := strings.Repeat("\t", tabs) 77 | fmt.Printf("%s:%s%s\n", t.Name, pad, t.Description) 78 | } 79 | os.Exit(0) 80 | } 81 | 82 | var src *locerr.Source 83 | var err error 84 | 85 | if flag.NArg() == 0 { 86 | src, err = locerr.NewSourceFromStdin() 87 | } else { 88 | src, err = locerr.NewSourceFromFile(flag.Arg(0)) 89 | } 90 | 91 | if err != nil { 92 | fmt.Fprintf(os.Stderr, "Error on opening source: %s\n", err.Error()) 93 | os.Exit(4) 94 | } 95 | 96 | d := driver.Driver{ 97 | Optimization: getOptLevel(), 98 | TargetTriple: *target, 99 | LinkFlags: *ldflags, 100 | DebugInfo: *debug, 101 | } 102 | 103 | switch { 104 | case *showTokens: 105 | d.PrintTokens(src) 106 | case *showAST: 107 | case *check: 108 | d.PrintAST(src) 109 | if _, _, err := d.SemanticAnalysis(src); err != nil { 110 | fmt.Fprintln(os.Stderr, err) 111 | os.Exit(4) 112 | } 113 | case *analyze: 114 | if err := d.DumpEnvToStdout(src); err != nil { 115 | fmt.Fprintln(os.Stderr, err) 116 | os.Exit(4) 117 | } 118 | case *showMIR: 119 | prog, env, err := d.EmitMIR(src) 120 | if err != nil { 121 | fmt.Fprintln(os.Stderr, err) 122 | os.Exit(4) 123 | } 124 | prog.Println(os.Stdout, env) 125 | case *llvm: 126 | ir, err := d.EmitLLVMIR(src) 127 | if err != nil { 128 | fmt.Fprintln(os.Stderr, err) 129 | os.Exit(4) 130 | } 131 | fmt.Println(ir) 132 | case *asm: 133 | asm, err := d.EmitAsm(src) 134 | if err != nil { 135 | fmt.Fprintln(os.Stderr, err) 136 | os.Exit(4) 137 | } 138 | fmt.Println(asm) 139 | case *obj: 140 | if err := d.EmitObjFile(src); err != nil { 141 | fmt.Fprintln(os.Stderr, err) 142 | os.Exit(4) 143 | } 144 | default: 145 | if err := d.Compile(src); err != nil { 146 | fmt.Fprintln(os.Stderr, err) 147 | os.Exit(4) 148 | } 149 | } 150 | } 151 | -------------------------------------------------------------------------------- /mir/block.go: -------------------------------------------------------------------------------- 1 | // Package mir provides definition of MIR and converter from AST. 2 | // 3 | // MIR is an abbreviation of GoCaml Intermediate Language. 4 | // It's an original intermediate language to fill the gap between machine code and 5 | // syntax tree. 6 | // MIR is a SSA form and K-normalized, and has high-level type information. 7 | // 8 | // It discards many things from syntax tree because it's no longer needed. 9 | // For example, position of nodes, display name of symbols and nested tree structure are discarded. 10 | // 11 | // MIR consists of block (basic block), instruction and value. 12 | // There is a one root block. Block contains sequence of instructions. 13 | // Instruction contains a bound identifier name and its value. 14 | // Some value (`if`, `fun`, ...) contains recursive blocks. 15 | // 16 | // Please see spec file in the gocaml repository. 17 | // 18 | // https://github.com/rhysd/gocaml/blob/master/mir/README.md 19 | // 20 | // You can see its string representation by command 21 | // 22 | // gocaml -mir test.ml 23 | // 24 | // e.g. 25 | // 26 | // let x = 1 in 27 | // let rec f a b = if a < 0 then a + b - x else x in 28 | // if true then print_int (f 3 4) else () 29 | // 30 | // root: 31 | // x$t1 = int 1 32 | // f$t2 = fun a$t3,b$t4 33 | // $k1 = int 0 34 | // $k2 = less a$t3 $k1 35 | // $k3 = if $k2 36 | // then: 37 | // $k4 = add $at3 $bt4 38 | // $k5 = sub $k4 x$t1 39 | // else: 40 | // $k6 = ref x$t1 41 | // $k7 = bool true 42 | // $k8 = if $k7 43 | // then: 44 | // $k9 = xref print_int 45 | // $k10 = ref f$t2 46 | // $k11 = int 3 47 | // $k12 = int 4 48 | // $k13 = app $k10 $k11,$k12 49 | // $k14 = app $k9 $k13 50 | // else: 51 | // $k15 = unit 52 | // 53 | package mir 54 | 55 | import ( 56 | "github.com/rhysd/locerr" 57 | ) 58 | 59 | // Block struct represents basic block. 60 | // It has a name and instruction sequence to execute. 61 | // Note that top and bottom of the sequence are always NOP instruction in order to 62 | // make modifying instructions easy. 63 | type Block struct { 64 | Top *Insn 65 | Bottom *Insn 66 | Name string 67 | } 68 | 69 | func NewBlock(name string, top, bottom *Insn) *Block { 70 | start := &Insn{"", NOPVal, top, nil, locerr.Pos{}} 71 | top.Prev = start 72 | end := &Insn{"", NOPVal, nil, bottom, locerr.Pos{}} 73 | bottom.Next = end 74 | return &Block{start, end, name} 75 | } 76 | 77 | func NewEmptyBlock(name string) *Block { 78 | start := &Insn{"", NOPVal, nil, nil, locerr.Pos{}} 79 | end := &Insn{"", NOPVal, nil, nil, locerr.Pos{}} 80 | start.Next = end 81 | end.Prev = start 82 | return &Block{start, end, name} 83 | } 84 | 85 | func NewBlockFromArray(name string, insns []*Insn) *Block { 86 | if len(insns) == 0 { 87 | panic("Block must contain at least one instruction") 88 | } 89 | 90 | top := insns[0] 91 | bottom := top 92 | for _, insn := range insns[1:] { 93 | insn.Prev = bottom 94 | bottom.Next = insn 95 | bottom = insn 96 | } 97 | 98 | return NewBlock(name, top, bottom) 99 | } 100 | 101 | func (b *Block) Prepend(i *Insn) { 102 | i.Next = b.Top.Next 103 | i.Prev = b.Top 104 | b.Top.Next.Prev = i 105 | b.Top.Next = i 106 | } 107 | 108 | func (b *Block) Append(i *Insn) { 109 | i.Next = b.Bottom 110 | i.Prev = b.Bottom.Prev 111 | b.Bottom.Prev.Next = i 112 | b.Bottom.Prev = i 113 | } 114 | 115 | // Returns range [begin, end) 116 | func (b *Block) WholeRange() (begin *Insn, end *Insn) { 117 | begin = b.Top.Next 118 | end = b.Bottom 119 | return 120 | } 121 | 122 | // Instruction. 123 | // Its form is always `ident = val` 124 | type Insn struct { 125 | Ident string 126 | Val Val 127 | Next *Insn 128 | Prev *Insn 129 | Pos locerr.Pos 130 | } 131 | 132 | func (insn *Insn) Last() *Insn { 133 | i := insn 134 | for i.Next != nil { 135 | i = i.Next 136 | } 137 | return i 138 | } 139 | 140 | func (insn *Insn) Append(other *Insn) { 141 | if other == nil { 142 | return 143 | } 144 | last := insn.Last() 145 | last.Next = other 146 | other.Prev = last 147 | } 148 | 149 | func (insn *Insn) RemoveFromList() { 150 | insn.Next.Prev = insn.Prev 151 | insn.Prev.Next = insn.Next 152 | } 153 | 154 | func NewInsn(n string, v Val, pos locerr.Pos) *Insn { 155 | return &Insn{n, v, nil, nil, pos} 156 | } 157 | 158 | func Concat(a, b *Insn) *Insn { 159 | a.Append(b) 160 | return a 161 | } 162 | 163 | // Reverse the instruction list. `insn` is assumed to point head of the list 164 | func Reverse(insn *Insn) *Insn { 165 | i := insn 166 | for { 167 | i.Next, i.Prev = i.Prev, i.Next 168 | if i.Prev == nil { 169 | return i 170 | } 171 | i = i.Prev 172 | } 173 | } 174 | -------------------------------------------------------------------------------- /mir/block_test.go: -------------------------------------------------------------------------------- 1 | package mir 2 | 3 | import ( 4 | "github.com/rhysd/locerr" 5 | "testing" 6 | ) 7 | 8 | func TestLast(t *testing.T) { 9 | i1 := &Insn{"test1", nil, nil, nil, locerr.Pos{}} 10 | i2 := &Insn{"test1", nil, i1, nil, locerr.Pos{}} 11 | i1.Prev = i2 12 | 13 | if i1 != i2.Last() { 14 | t.Errorf("last node is actually not last") 15 | } 16 | 17 | if i1 != i1.Last() { 18 | t.Errorf("last of last node should be itself") 19 | } 20 | } 21 | 22 | func TestInsnAppend(t *testing.T) { 23 | i1 := &Insn{"test1", nil, nil, nil, locerr.Pos{}} 24 | i2 := &Insn{"test2", nil, i1, nil, locerr.Pos{}} 25 | i1.Prev = i2 26 | 27 | i3 := &Insn{"test3", nil, nil, nil, locerr.Pos{}} 28 | i4 := &Insn{"test4", nil, i3, nil, locerr.Pos{}} 29 | i3.Prev = i4 30 | 31 | i2.Append(i4) 32 | 33 | strings := []string{"test2", "test1", "test4", "test3"} 34 | 35 | insn := i2 36 | for i, s := range strings { 37 | if insn.Ident != s { 38 | t.Errorf("While forwarding list %dth insn must be '%s' but actually '%s'", i, s, insn.Ident) 39 | } 40 | if insn.Next != nil && insn.Next.Prev != insn { 41 | t.Errorf("Prev does not point previous node properly. Expected %v but actually %v", insn, insn.Next.Prev) 42 | } 43 | insn = insn.Next 44 | } 45 | } 46 | 47 | func TestConcat(t *testing.T) { 48 | i1 := &Insn{"test1", nil, nil, nil, locerr.Pos{}} 49 | i2 := &Insn{"test2", nil, i1, nil, locerr.Pos{}} 50 | i1.Prev = i2 51 | 52 | i3 := &Insn{"test3", nil, nil, nil, locerr.Pos{}} 53 | i4 := &Insn{"test4", nil, i3, nil, locerr.Pos{}} 54 | i3.Prev = i4 55 | 56 | i5 := Concat(i2, i4) 57 | 58 | strings := []string{"test2", "test1", "test4", "test3"} 59 | 60 | insn := i5 61 | for i, s := range strings { 62 | if insn.Ident != s { 63 | t.Errorf("While forwarding list %dth insn must be '%s' but actually '%s'", i, s, insn.Ident) 64 | } 65 | if insn.Next != nil && insn.Next.Prev != insn { 66 | t.Errorf("Prev does not point previous node properly. Expected %v but actually %v", insn, insn.Next.Prev) 67 | } 68 | insn = insn.Next 69 | } 70 | } 71 | 72 | func TestReverse(t *testing.T) { 73 | i1 := &Insn{"test1", nil, nil, nil, locerr.Pos{}} 74 | i2 := &Insn{"test1", nil, i1, nil, locerr.Pos{}} 75 | i1.Prev = i2 76 | 77 | i3 := Reverse(i2) 78 | if i1 != i3 { 79 | t.Errorf("previous bottom must be head of reversed list") 80 | } 81 | 82 | if i3.Next != i2 { 83 | t.Errorf("list direction must be reversed but actually %v", i3.Next) 84 | } 85 | if i3.Prev != nil { 86 | t.Errorf("prev of top of reversed list must be null but %v", i3.Prev) 87 | } 88 | 89 | if i2.Next != nil { 90 | t.Errorf("bottom of list must be ended with nil but actually %v", i2.Next) 91 | } 92 | if i2.Prev != i1 { 93 | t.Errorf("prev of bottom of reversed list must be i1 but %v", i2.Prev) 94 | } 95 | } 96 | 97 | func TestEmptyArrayFail(t *testing.T) { 98 | defer func() { 99 | if r := recover(); r == nil { 100 | t.Errorf("Trying to create empty block should make panic") 101 | } 102 | }() 103 | NewBlockFromArray("test", []*Insn{}) 104 | } 105 | 106 | func TestBlockPrepend(t *testing.T) { 107 | i := NewInsn("$k1", UnitVal, locerr.Pos{}) 108 | j := NewInsn("$k2", UnitVal, locerr.Pos{}) 109 | b := NewBlockFromArray("test", []*Insn{i}) 110 | b.Prepend(j) 111 | if j.Next != i || i.Prev != j || j.Prev != b.Top || b.Top.Next != j { 112 | t.Fatalf("Instruction was not prepended correctly") 113 | } 114 | } 115 | 116 | func TestBlockAppend(t *testing.T) { 117 | i := NewInsn("$k1", UnitVal, locerr.Pos{}) 118 | j := NewInsn("$k2", UnitVal, locerr.Pos{}) 119 | b := NewBlockFromArray("test", []*Insn{i}) 120 | b.Append(j) 121 | if i.Next != j || j.Prev != i || b.Bottom.Prev != j || j.Next != b.Bottom { 122 | t.Fatalf("Instruction was not appended correctly") 123 | } 124 | } 125 | -------------------------------------------------------------------------------- /mir/printer.go: -------------------------------------------------------------------------------- 1 | package mir 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/types" 6 | "io" 7 | ) 8 | 9 | type printer struct { 10 | types *types.Env 11 | out io.Writer 12 | indent string 13 | } 14 | 15 | func (p *printer) getTypeNameOf(insn *Insn) string { 16 | t, ok := p.types.DeclTable[insn.Ident] 17 | if !ok { 18 | panic("FATAL: Type of identifier not found: " + insn.Ident) 19 | } 20 | return t.String() 21 | } 22 | 23 | func (p *printer) printlnInsn(insn *Insn) { 24 | fmt.Fprintf(p.out, "%s%s = ", p.indent, insn.Ident) 25 | insn.Val.Print(p.out) 26 | fmt.Fprintf(p.out, " ; type=%s\n", p.getTypeNameOf(insn)) 27 | switch i := insn.Val.(type) { 28 | case *If: 29 | indented := printer{p.types, p.out, p.indent + " "} 30 | indented.printlnBlock(i.Then) 31 | indented.printlnBlock(i.Else) 32 | case *Fun: 33 | indented := printer{p.types, p.out, p.indent + " "} 34 | indented.printlnBlock(i.Body) 35 | } 36 | } 37 | 38 | func (p *printer) printlnBlock(b *Block) { 39 | fmt.Fprintf(p.out, "%sBEGIN: %s\n", p.indent, b.Name) 40 | for i := b.Top.Next; i.Next != nil; i = i.Next { 41 | p.printlnInsn(i) 42 | } 43 | fmt.Fprintf(p.out, "%sEND: %s\n", p.indent, b.Name) 44 | } 45 | 46 | func (b *Block) Println(out io.Writer, types *types.Env) { 47 | p := printer{ 48 | types, 49 | out, 50 | "", 51 | } 52 | p.printlnBlock(b) 53 | } 54 | -------------------------------------------------------------------------------- /mir/program.go: -------------------------------------------------------------------------------- 1 | package mir 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/types" 6 | "github.com/rhysd/locerr" 7 | "io" 8 | "strings" 9 | ) 10 | 11 | // Closures is a map from closure name to its captures 12 | type Closures map[string][]string 13 | 14 | type FunInsn struct { 15 | Name string 16 | Val *Fun 17 | Pos locerr.Pos 18 | } 19 | 20 | type Toplevel map[string]FunInsn 21 | 22 | func NewToplevel() Toplevel { 23 | return map[string]FunInsn{} 24 | } 25 | 26 | func (top Toplevel) Add(n string, f *Fun, p locerr.Pos) { 27 | top[n] = FunInsn{n, f, p} 28 | } 29 | 30 | // Program representation. Program can be obtained after closure transform because 31 | // all functions must be at the top. 32 | type Program struct { 33 | Toplevel Toplevel // Mapping from function name to its instruction 34 | Closures Closures // Mapping from closure name to it free variables 35 | Entry *Block 36 | } 37 | 38 | func (prog *Program) PrintToplevels(out io.Writer, env *types.Env) { 39 | p := printer{env, out, ""} 40 | for n, f := range prog.Toplevel { 41 | p.printlnInsn(NewInsn(n, f.Val, f.Pos)) 42 | fmt.Fprintln(out) 43 | } 44 | } 45 | 46 | func (prog *Program) Dump(out io.Writer, env *types.Env) { 47 | fmt.Fprintf(out, "[TOPLEVELS (%d)]\n", len(prog.Toplevel)) 48 | prog.PrintToplevels(out, env) 49 | 50 | fmt.Fprintf(out, "[CLOSURES (%d)]\n", len(prog.Closures)) 51 | for c, fv := range prog.Closures { 52 | fmt.Fprintf(out, "%s:\t%s\n", c, strings.Join(fv, ",")) 53 | } 54 | fmt.Fprintln(out) 55 | 56 | fmt.Fprintln(out, "[ENTRY]") 57 | prog.Entry.Println(out, env) 58 | } 59 | 60 | func (prog *Program) Println(out io.Writer, env *types.Env) { 61 | prog.PrintToplevels(out, env) 62 | prog.Entry.Println(out, env) 63 | } 64 | -------------------------------------------------------------------------------- /mir/program_test.go: -------------------------------------------------------------------------------- 1 | package mir 2 | 3 | import ( 4 | "bytes" 5 | "github.com/rhysd/gocaml/types" 6 | "github.com/rhysd/locerr" 7 | "strings" 8 | "testing" 9 | ) 10 | 11 | func TestDump(t *testing.T) { 12 | prog := &Program{ 13 | NewToplevel(), 14 | map[string][]string{}, 15 | NewBlockFromArray("program", []*Insn{ 16 | NewInsn("$k1", UnitVal, locerr.Pos{}), 17 | }), 18 | } 19 | 20 | env := types.NewEnv() 21 | env.DeclTable["$k1"] = types.UnitType 22 | 23 | var buf bytes.Buffer 24 | prog.Dump(&buf, env) 25 | out := buf.String() 26 | if !strings.Contains(out, "[TOPLEVELS (0)]") { 27 | t.Fatalf("Toplevel section not found") 28 | } 29 | if !strings.Contains(out, "[CLOSURES (0)]") { 30 | t.Fatalf("Closures section not found") 31 | } 32 | if !strings.Contains(out, "[ENTRY]") { 33 | t.Fatalf("Entry section not found") 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /mir/val.go: -------------------------------------------------------------------------------- 1 | package mir 2 | 3 | import ( 4 | "fmt" 5 | "io" 6 | "strconv" 7 | "strings" 8 | ) 9 | 10 | type Val interface { 11 | Print(io.Writer) 12 | } 13 | 14 | type OperatorKind int 15 | 16 | // Operators 17 | const ( 18 | NOT OperatorKind = iota 19 | NEG 20 | FNEG 21 | ADD 22 | SUB 23 | MUL 24 | DIV 25 | MOD 26 | FADD 27 | FSUB 28 | FMUL 29 | FDIV 30 | LT 31 | LTE 32 | EQ 33 | NEQ 34 | GT 35 | GTE 36 | AND 37 | OR 38 | ) 39 | 40 | var OpTable = [...]string{ 41 | NOT: "not", 42 | NEG: "-", 43 | FNEG: "-.", 44 | ADD: "+", 45 | SUB: "-", 46 | MUL: "*", 47 | DIV: "/", 48 | MOD: "%", 49 | FADD: "+.", 50 | FSUB: "-.", 51 | FMUL: "*.", 52 | FDIV: "/.", 53 | LT: "<", 54 | LTE: "<=", 55 | EQ: "=", 56 | NEQ: "<>", 57 | GT: ">", 58 | GTE: ">=", 59 | AND: "&&", 60 | OR: "||", 61 | } 62 | 63 | // Kind of function call. 64 | type AppKind int 65 | 66 | const ( 67 | // Means to call a function without closure 68 | DIRECT_CALL AppKind = iota 69 | CLOSURE_CALL 70 | EXTERNAL_CALL 71 | ) 72 | 73 | var appTable = [...]string{ 74 | DIRECT_CALL: "", 75 | CLOSURE_CALL: "cls", 76 | EXTERNAL_CALL: "x", 77 | } 78 | 79 | type ( 80 | Unit struct{} 81 | Bool struct { 82 | Const bool 83 | } 84 | Int struct { 85 | Const int64 86 | } 87 | Float struct { 88 | Const float64 89 | } 90 | String struct { 91 | Const string 92 | } 93 | Unary struct { 94 | Op OperatorKind 95 | Child string 96 | } 97 | Binary struct { 98 | Op OperatorKind 99 | LHS, RHS string 100 | } 101 | Ref struct { 102 | Ident string 103 | } 104 | If struct { 105 | Cond string 106 | Then *Block 107 | Else *Block 108 | } 109 | Fun struct { 110 | Params []string 111 | Body *Block 112 | IsRecursive bool 113 | } 114 | App struct { 115 | Callee string 116 | Args []string 117 | Kind AppKind 118 | } 119 | Tuple struct { 120 | Elems []string 121 | } 122 | TplLoad struct { // Used for each element of LetTuple 123 | From string 124 | Index int 125 | } 126 | Array struct { 127 | Size, Elem string 128 | } 129 | ArrLit struct { 130 | Elems []string 131 | } 132 | ArrLoad struct { 133 | From, Index string 134 | } 135 | ArrStore struct { 136 | To, Index, RHS string 137 | } 138 | ArrLen struct { 139 | Array string 140 | } 141 | Some struct { 142 | Elem string 143 | } 144 | None struct { 145 | } 146 | IsSome struct { 147 | OptVal string 148 | } 149 | DerefSome struct { 150 | SomeVal string 151 | } 152 | XRef struct { 153 | Ident string 154 | } 155 | NOP struct { 156 | } 157 | // Introduced at closure-transform. 158 | MakeCls struct { 159 | Vars []string 160 | Fun string 161 | } 162 | ) 163 | 164 | var ( 165 | UnitVal = &Unit{} 166 | NOPVal = &NOP{} 167 | NoneVal = &None{} 168 | ) 169 | 170 | func (v *Unit) Print(out io.Writer) { 171 | fmt.Fprint(out, "unit") 172 | } 173 | func (v *Bool) Print(out io.Writer) { 174 | fmt.Fprintf(out, "bool %v", v.Const) 175 | } 176 | func (v *Int) Print(out io.Writer) { 177 | fmt.Fprintf(out, "int %d", v.Const) 178 | } 179 | func (v *Float) Print(out io.Writer) { 180 | fmt.Fprintf(out, "float %f", v.Const) 181 | } 182 | func (v *String) Print(out io.Writer) { 183 | fmt.Fprintf(out, "string %s", strconv.Quote(v.Const)) 184 | } 185 | func (v *Unary) Print(out io.Writer) { 186 | fmt.Fprintf(out, "unary %s %s", OpTable[v.Op], v.Child) 187 | } 188 | func (v *Binary) Print(out io.Writer) { 189 | fmt.Fprintf(out, "binary %s %s %s", OpTable[v.Op], v.LHS, v.RHS) 190 | } 191 | func (v *Ref) Print(out io.Writer) { 192 | fmt.Fprintf(out, "ref %s", v.Ident) 193 | } 194 | func (v *If) Print(out io.Writer) { 195 | fmt.Fprintf(out, "if %s", v.Cond) 196 | } 197 | func (v *Fun) Print(out io.Writer) { 198 | rec := "" 199 | if v.IsRecursive { 200 | rec = "rec" 201 | } 202 | fmt.Fprintf(out, "%sfun %s", rec, strings.Join(v.Params, ",")) 203 | } 204 | func (v *App) Print(out io.Writer) { 205 | fmt.Fprintf(out, "app%s %s %s", appTable[v.Kind], v.Callee, strings.Join(v.Args, ",")) 206 | } 207 | func (v *Tuple) Print(out io.Writer) { 208 | fmt.Fprintf(out, "tuple %s", strings.Join(v.Elems, ",")) 209 | } 210 | func (v *Array) Print(out io.Writer) { 211 | fmt.Fprintf(out, "array %s %s", v.Size, v.Elem) 212 | } 213 | func (v *ArrLit) Print(out io.Writer) { 214 | fmt.Fprintf(out, "arrlit %s", strings.Join(v.Elems, ",")) 215 | } 216 | func (v *TplLoad) Print(out io.Writer) { 217 | fmt.Fprintf(out, "tplload %d %s", v.Index, v.From) 218 | } 219 | func (v *ArrLoad) Print(out io.Writer) { 220 | fmt.Fprintf(out, "arrload %s %s", v.Index, v.From) 221 | } 222 | func (v *ArrStore) Print(out io.Writer) { 223 | fmt.Fprintf(out, "arrstore %s %s %s", v.Index, v.To, v.RHS) 224 | } 225 | func (v *ArrLen) Print(out io.Writer) { 226 | fmt.Fprintf(out, "arrlen %s", v.Array) 227 | } 228 | func (v *XRef) Print(out io.Writer) { 229 | fmt.Fprintf(out, "xref %s", v.Ident) 230 | } 231 | func (v *NOP) Print(out io.Writer) { 232 | fmt.Fprint(out, "nop") 233 | } 234 | func (v *MakeCls) Print(out io.Writer) { 235 | fmt.Fprintf(out, "makecls (%s) %s", strings.Join(v.Vars, ","), v.Fun) 236 | } 237 | func (v *Some) Print(out io.Writer) { 238 | fmt.Fprintf(out, "some %s", v.Elem) 239 | } 240 | func (v *None) Print(out io.Writer) { 241 | fmt.Fprint(out, "none") 242 | } 243 | func (v *IsSome) Print(out io.Writer) { 244 | fmt.Fprintf(out, "issome %s", v.OptVal) 245 | } 246 | func (v *DerefSome) Print(out io.Writer) { 247 | fmt.Fprintf(out, "derefsome %s", v.SomeVal) 248 | } 249 | -------------------------------------------------------------------------------- /runtime/gocaml.h: -------------------------------------------------------------------------------- 1 | #if !defined GOCAML_H_INCLUDED 2 | #define GOCAML_H_INCLUDED 3 | 4 | #include 5 | 6 | typedef int64_t gocaml_int; 7 | typedef int gocaml_bool; 8 | typedef double gocaml_float; 9 | 10 | typedef struct { 11 | void *buf; 12 | gocaml_int size; 13 | } gocaml_array; 14 | 15 | typedef struct { 16 | int8_t *chars; // Null-terminated string 17 | gocaml_int size; 18 | } gocaml_string; 19 | 20 | typedef struct {} gocaml_unit; 21 | 22 | #endif // GOCAML_H_INCLUDED 23 | -------------------------------------------------------------------------------- /scripts/install_llvmgo.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | GOPATH="$(go env GOPATH)" 6 | 7 | if [[ "$GOPATH" == "" ]]; then 8 | echo '$GOPATH is empty' 1>&2 9 | exit 4 10 | fi 11 | 12 | LLVM_ORG_DIR="${GOPATH}/src/llvm.org" 13 | LLVM_DIR="${LLVM_ORG_DIR}/llvm" 14 | LLVM_GO_DIR="${LLVM_DIR}/bindings/go" 15 | LLVM_GO_LLVM_DIR="${LLVM_GO_DIR}/llvm" 16 | LLVM_ARCHIVE="${GOPATH}/pkg/$(go env GOOS)_$(go env GOARCH)/llvm.org/llvm/bindings/go/llvm.a" 17 | 18 | if [[ -f "$LLVM_ARCHIVE" ]]; then 19 | echo "LLVM is already installed: ${LLVM_ARCHIVE}. Installation skipped." 20 | exit 21 | fi 22 | 23 | if [[ "$LLVM_BRANCH" == "" ]]; then 24 | LLVM_BRANCH="release_50" 25 | fi 26 | 27 | rm -rf "$LLVM_DIR" 28 | mkdir -p "$LLVM_ORG_DIR" 29 | cd "$LLVM_ORG_DIR" 30 | 31 | echo "Cloning LLVM branch: ${LLVM_BRANCH}..." 32 | git clone --depth 1 -b $LLVM_BRANCH --single-branch https://llvm.org/git/llvm.git 33 | cd "$LLVM_GO_DIR" 34 | 35 | if [[ "$USE_SYSTEM_LLVM" == "" ]]; then 36 | echo "Building LLVM locally: ${LLVM_DIR}" 37 | # -DCMAKE_BUILD_TYPE=Debug makes `go build` too slow because clang's linker is very slow with dwarf. 38 | ./build.sh -DCMAKE_BUILD_TYPE=Release 39 | 40 | go install -v ./llvm 41 | exit 42 | fi 43 | 44 | echo "Building go-llvm with system installed LLVM..." 45 | 46 | if [[ "$LLVM_CONFIG" == "" ]]; then 47 | LLVM_CONFIG="llvm-config" 48 | case "$OSTYPE" in 49 | darwin*) 50 | BREW_LLVM="$(ls -1 /usr/local/Cellar/llvm/*/bin/llvm-config | tail -1)" 51 | if [[ "$BREW_LLVM" != "" ]]; then 52 | LLVM_CONFIG="$BREW_LLVM" 53 | # libffi is needed to build Go bindings 54 | CGO_LDFLAGS="$CGO_LDFLAGS -L/usr/local/opt/libffi/lib -lffi" 55 | echo "Detected LLVM installed with Homebrew: $BREW_LLVM" 56 | fi 57 | ;; 58 | esac 59 | fi 60 | 61 | if which "$LLVM_CONFIG" 2>&1 > /dev/null; then 62 | echo "llvm-config version: $($LLVM_CONFIG --version)" 63 | else 64 | echo "llvm-config command not found: $LLVM_CONFIG" >&2 65 | exit 1 66 | fi 67 | 68 | cd "$LLVM_GO_LLVM_DIR" 69 | 70 | export CGO_CPPFLAGS="${CGO_CPPFLAGS} $($LLVM_CONFIG --cppflags) ${GOCAML_CPPFLAGS}" 71 | export CGO_CXXFLAGS="${CGO_CXXFLAGS} $($LLVM_CONFIG --cxxflags) ${GOCAML_CXXFLAGS}" 72 | export CGO_LDFLAGS="${CGO_LDFLAGS} $($LLVM_CONFIG --ldflags --libs --system-libs all | tr '\n' ' ') ${GOCAML_LDFLAGS}" 73 | 74 | echo "CGO_CPPFLAGS='$CGO_CPPFLAGS'" 75 | echo "CGO_CXXFLAGS='$CGO_CXXFLAGS'" 76 | echo "CGO_LDFLAGS='$CGO_LDFLAGS'" 77 | 78 | cat ${LLVM_GO_LLVM_DIR}/llvm_config.go.in | \ 79 | sed "s#@LLVM_CFLAGS@#${CGO_CPPFLAGS}#" | \ 80 | sed "s#@LLVM_LDFLAGS@#${CGO_LDFLAGS}#" > \ 81 | ${LLVM_GO_LLVM_DIR}/llvm_config.go 82 | 83 | go install -v -tags byollvm 84 | -------------------------------------------------------------------------------- /scripts/travis_install.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | set -e 4 | 5 | export USE_SYSTEM_LLVM=true 6 | 7 | if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then 8 | brew update 9 | brew info llvm 10 | brew install bdw-gc llvm 11 | else 12 | go get golang.org/x/tools/cmd/cover 13 | go get github.com/haya14busa/goverage 14 | go get github.com/mattn/goveralls 15 | export LLVM_CONFIG="llvm-config-5.0" 16 | fi 17 | 18 | make build 19 | -------------------------------------------------------------------------------- /sema/deref_test.go: -------------------------------------------------------------------------------- 1 | package sema 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/ast" 6 | "github.com/rhysd/gocaml/syntax" 7 | "github.com/rhysd/gocaml/token" 8 | . "github.com/rhysd/gocaml/types" 9 | "github.com/rhysd/locerr" 10 | "strings" 11 | "testing" 12 | ) 13 | 14 | func varT(t Type) *Var { 15 | return NewVar(t, 0) 16 | } 17 | 18 | func TestDerefFailure(t *testing.T) { 19 | s := locerr.NewDummySource("") 20 | pos := locerr.Pos{0, 0, 0, s} 21 | tok := &token.Token{token.ILLEGAL, pos, pos, s} 22 | env := NewEnv() 23 | env.DeclTable["hello"] = varT(nil) 24 | v := &typeVarDereferencer{ 25 | nil, 26 | env, 27 | map[ast.Expr]Type{}, 28 | schemes{}, 29 | } 30 | root := &ast.Let{ 31 | tok, 32 | ast.NewSymbol("hello"), 33 | &ast.Int{tok, 0}, 34 | &ast.Int{tok, 0}, 35 | nil, 36 | } 37 | ast.Visit(v, root) 38 | if v.err == nil { 39 | t.Fatal("Unknown symbol 'hello' must cause an error") 40 | } 41 | msg := v.err.Error() 42 | if !strings.Contains(msg, "Cannot infer type of variable 'hello'") { 43 | t.Fatal("Unexpected error message:", msg) 44 | } 45 | } 46 | 47 | func TestUnwrapEmptyTypeVar(t *testing.T) { 48 | e := varT(nil) 49 | for _, ty := range []Type{ 50 | e, 51 | varT(e), 52 | varT(varT(e)), 53 | &Tuple{[]Type{e}}, 54 | &Fun{e, []Type{}}, 55 | &Fun{IntType, []Type{e}}, 56 | &Option{e}, 57 | &Array{e}, 58 | } { 59 | v := &typeVarDereferencer{ 60 | nil, 61 | NewEnv(), 62 | map[ast.Expr]Type{}, 63 | schemes{}, 64 | } 65 | _, ok := v.unwrap(ty) 66 | if ok { 67 | t.Error("Unwrapping type variable must cause an error:", ty.String()) 68 | } 69 | } 70 | } 71 | 72 | func TestMiscCheckError(t *testing.T) { 73 | cases := []struct { 74 | what string 75 | code string 76 | expected string 77 | }{ 78 | { 79 | what: "unit is invalid for operator '<'", 80 | code: "() < ()", 81 | expected: "'unit' can't be compared with operator '<'", 82 | }, 83 | { 84 | what: "tuple is invalid for operator '<'", 85 | code: "let t = (1, 2) in t < t", 86 | expected: "'int * int' can't be compared with operator '<'", 87 | }, 88 | { 89 | what: "option is invalid for operator '<'", 90 | code: "let a = Some 3 in a < None", 91 | expected: "'int option' can't be compared with operator '<'", 92 | }, 93 | { 94 | what: "array is invalid for operator '='", 95 | code: "let a = Array.make 3 3 in a = a", 96 | expected: "'int array' can't be compared with operator '='", 97 | }, 98 | } 99 | 100 | for _, tc := range cases { 101 | t.Run(tc.what, func(t *testing.T) { 102 | s := locerr.NewDummySource(fmt.Sprintf("%s; ()", tc.code)) 103 | parsed, err := syntax.Parse(s) 104 | if err != nil { 105 | t.Fatal(err) 106 | } 107 | 108 | env := NewEnv() 109 | if err := AlphaTransform(parsed, env); err != nil { 110 | t.Fatal(err) 111 | } 112 | 113 | inf := NewInferer(env) 114 | 115 | // inf.Infer() invokes type dereferences 116 | err = inf.Infer(parsed) 117 | 118 | if err == nil { 119 | t.Fatalf("Expected code '%s' to cause an error '%s' but actually there is no error", tc.code, tc.expected) 120 | } 121 | if !strings.Contains(err.Error(), tc.expected) { 122 | t.Fatalf("Error message '%s' does not contain '%s'", err.Error(), tc.expected) 123 | } 124 | }) 125 | } 126 | } 127 | -------------------------------------------------------------------------------- /sema/example_test.go: -------------------------------------------------------------------------------- 1 | package sema 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/mir" 6 | "github.com/rhysd/gocaml/syntax" 7 | "github.com/rhysd/gocaml/types" 8 | "github.com/rhysd/locerr" 9 | "os" 10 | "path/filepath" 11 | ) 12 | 13 | func ExampleInferer_Infer() { 14 | // Type check example 15 | 16 | // Analyzing target 17 | src, err := locerr.NewSourceFromFile(filepath.FromSlash("../testdata/from-mincaml/ack.ml")) 18 | if err != nil { 19 | // File not found 20 | panic(err) 21 | } 22 | 23 | parsed, err := syntax.Parse(src) 24 | if err != nil { 25 | // When parse failed 26 | fmt.Fprintln(os.Stderr, err) 27 | return 28 | } 29 | 30 | // Type environment for analysis 31 | env := types.NewEnv() 32 | 33 | // First, resolve all symbols by alpha transform 34 | if err := AlphaTransform(parsed, env); err != nil { 35 | fmt.Fprintln(os.Stderr, err) 36 | return 37 | } 38 | 39 | // Second, run unification on all nodes and dereference type variables 40 | 41 | // Make a visitor to do type inferernce 42 | inferer := NewInferer(env) 43 | 44 | // Do type inference. It returns error if type mismatch was detected. 45 | if err := inferer.Infer(parsed); err != nil { 46 | fmt.Fprintln(os.Stderr, err) 47 | return 48 | } 49 | 50 | // No error found! 51 | fmt.Println("OK") 52 | // Output: OK 53 | } 54 | 55 | func ExampleSemanticsCheck() { 56 | file := filepath.FromSlash("../testdata/from-mincaml/ack.ml") 57 | src, err := locerr.NewSourceFromFile(file) 58 | if err != nil { 59 | // File not found 60 | panic(err) 61 | } 62 | 63 | ast, err := syntax.Parse(src) 64 | if err != nil { 65 | // When parse failed 66 | panic(err) 67 | } 68 | 69 | // Resolve symbols by alpha transform. 70 | // Then apply type inference. After this, all symbols in AST should have exact types. It also checks 71 | // types are valid and all types are determined by inference. It returns a type environment object 72 | // and converted MIR as the result. 73 | env, ir, err := SemanticsCheck(ast) 74 | if err != nil { 75 | // Type error detected 76 | panic(err) 77 | } 78 | 79 | // You can dump the type table 80 | env.Dump() 81 | 82 | ir.Println(os.Stdout, env) 83 | // Output: 84 | // ack$t1 = recfun x$t2,y$t3 ; type=(int, int) -> int 85 | // BEGIN: body (ack$t1) 86 | // $k2 = int 0 ; type=int 87 | // $k3 = binary <= x$t2 $k2 ; type=bool 88 | // $k28 = if $k3 ; type=int 89 | // BEGIN: then 90 | // $k5 = int 1 ; type=int 91 | // $k6 = binary + y$t3 $k5 ; type=int 92 | // END: then 93 | // BEGIN: else 94 | // $k8 = int 0 ; type=int 95 | // $k9 = binary <= y$t3 $k8 ; type=bool 96 | // $k27 = if $k9 ; type=int 97 | // BEGIN: then 98 | // $k12 = int 1 ; type=int 99 | // $k13 = binary - x$t2 $k12 ; type=int 100 | // $k14 = int 1 ; type=int 101 | // $k15 = app ack$t1 $k13,$k14 ; type=int 102 | // END: then 103 | // BEGIN: else 104 | // $k18 = int 1 ; type=int 105 | // $k19 = binary - x$t2 $k18 ; type=int 106 | // $k23 = int 1 ; type=int 107 | // $k24 = binary - y$t3 $k23 ; type=int 108 | // $k25 = app ack$t1 x$t2,$k24 ; type=int 109 | // $k26 = app ack$t1 $k19,$k25 ; type=int 110 | // END: else 111 | // END: else 112 | // END: body (ack$t1) 113 | // 114 | // BEGIN: program 115 | // $k31 = int 3 ; type=int 116 | // $k32 = int 10 ; type=int 117 | // $k33 = app ack$t1 $k31,$k32 ; type=int 118 | // $k34 = appx print_int $k33 ; type=unit 119 | // END: program 120 | 121 | // Optimization for eliminate unnecessary 'ref' instructions and classify 122 | // 'app' instruction for external function calls. 123 | mir.ElimRefs(ir, env) 124 | } 125 | -------------------------------------------------------------------------------- /sema/generic.go: -------------------------------------------------------------------------------- 1 | package sema 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/types" 5 | ) 6 | 7 | type boundVarIDs map[types.VarID]struct{} 8 | 9 | func (ids boundVarIDs) add(id types.VarID) { 10 | ids[id] = struct{}{} 11 | } 12 | 13 | func (ids boundVarIDs) contains(id types.VarID) bool { 14 | _, ok := ids[id] 15 | return ok 16 | } 17 | 18 | type generalizer struct { 19 | bounds boundVarIDs 20 | level int 21 | } 22 | 23 | func (gen *generalizer) apply(t types.Type) types.Type { 24 | switch t := t.(type) { 25 | case *types.Var: 26 | if t.Ref != nil { 27 | return gen.apply(t.Ref) 28 | } 29 | if t.Level > gen.level { 30 | gen.bounds.add(t.ID) 31 | t.SetGeneric() 32 | } 33 | return t 34 | case *types.Tuple: 35 | elems := make([]types.Type, 0, len(t.Elems)) 36 | for _, e := range t.Elems { 37 | elems = append(elems, gen.apply(e)) 38 | } 39 | return &types.Tuple{elems} 40 | case *types.Array: 41 | return &types.Array{gen.apply(t.Elem)} 42 | case *types.Option: 43 | return &types.Option{gen.apply(t.Elem)} 44 | case *types.Fun: 45 | params := make([]types.Type, 0, len(t.Params)) 46 | for _, p := range t.Params { 47 | params = append(params, gen.apply(p)) 48 | } 49 | return &types.Fun{gen.apply(t.Ret), params} 50 | default: 51 | return t 52 | } 53 | } 54 | 55 | // Generalize given type variable. It means binding proper free type variables in the type. It returns 56 | // generalized type and IDs of bound type variables in given type. 57 | func generalize(t types.Type, level int) (types.Type, boundVarIDs) { 58 | gen := &generalizer{boundVarIDs{}, level} 59 | t = gen.apply(t) 60 | return t, gen.bounds 61 | } 62 | 63 | type instantiator struct { 64 | freeVars []*types.VarMapping 65 | level int 66 | } 67 | 68 | func (inst *instantiator) apply(t types.Type) types.Type { 69 | switch t := t.(type) { 70 | case *types.Var: 71 | if t.Ref != nil { 72 | return inst.apply(t.Ref) 73 | } 74 | if !t.IsGeneric() { 75 | return t 76 | } 77 | for _, m := range inst.freeVars { 78 | if t.ID == m.ID { 79 | return m.Type 80 | } 81 | } 82 | v := types.NewVar(nil, inst.level) 83 | inst.freeVars = append(inst.freeVars, &types.VarMapping{t.ID, v}) 84 | return v 85 | case *types.Tuple: 86 | ts := make([]types.Type, 0, len(t.Elems)) 87 | for _, e := range t.Elems { 88 | ts = append(ts, inst.apply(e)) 89 | } 90 | return &types.Tuple{ts} 91 | case *types.Array: 92 | return &types.Array{inst.apply(t.Elem)} 93 | case *types.Option: 94 | return &types.Option{inst.apply(t.Elem)} 95 | case *types.Fun: 96 | ts := make([]types.Type, 0, len(t.Params)) 97 | for _, p := range t.Params { 98 | ts = append(ts, inst.apply(p)) 99 | } 100 | return &types.Fun{inst.apply(t.Ret), ts} 101 | default: 102 | return t 103 | } 104 | } 105 | 106 | func instantiate(t types.Type, level int) *types.Instantiation { 107 | i := &instantiator{[]*types.VarMapping{}, level} 108 | ret := i.apply(t) 109 | if len(i.freeVars) == 0 { 110 | // Should return the original type 't' here? 111 | // Even if no instantiation occurred, linked type variables may be dereferenced in instantiator.apply(). 112 | return nil 113 | } 114 | return &types.Instantiation{ 115 | From: t, 116 | To: ret, 117 | Mapping: i.freeVars, 118 | } 119 | } 120 | -------------------------------------------------------------------------------- /sema/node_to_type.go: -------------------------------------------------------------------------------- 1 | package sema 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/ast" 5 | . "github.com/rhysd/gocaml/types" 6 | "github.com/rhysd/locerr" 7 | ) 8 | 9 | type nodeTypeConv struct { 10 | aliases map[string]Type 11 | acceptsAnyType bool 12 | } 13 | 14 | func newNodeTypeConv(decls []*ast.TypeDecl) (*nodeTypeConv, error) { 15 | conv := &nodeTypeConv{make(map[string]Type, len(decls)+5 /*primitives*/), true} 16 | conv.aliases["unit"] = UnitType 17 | conv.aliases["int"] = IntType 18 | conv.aliases["bool"] = BoolType 19 | conv.aliases["float"] = FloatType 20 | conv.aliases["string"] = StringType 21 | 22 | for _, decl := range decls { 23 | t, err := conv.nodeToType(decl.Type, -1) 24 | if err != nil { 25 | return nil, locerr.NotefAt(decl.Pos(), err, "Type declaration '%s'", decl.Ident.Name) 26 | } 27 | conv.aliases[decl.Ident.Name] = t 28 | } 29 | return conv, nil 30 | } 31 | 32 | func (conv *nodeTypeConv) nodesToTypes(nodes []ast.Expr, level int) ([]Type, error) { 33 | types := make([]Type, 0, len(nodes)) 34 | for _, n := range nodes { 35 | t, err := conv.nodeToType(n, level) 36 | if err != nil { 37 | return nil, err 38 | } 39 | types = append(types, t) 40 | } 41 | return types, nil 42 | } 43 | 44 | func (conv *nodeTypeConv) nodeToType(node ast.Expr, level int) (Type, error) { 45 | switch n := node.(type) { 46 | case *ast.FuncType: 47 | params, err := conv.nodesToTypes(n.ParamTypes, level) 48 | if err != nil { 49 | return nil, err 50 | } 51 | 52 | ret, err := conv.nodeToType(n.RetType, level) 53 | if err != nil { 54 | return nil, err 55 | } 56 | 57 | return &Fun{ret, params}, nil 58 | case *ast.TupleType: 59 | elems, err := conv.nodesToTypes(n.ElemTypes, level) 60 | return &Tuple{elems}, err 61 | case *ast.CtorType: 62 | len := len(n.ParamTypes) 63 | if len == 0 { 64 | if n.Ctor.Name == "_" { 65 | if !conv.acceptsAnyType { 66 | return nil, locerr.ErrorIn(n.Pos(), n.End(), "'_' is not permitted for type annotation in this context") 67 | } 68 | // '_' accepts any type. 69 | return &Var{Level: level}, nil 70 | } 71 | if t, ok := conv.aliases[n.Ctor.Name]; ok { 72 | return t, nil 73 | } 74 | } 75 | 76 | // TODO: Currently only built-in array and option types are supported 77 | switch n.Ctor.Name { 78 | case "array": 79 | if len != 1 { 80 | return nil, locerr.ErrorIn(n.Pos(), n.End(), "Invalid array type. 'array' only has 1 type parameter") 81 | } 82 | elem, err := conv.nodeToType(n.ParamTypes[0], level) 83 | return &Array{elem}, err 84 | case "option": 85 | if len != 1 { 86 | return nil, locerr.ErrorIn(n.Pos(), n.End(), "Invalid option type. 'option' only has 1 type parameter") 87 | } 88 | elem, err := conv.nodeToType(n.ParamTypes[0], level) 89 | return &Option{elem}, err 90 | default: 91 | return nil, locerr.ErrorfIn(n.Pos(), n.End(), "Unknown type constructor '%s'. Primitive types, aliased types, 'array', 'option' and '_' are supported", n.Ctor.DisplayName) 92 | } 93 | default: 94 | panic("FATAL: Cannot convert non-type AST node into type values: " + node.Name()) 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /sema/scope.go: -------------------------------------------------------------------------------- 1 | package sema 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/ast" 5 | ) 6 | 7 | type scope struct { 8 | parent *scope 9 | vars map[string]*ast.Symbol 10 | } 11 | 12 | func newScope(parent *scope) *scope { 13 | return &scope{ 14 | parent, 15 | map[string]*ast.Symbol{}, 16 | } 17 | } 18 | 19 | func (m *scope) mapSymbol(from string, to *ast.Symbol) { 20 | m.vars[from] = to 21 | } 22 | 23 | func (m *scope) resolve(name string) (*ast.Symbol, bool) { 24 | if mapped, ok := m.vars[name]; ok { 25 | return mapped, true 26 | } 27 | if m.parent == nil { 28 | return nil, false 29 | } 30 | return m.parent.resolve(name) 31 | } 32 | -------------------------------------------------------------------------------- /sema/scope_test.go: -------------------------------------------------------------------------------- 1 | package sema 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/ast" 5 | "testing" 6 | ) 7 | 8 | func TestFindSymbol(t *testing.T) { 9 | s := newScope(nil) 10 | foo := ast.NewSymbol("foo") 11 | foo.Name = "foo1" 12 | s.mapSymbol("foo", foo) 13 | sym, ok := s.resolve("foo") 14 | if !ok { 15 | t.Errorf("symbol for current scope not found") 16 | } 17 | if sym.Name != "foo1" { 18 | t.Errorf("expected foo1 but actually %s", sym.Name) 19 | } 20 | } 21 | 22 | func TestFindNestedSymbol(t *testing.T) { 23 | s := newScope(nil) 24 | foo := ast.NewSymbol("foo") 25 | foo.Name = "foo1" 26 | s.mapSymbol("foo", foo) 27 | s.mapSymbol("bar", ast.NewSymbol("bar")) 28 | 29 | s = newScope(s) 30 | foo2 := ast.NewSymbol("foo") 31 | foo2.Name = "foo2" 32 | s.mapSymbol("foo", foo2) 33 | 34 | sym, ok := s.resolve("foo") 35 | if !ok { 36 | t.Errorf("symbol for current scope not found") 37 | } 38 | if sym.Name != "foo2" { 39 | t.Errorf("expected foo2 but actually %s", sym.Name) 40 | } 41 | 42 | sym, ok = s.resolve("bar") 43 | if !ok { 44 | t.Errorf("symbol for current scope not found") 45 | } 46 | if sym.Name != "bar" { 47 | t.Errorf("expected bar but actually %s", sym.Name) 48 | } 49 | 50 | if sym, ok = s.resolve("piyo"); ok { 51 | t.Errorf("symbol piyo should not be found but actually %v was found", sym) 52 | } 53 | } 54 | -------------------------------------------------------------------------------- /sema/semantics_check.go: -------------------------------------------------------------------------------- 1 | // Package sema provides resolving symbols, type inference and type check for GoCaml. 2 | // Semantic check finally converts given AST into MIR (Mid-level IR). 3 | // This package only provides type operations. To know data structures of types, please see 4 | // https://godoc.org/github.com/rhysd/gocaml/types 5 | package sema 6 | 7 | import ( 8 | "github.com/rhysd/gocaml/ast" 9 | "github.com/rhysd/gocaml/mir" 10 | "github.com/rhysd/gocaml/types" 11 | "github.com/rhysd/locerr" 12 | ) 13 | 14 | func Analyze(parsed *ast.AST) (*types.Env, InferredTypes, error) { 15 | env := types.NewEnv() 16 | 17 | // First, resolve all symbols by alpha transform 18 | if err := AlphaTransform(parsed, env); err != nil { 19 | return nil, nil, locerr.NoteAt(parsed.Root.Pos(), err, "Alpha transform failed") 20 | } 21 | 22 | // Second, run unification on all nodes and dereference type variables 23 | inferer := NewInferer(env) 24 | if err := inferer.Infer(parsed); err != nil { 25 | return nil, nil, locerr.NoteAt(parsed.Root.Pos(), err, "Type inference failed") 26 | } 27 | 28 | return env, inferer.inferred, nil 29 | } 30 | 31 | // SemanticsCheck applies type inference, checks semantics of types and finally converts AST into MIR 32 | // with inferred type information. 33 | func SemanticsCheck(parsed *ast.AST) (*types.Env, *mir.Block, error) { 34 | env := types.NewEnv() 35 | 36 | // First, resolve all symbols by alpha transform 37 | if err := AlphaTransform(parsed, env); err != nil { 38 | return nil, nil, locerr.NoteAt(parsed.Root.Pos(), err, "Alpha transform failed") 39 | } 40 | 41 | // Second, run unification on all nodes and dereference type variables 42 | inferer := NewInferer(env) 43 | if err := inferer.Infer(parsed); err != nil { 44 | return nil, nil, locerr.NoteAt(parsed.Root.Pos(), err, "Type inference failed") 45 | } 46 | 47 | // Third, convert AST into MIR 48 | block := ToMIR(parsed.Root, env, inferer.inferred, inferer.insts) 49 | 50 | return env, block, nil 51 | } 52 | -------------------------------------------------------------------------------- /sema/semantics_check_test.go: -------------------------------------------------------------------------------- 1 | package sema 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/syntax" 5 | "github.com/rhysd/locerr" 6 | "io/ioutil" 7 | "path/filepath" 8 | "strings" 9 | "testing" 10 | ) 11 | 12 | func TestResolvedSymbols(t *testing.T) { 13 | s := locerr.NewDummySource(`external y: int = "c_y"; let x = 1 in x + y; ()`) 14 | ast, err := syntax.Parse(s) 15 | if err != nil { 16 | panic(ast.Root) 17 | } 18 | 19 | env, _, err := SemanticsCheck(ast) 20 | if err != nil { 21 | t.Fatal(err) 22 | } 23 | if _, ok := env.DeclTable["x"]; ok { 24 | t.Error("'x' was resolved as internal symbol:", env.DeclTable) 25 | } 26 | if _, ok := env.Externals["y"]; !ok { 27 | t.Error("'y' was not resolved as external symbol:", env.Externals) 28 | } 29 | } 30 | 31 | func TestTypeCheckMinCamlTests(t *testing.T) { 32 | testdir := filepath.FromSlash("../testdata/from-mincaml/") 33 | files, err := ioutil.ReadDir(testdir) 34 | if err != nil { 35 | panic(err) 36 | } 37 | 38 | for _, f := range files { 39 | n := filepath.Join(testdir, f.Name()) 40 | if !strings.HasSuffix(n, ".ml") { 41 | continue 42 | } 43 | 44 | t.Run("from-mincaml:"+n, func(t *testing.T) { 45 | s, err := locerr.NewSourceFromFile(n) 46 | if err != nil { 47 | panic(err) 48 | } 49 | 50 | ast, err := syntax.Parse(s) 51 | if err != nil { 52 | t.Fatal(err) 53 | } 54 | 55 | _, _, err = SemanticsCheck(ast) 56 | if err != nil { 57 | t.Fatal(err) 58 | } 59 | }) 60 | } 61 | } 62 | 63 | func TestSemanticsCheckFail(t *testing.T) { 64 | cases := map[string]string{ 65 | "alpha transform": "let rec f a a = a in f 42 42; ()", 66 | "type mismatch": "3.14 + 10", 67 | "invalid root expression": "42", 68 | "dereference failure": "None", 69 | } 70 | for what, code := range cases { 71 | t.Run(what, func(t *testing.T) { 72 | s := locerr.NewDummySource(code) 73 | parsed, err := syntax.Parse(s) 74 | if err != nil { 75 | panic(err) 76 | } 77 | _, _, err = SemanticsCheck(parsed) 78 | if err == nil { 79 | t.Fatal("Semantics should fail with:", code) 80 | } 81 | }) 82 | } 83 | } 84 | -------------------------------------------------------------------------------- /sema/testdata/array.ml: -------------------------------------------------------------------------------- 1 | let a: bool array = Array.make 3 true in 2 | let b: (int * int) array = Array.make 3 (1, 1) in 3 | let c: int array array = Array.make 3 (Array.make 3 1) in 4 | let d: bool = a.(0) in 5 | let e: unit = a.(0) <- false in 6 | () 7 | -------------------------------------------------------------------------------- /sema/testdata/array_lit.ml: -------------------------------------------------------------------------------- 1 | let a = [| 1; 2; 3 |] in 2 | let b = [| [|1|]; [| |]; |] in 3 | let c = [| |] in 4 | c.(0) <- a.(0); 5 | let a = [| |] in 6 | println_int a.(0) 7 | -------------------------------------------------------------------------------- /sema/testdata/binop.ml: -------------------------------------------------------------------------------- 1 | let v: int = 1 * 2 in 2 | let x: int = 1 + 2 in 3 | let y: float = 1.0 *. 3.0 in 4 | let z: float = 1.0 /. 3.0 in 5 | let w: bool = 2 < 3 in 6 | let p: bool = true <> false in 7 | () 8 | -------------------------------------------------------------------------------- /sema/testdata/external_func.ml: -------------------------------------------------------------------------------- 1 | external print: int -> string -> unit = "print"; 2 | external print2: int -> unit = "print2"; 3 | let a = print 42 "hello" in 4 | let f = print in f 42 "foo"; 5 | let g = print2 in g 10; 6 | () 7 | -------------------------------------------------------------------------------- /sema/testdata/external_val.ml: -------------------------------------------------------------------------------- 1 | external x: int = "c_x"; 2 | external y: int = "c_y"; 3 | let i = x + y in 4 | let j = x in 5 | let k = y in 6 | println_int (i + j + k) 7 | -------------------------------------------------------------------------------- /sema/testdata/fun.ml: -------------------------------------------------------------------------------- 1 | let rec foo x y = x + y in 2 | let bar: int -> int -> int = foo in 3 | let piyo: bool -> int -> int * bool = fun x y -> (y, x) in 4 | () 5 | -------------------------------------------------------------------------------- /sema/testdata/if.ml: -------------------------------------------------------------------------------- 1 | let foo: int = if true then 21 else 10 in 2 | () 3 | -------------------------------------------------------------------------------- /sema/testdata/match.ml: -------------------------------------------------------------------------------- 1 | let s: string = match Some 42 with 2 | | Some i -> let j: int = i in "ok" 3 | | None -> "not ok" 4 | in () 5 | -------------------------------------------------------------------------------- /sema/testdata/option.ml: -------------------------------------------------------------------------------- 1 | let o: int option = Some 42 in 2 | let o2: (int * unit) array option = None in 3 | let rec f x = () in f (Some 42); f None; let a = None in f a; 4 | () 5 | -------------------------------------------------------------------------------- /sema/testdata/primitives.ml: -------------------------------------------------------------------------------- 1 | let i: int = 42 in 2 | let b: bool = true in 3 | let f: float = 3.14 in 4 | let s: string = "hello" in 5 | () 6 | -------------------------------------------------------------------------------- /sema/testdata/tuple.ml: -------------------------------------------------------------------------------- 1 | let t: int * bool = 42, true in 2 | let (i, b): int * bool = t in 3 | let j: int = i in 4 | let c: bool = b in 5 | () 6 | -------------------------------------------------------------------------------- /sema/testdata/type_annotation.ml: -------------------------------------------------------------------------------- 1 | let i: _ = 42 in 2 | let j: _ = "foo" in 3 | let k: _ array = Array.make 3 true in 4 | let l: _ array = Array.make 3 3.14 in 5 | let m: _ option = Some 42 in 6 | let n: _ * int = true, 42 in 7 | let (o, p): float * _ = 3.14, 42 in 8 | let q: _ -> _ -> _ = fun x y -> x + y in 9 | () 10 | -------------------------------------------------------------------------------- /sema/testdata/type_annotation_expr.ml: -------------------------------------------------------------------------------- 1 | let f = fun x y -> (x: int), (y: bool) in 2 | let g = (f: int -> bool -> int * bool) in 3 | let (a, b) = g 1 true in 4 | println_int (a: int); 5 | println_bool (b: bool) 6 | -------------------------------------------------------------------------------- /sema/testdata/type_annotation_fun.ml: -------------------------------------------------------------------------------- 1 | let rec a (x:int) = x in 2 | let rec b x: int = x in 3 | let c = fun (x:int) -> x in 4 | let d = fun x: int -> x in 5 | let e = fun (x:_ option) -> match x with Some(i) -> -i | None -> 0 in 6 | () 7 | -------------------------------------------------------------------------------- /sema/testdata/type_decl.ml: -------------------------------------------------------------------------------- 1 | type foo = int; 2 | type bar = foo array; 3 | type piyo = foo option; 4 | type foo = float; 5 | let b:bar = [| 1; 2 |] in 6 | let p:piyo = Some 3 in 7 | let rec f (p:piyo) = p in 8 | f (Some 3); 9 | let rec f x: foo = x in 10 | f 3.1; 11 | let foo: foo = (1.41: foo) in 12 | let rec foo x: foo = x in 13 | () 14 | -------------------------------------------------------------------------------- /sema/testdata/unary.ml: -------------------------------------------------------------------------------- 1 | let f: float = -.3.14 in 2 | let i: int = -42 in 3 | let b: bool = not true in 4 | () 5 | -------------------------------------------------------------------------------- /sema/testdata/underscore.ml: -------------------------------------------------------------------------------- 1 | let _ = 42 in 2 | let (_, _, _) = 1, 2, 3 in 3 | let rec _ _ = () in 4 | let rec f _ = 42 in 5 | f true; 6 | let g = fun _ -> () in 7 | g 3.14 8 | -------------------------------------------------------------------------------- /sema/unify.go: -------------------------------------------------------------------------------- 1 | package sema 2 | 3 | import ( 4 | "github.com/rhysd/gocaml/common" 5 | . "github.com/rhysd/gocaml/types" 6 | "github.com/rhysd/locerr" 7 | ) 8 | 9 | // Check cyclic dependency. When unifying t and u where t is type variable and 10 | // u is a type which contains t, it results in infinite-length type. 11 | // It should be reported as semantic error. 12 | func occur(v *Var, rhs Type) bool { 13 | switch t := rhs.(type) { 14 | case *Tuple: 15 | for _, e := range t.Elems { 16 | if occur(v, e) { 17 | return true 18 | } 19 | } 20 | case *Array: 21 | return occur(v, t.Elem) 22 | case *Option: 23 | return occur(v, t.Elem) 24 | case *Fun: 25 | if occur(v, t.Ret) { 26 | return true 27 | } 28 | for _, p := range t.Params { 29 | if occur(v, p) { 30 | return true 31 | } 32 | } 33 | case *Var: 34 | if t.Ref != nil { 35 | return occur(v, t.Ref) 36 | } 37 | if t.IsGeneric() { 38 | panic("FATAL: Generic type variable must not appear in occur check") 39 | } 40 | if v == t { 41 | return true 42 | } 43 | if t.Level > v.Level { 44 | // Adjust levels 45 | t.Level = v.Level 46 | } 47 | } 48 | return false 49 | } 50 | 51 | func unifyTuple(left, right *Tuple) *locerr.Error { 52 | length := len(left.Elems) 53 | if length != len(right.Elems) { 54 | return locerr.Errorf("Number of elements of tuple does not match: %d vs %d (between '%s' and '%s')", length, len(right.Elems), left.String(), right.String()) 55 | } 56 | 57 | for i := 0; i < length; i++ { 58 | l := left.Elems[i] 59 | r := right.Elems[i] 60 | if err := Unify(l, r); err != nil { 61 | return locerr.Notef(err, "On unifying tuples' %s elements of '%s' and '%s'", common.Ordinal(i+1), left.String(), right.String()) 62 | } 63 | } 64 | 65 | return nil 66 | } 67 | 68 | func unifyFun(left, right *Fun) *locerr.Error { 69 | if err := Unify(left.Ret, right.Ret); err != nil { 70 | return locerr.Notef(err, "On unifying functions' return types of '%s' and '%s'", left.String(), right.String()) 71 | } 72 | 73 | if len(left.Params) != len(right.Params) { 74 | return locerr.Errorf("Number of parameters of function does not match: %d vs %d (between '%s' and '%s')", len(left.Params), len(right.Params), left.String(), right.String()) 75 | } 76 | 77 | for i, l := range left.Params { 78 | r := right.Params[i] 79 | if err := Unify(l, r); err != nil { 80 | return locerr.Notef(err, "On unifying %s parameter of function '%s' and '%s'", common.Ordinal(i+1), left.String(), right.String()) 81 | } 82 | } 83 | 84 | return nil 85 | } 86 | 87 | func assignVar(v *Var, t Type) *locerr.Error { 88 | // When rv.Ref == nil 89 | if occur(v, t) { 90 | return locerr.Errorf("Cannot resolve free type variable. Cyclic dependency found for free type variable '%s' while unification with '%s'", v.String(), t.String()) 91 | } 92 | 93 | // Note: 94 | // 'v' may be generic type variable because of external symbols. 95 | // e.g. 96 | // let _ = x in x + x 97 | // The `x` is an external symbol and typed as ?. And it is bound to `_` in `let` expression. 98 | // The `_` is typed as 'a so the type of `x` will be 'a. 99 | // In `x + x`, type of `x` is unified although its type is generic. 100 | 101 | v.Ref = t 102 | return nil 103 | } 104 | 105 | func Unify(left, right Type) *locerr.Error { 106 | switch l := left.(type) { 107 | case *Unit, *Bool, *Int, *Float, *String: 108 | // Types for Unit, Bool, Int, Float and String are singleton instance. 109 | // So comparing directly is OK. 110 | if l == right { 111 | return nil 112 | } 113 | case *Tuple: 114 | if r, ok := right.(*Tuple); ok { 115 | return unifyTuple(l, r) 116 | } 117 | case *Array: 118 | if r, ok := right.(*Array); ok { 119 | return Unify(l.Elem, r.Elem) 120 | } 121 | case *Option: 122 | if r, ok := right.(*Option); ok { 123 | return Unify(l.Elem, r.Elem) 124 | } 125 | case *Fun: 126 | if r, ok := right.(*Fun); ok { 127 | return unifyFun(l, r) 128 | } 129 | } 130 | 131 | lv, lok := left.(*Var) 132 | rv, rok := right.(*Var) 133 | 134 | // Order of below 'if' statements is important! (#15) 135 | 136 | if (lok && rok) && (lv == rv) { 137 | return nil 138 | } 139 | if lok && lv.Ref != nil { 140 | return Unify(lv.Ref, right) 141 | } 142 | if rok && rv.Ref != nil { 143 | return Unify(left, rv.Ref) 144 | } 145 | if lok { 146 | // When lv.Ref == nil 147 | return assignVar(lv, right) 148 | } 149 | if rok { 150 | // When rv.Ref == nil 151 | return assignVar(rv, left) 152 | } 153 | 154 | return locerr.Errorf("Cannot unify types. Type mismatch between '%s' and '%s'", left.String(), right.String()) 155 | } 156 | -------------------------------------------------------------------------------- /syntax/example_test.go: -------------------------------------------------------------------------------- 1 | package syntax 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/token" 6 | "github.com/rhysd/locerr" 7 | "path/filepath" 8 | ) 9 | 10 | func ExampleLexer_Lex() { 11 | file := filepath.FromSlash("../testdata/from-mincaml/ack.ml") 12 | src, err := locerr.NewSourceFromFile(file) 13 | if err != nil { 14 | // File not found 15 | panic(err) 16 | } 17 | 18 | lex := NewLexer(src) 19 | 20 | // Start to lex the source in other goroutine 21 | go lex.Lex() 22 | 23 | // tokens will be sent from lex.Tokens channel 24 | for { 25 | select { 26 | case tok := <-lex.Tokens: 27 | switch tok.Kind { 28 | case token.ILLEGAL: 29 | fmt.Printf("Lexing invalid token at %v\n", tok.Start) 30 | return 31 | case token.EOF: 32 | fmt.Println("End of input") 33 | return 34 | default: 35 | fmt.Printf("Token: %s", tok.String()) 36 | } 37 | } 38 | } 39 | } 40 | 41 | func ExampleParse() { 42 | file := filepath.FromSlash("../testdata/from-mincaml/ack.ml") 43 | src, err := locerr.NewSourceFromFile(file) 44 | if err != nil { 45 | // File not found 46 | panic(err) 47 | } 48 | 49 | // Create lexer instance for the source 50 | lex := NewLexer(src) 51 | go lex.Lex() 52 | 53 | // ParseTokens() takes channel of token which is usually given from lexer 54 | // And returns the root of AST. 55 | tree, err := ParseTokens(lex.Tokens) 56 | if err != nil { 57 | // When parse failed 58 | panic(err) 59 | } 60 | 61 | fmt.Printf("AST: %v\n", tree) 62 | 63 | // If you want to parse a source code into AST directly, simply call Parse() function. 64 | tree, err = Parse(src) 65 | if err != nil { 66 | // When lexing or parsing failed 67 | panic(err) 68 | } 69 | 70 | fmt.Printf("AST: %v\n", tree) 71 | } 72 | -------------------------------------------------------------------------------- /syntax/lexer_test.go: -------------------------------------------------------------------------------- 1 | package syntax 2 | 3 | import ( 4 | "fmt" 5 | "github.com/rhysd/gocaml/token" 6 | "github.com/rhysd/locerr" 7 | "io/ioutil" 8 | "path/filepath" 9 | "strings" 10 | "testing" 11 | ) 12 | 13 | func TestLexingOK(t *testing.T) { 14 | for _, testdir := range []string{ 15 | "testdata", 16 | "../testdata/from-mincaml/", 17 | } { 18 | files, err := ioutil.ReadDir(filepath.FromSlash(testdir)) 19 | if err != nil { 20 | panic(err) 21 | } 22 | 23 | for _, f := range files { 24 | n := filepath.Join(testdir, f.Name()) 25 | if !strings.HasSuffix(n, ".ml") { 26 | continue 27 | } 28 | 29 | t.Run(fmt.Sprintf("Check lexing successfully: %s", n), func(t *testing.T) { 30 | s, err := locerr.NewSourceFromFile(n) 31 | if err != nil { 32 | panic(err) 33 | } 34 | l := NewLexer(s) 35 | go l.Lex() 36 | for { 37 | select { 38 | case tok := <-l.Tokens: 39 | switch tok.Kind { 40 | case token.ILLEGAL: 41 | t.Fatal(tok.String()) 42 | case token.EOF: 43 | return 44 | } 45 | } 46 | } 47 | }) 48 | } 49 | } 50 | } 51 | 52 | // List literal can be lexed but parser should complain that it is not implemented yet. 53 | // This behavior is implemented because array literal ressembles to list literal. 54 | func TestLexingListLiteral(t *testing.T) { 55 | s := locerr.NewDummySource("[1; 2; 3]") 56 | l := NewLexer(s) 57 | go l.Lex() 58 | lexing: 59 | for { 60 | select { 61 | case tok := <-l.Tokens: 62 | switch tok.Kind { 63 | case token.ILLEGAL: 64 | t.Fatal(tok.String()) 65 | case token.EOF: 66 | break lexing 67 | } 68 | } 69 | } 70 | } 71 | 72 | func TestLexingIllegal(t *testing.T) { 73 | testdir := filepath.FromSlash("testdata/lexer/invalid") 74 | files, err := ioutil.ReadDir(testdir) 75 | if err != nil { 76 | panic(err) 77 | } 78 | 79 | for _, f := range files { 80 | n := filepath.Join(testdir, f.Name()) 81 | if !strings.HasSuffix(n, ".ml") { 82 | continue 83 | } 84 | 85 | t.Run(fmt.Sprintf("Check lexing illegal input: %s", f.Name()), func(t *testing.T) { 86 | s, err := locerr.NewSourceFromFile(n) 87 | if err != nil { 88 | panic(err) 89 | } 90 | errorOccurred := false 91 | l := NewLexer(s) 92 | l.Error = func(_ string, _ locerr.Pos) { 93 | errorOccurred = true 94 | } 95 | go l.Lex() 96 | for { 97 | select { 98 | case tok := <-l.Tokens: 99 | switch tok.Kind { 100 | case token.ILLEGAL: 101 | if !errorOccurred { 102 | t.Fatalf("Illegal token was emitted but no error occurred") 103 | } 104 | return 105 | case token.EOF: 106 | t.Fatalf("Lexing successfully done unexpectedly") 107 | return 108 | } 109 | } 110 | } 111 | }) 112 | } 113 | } 114 | -------------------------------------------------------------------------------- /syntax/parser.go: -------------------------------------------------------------------------------- 1 | // Package syntax provides lexing and parsing from GoCaml source code into abstract syntax tree. 2 | package syntax 3 | 4 | import ( 5 | "github.com/rhysd/gocaml/ast" 6 | "github.com/rhysd/gocaml/token" 7 | "github.com/rhysd/locerr" 8 | ) 9 | 10 | type pseudoLexer struct { 11 | lastToken *token.Token 12 | tokens chan token.Token 13 | err *locerr.Error 14 | result *ast.AST 15 | } 16 | 17 | func (l *pseudoLexer) Lex(lval *yySymType) int { 18 | for { 19 | select { 20 | case t := <-l.tokens: 21 | lval.token = &t 22 | 23 | switch t.Kind { 24 | case token.EOF, token.ILLEGAL: 25 | // Zero means input ends 26 | // (see golang.org/x/tools/cmd/goyacc/testdata/expr/expr.y) 27 | return 0 28 | case token.COMMENT: 29 | continue 30 | } 31 | 32 | l.lastToken = &t 33 | 34 | // XXX: 35 | // Converting token value into yacc's token. 36 | // This conversion requires that token order must the same as 37 | // yacc's token order. EOF is a first token. So we can use it 38 | // to make an offset between token value and yacc's token value. 39 | return int(t.Kind) + ILLEGAL 40 | } 41 | } 42 | } 43 | 44 | // Interface yyLexer requires this method. 45 | func (l *pseudoLexer) Error(msg string) { 46 | if l.err == nil { 47 | if l.lastToken != nil { 48 | l.err = locerr.ErrorAt(l.lastToken.Start, msg) 49 | } else { 50 | l.err = locerr.NewError(msg) 51 | } 52 | } else { 53 | if l.lastToken != nil { 54 | l.err = l.err.NoteAt(l.lastToken.Start, msg) 55 | } else { 56 | l.err = l.err.Note(msg) 57 | } 58 | } 59 | } 60 | 61 | func Parse(src *locerr.Source) (*ast.AST, error) { 62 | var lexErr *locerr.Error 63 | l := NewLexer(src) 64 | l.Error = func(msg string, pos locerr.Pos) { 65 | if lexErr == nil { 66 | lexErr = locerr.ErrorAt(pos, msg) 67 | } else { 68 | lexErr = lexErr.NoteAt(pos, msg) 69 | } 70 | } 71 | go l.Lex() 72 | parsed, err := ParseTokens(l.Tokens) 73 | if lexErr != nil { 74 | return nil, lexErr.Note("Lexing source into tokens failed") 75 | } 76 | if err != nil { 77 | return nil, err 78 | } 79 | return parsed, nil 80 | } 81 | 82 | // ParseTokens parses given tokens and returns parsed AST. 83 | // Tokens are passed via channel. 84 | func ParseTokens(tokens chan token.Token) (*ast.AST, error) { 85 | yyErrorVerbose = true 86 | 87 | l := &pseudoLexer{tokens: tokens} 88 | ret := yyParse(l) 89 | 90 | if l.err != nil { 91 | l.Error("Error while parsing") 92 | return nil, l.err 93 | } 94 | 95 | root := l.result 96 | if ret != 0 || root == nil { 97 | panic("FATAL: Parse failed for unknown reason") 98 | } 99 | 100 | return root, nil 101 | } 102 | -------------------------------------------------------------------------------- /syntax/testdata/array.ml: -------------------------------------------------------------------------------- 1 | let a = Array.make 3 true in 2 | let b = Array.length a in 3 | () 4 | -------------------------------------------------------------------------------- /syntax/testdata/array_lit.ml: -------------------------------------------------------------------------------- 1 | let a = [| 1; 2; 3; 4 |] in 2 | let b = [| true; false; |] in 3 | let c = [| |] in 4 | () 5 | -------------------------------------------------------------------------------- /syntax/testdata/binop.ml: -------------------------------------------------------------------------------- 1 | let v = 1 * 2 in 2 | let x = 1 + 2 in 3 | let y = 1.0 *. 3.0 in 4 | let z = 1.0 /. 3.0 in 5 | let w = 2 < 3 in 6 | let p = 3 / 2 in 7 | let q = 3 % 2 in 8 | let r = 3 > 2 in 9 | (v, x, y, z, w, p, q) 10 | -------------------------------------------------------------------------------- /syntax/testdata/constant.ml: -------------------------------------------------------------------------------- 1 | 42 2 | -------------------------------------------------------------------------------- /syntax/testdata/external.ml: -------------------------------------------------------------------------------- 1 | external foo: int = "c_foo"; 2 | type myint = int; 3 | external cfun: int -> int -> int = "cfun"; 4 | () 5 | -------------------------------------------------------------------------------- /syntax/testdata/external_func_unknown_ret_type.ml: -------------------------------------------------------------------------------- 1 | (* Return type of print_int cannot be inferred because print_int 2 | * is an external symbol. In this case, I decided to assign unit 3 | * to the return type. 4 | * In this case, ; will create $tmp = print_int 42 and type of 5 | * $tmp won't be inferred. So falling back into unit type. *) 6 | print_int 42; () 7 | -------------------------------------------------------------------------------- /syntax/testdata/float.ml: -------------------------------------------------------------------------------- 1 | 3.14e+3 2 | -------------------------------------------------------------------------------- /syntax/testdata/fun_type_annotate.ml: -------------------------------------------------------------------------------- 1 | let rec a (x:int) y = x + y in 2 | let rec b (x:int) (y:int): int = x + y in 3 | let rec c x y: int = x + y in 4 | let d = fun (x:int) y -> x + y in 5 | let e = fun (x:int) (y:int): int -> x + y in 6 | let f = fun x y: int -> x + y in 7 | let g = fun _: (int -> int -> int) -> f in 8 | () 9 | -------------------------------------------------------------------------------- /syntax/testdata/get.ml: -------------------------------------------------------------------------------- 1 | let 2 | a = Array.make 1 2 3 | in 4 | print a.(0) 5 | -------------------------------------------------------------------------------- /syntax/testdata/ident.ml: -------------------------------------------------------------------------------- 1 | let 2 | (blah, make, create) = (1, 2, 3) 3 | in 4 | blah make craete 5 | -------------------------------------------------------------------------------- /syntax/testdata/if.ml: -------------------------------------------------------------------------------- 1 | if true then 42 else 0 2 | -------------------------------------------------------------------------------- /syntax/testdata/lambda.ml: -------------------------------------------------------------------------------- 1 | let foo = fun x y -> x + y in 2 | let rec print f a b = println_int(f a b) in 3 | print(foo, 10, 42); 4 | print(fun x y -> x - y, 10, 42) 5 | -------------------------------------------------------------------------------- /syntax/testdata/let.ml: -------------------------------------------------------------------------------- 1 | let x = 42 in x 2 | -------------------------------------------------------------------------------- /syntax/testdata/let_rec.ml: -------------------------------------------------------------------------------- 1 | let rec f y z = x + y in f 1 2 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/array.ml: -------------------------------------------------------------------------------- 1 | Array.foo 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/array2.ml: -------------------------------------------------------------------------------- 1 | Array+ 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/array3.ml: -------------------------------------------------------------------------------- 1 | Array.\ 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/float.ml: -------------------------------------------------------------------------------- 1 | 3.14e+foo 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/ident.ml: -------------------------------------------------------------------------------- 1 | \ 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/invalid_utf8.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rhysd/gocaml/535c093eec557e7b2356b21181cc31cbbc174aff/syntax/testdata/lexer/invalid/invalid_utf8.ml -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/logical_and.ml: -------------------------------------------------------------------------------- 1 | true & false 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/unclosed_comment.ml: -------------------------------------------------------------------------------- 1 | (* this comment is not closed 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/unclosed_comment2.ml: -------------------------------------------------------------------------------- 1 | (* this comment is just closing... * 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/unclosed_string.ml: -------------------------------------------------------------------------------- 1 | " this 2 | strin literal is 3 | not closed\" ;() 4 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/unknown_char.ml: -------------------------------------------------------------------------------- 1 | # 2 | -------------------------------------------------------------------------------- /syntax/testdata/lexer/invalid/utf8.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rhysd/gocaml/535c093eec557e7b2356b21181cc31cbbc174aff/syntax/testdata/lexer/invalid/utf8.ml -------------------------------------------------------------------------------- /syntax/testdata/logicop.ml: -------------------------------------------------------------------------------- 1 | let b1 = true && false in 2 | let a = true in 3 | let b = false in 4 | let b2 = a || b in 5 | (b1, b2) 6 | -------------------------------------------------------------------------------- /syntax/testdata/match.ml: -------------------------------------------------------------------------------- 1 | match Some 42 with 2 | | Some i -> "ok" 3 | | None -> "not ok"; 4 | let s = match None with None -> "none" | Some i -> "some" in 5 | match Some (Some s) with 6 | None -> Some 10 7 | | Some o -> Some 99; 8 | match Some 42 with 9 | | Some(i) -> "ok" 10 | | None -> "not ok"; 11 | let s = match None with None -> "none" | Some(i) -> "some" in 12 | () 13 | -------------------------------------------------------------------------------- /syntax/testdata/none_keyword.ml: -------------------------------------------------------------------------------- 1 | let rec f o = o in 2 | f None; 3 | f (Some 42); 4 | () 5 | -------------------------------------------------------------------------------- /syntax/testdata/option.ml: -------------------------------------------------------------------------------- 1 | let o = Some 42 in 2 | let i = match o with 3 | | Some i -> i 4 | | None -> 0 5 | in print_int i; 6 | let o = Some (Some 42) in 7 | match o with 8 | | Some i -> i 9 | | None -> 0; 10 | let o = None in 11 | match o with 12 | | Some i -> i 13 | | None -> 0; 14 | () 15 | -------------------------------------------------------------------------------- /syntax/testdata/print.ml: -------------------------------------------------------------------------------- 1 | print 42 2 | -------------------------------------------------------------------------------- /syntax/testdata/put.ml: -------------------------------------------------------------------------------- 1 | let 2 | a = Array.make 1 2 3 | in 4 | a.(0) <- 42 5 | -------------------------------------------------------------------------------- /syntax/testdata/relational.ml: -------------------------------------------------------------------------------- 1 | let 2 | (a, b, c, d) = ( 3 | 1 < 2, 4 | 1 > 2, 5 | 1 <= 2, 6 | 1 >= 2 7 | ) 8 | in 9 | a = b <> c = d 10 | -------------------------------------------------------------------------------- /syntax/testdata/strings.ml: -------------------------------------------------------------------------------- 1 | "this is string literal"; 2 | "\tcontains\tsome escape\n"; 3 | "\\ <- back slash"; 4 | "\"\\tcontains\\tsome escape\\n\""; 5 | () 6 | -------------------------------------------------------------------------------- /syntax/testdata/tuple.ml: -------------------------------------------------------------------------------- 1 | let (x, y) = (1, 2) in x + y 2 | -------------------------------------------------------------------------------- /syntax/testdata/type_annotation.ml: -------------------------------------------------------------------------------- 1 | let x: int = (42: int) in 2 | let u: unit = () in 3 | let y: int array = Array.make 1 1 in 4 | let t: int * bool = 42, true in 5 | let o: int option = Some(42) in 6 | let f: int -> bool = fun x -> x <> 1 in 7 | let (a, b): int * bool = 10, false in 8 | let g: int -> bool -> int * bool = (fun i b -> (i, b): int -> bool -> int * bool) in 9 | let h = fun a b -> (a: int), (b: bool) in 10 | let i = fun a b -> (a, b: int * bool) in 11 | () 12 | -------------------------------------------------------------------------------- /syntax/testdata/type_decl.ml: -------------------------------------------------------------------------------- 1 | type foo = int; 2 | type bar = int * int; 3 | type piyo = (int -> bool) option array; 4 | () 5 | -------------------------------------------------------------------------------- /syntax/testdata/unary_op.ml: -------------------------------------------------------------------------------- 1 | let x = not true in 2 | let y = -42 in 3 | print_int (y = x < 0) 4 | -------------------------------------------------------------------------------- /testdata/from-mincaml/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2005-2008, Eijiro Sumii, Moe Masuko, and Kenichi Asai 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are 6 | met: 7 | 8 | - Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | - Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the 14 | distribution. 15 | 16 | - Neither the name of Information-Technology Promotion Agency, the 17 | name of University of Pennsylvania, the name of University of 18 | Tokyo, the name of Tohoku University, the name of Ochanomizu 19 | University, the name of Eijiro Sumii, the name of Moe Masuko, nor 20 | the name of Kenichi Asai may be used to endorse or promote products 21 | derived from this software without specific prior written 22 | permission. 23 | 24 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 27 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 28 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 29 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 30 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 31 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 32 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 33 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 34 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 35 | -------------------------------------------------------------------------------- /testdata/from-mincaml/README.md: -------------------------------------------------------------------------------- 1 | Files in this directory were from [official min-caml repository](https://github.com/esumii/min-caml). 2 | 3 | These are licensed under [BSD 3-Caluse license](./LICENSE). 4 | 5 | > Copyright (c) 2005-2008, Eijiro Sumii, Moe Masuko, and Kenichi Asai 6 | > All rights reserved. 7 | -------------------------------------------------------------------------------- /testdata/from-mincaml/ack.ml: -------------------------------------------------------------------------------- 1 | let rec ack x y = 2 | if x <= 0 then y + 1 else 3 | if y <= 0 then ack (x - 1) 1 else 4 | ack (x - 1) (ack x (y - 1)) in 5 | print_int (ack 3 10) 6 | -------------------------------------------------------------------------------- /testdata/from-mincaml/adder.ml: -------------------------------------------------------------------------------- 1 | let rec make_adder x = 2 | let rec adder y = x + y in 3 | adder in 4 | print_int ((make_adder 3) 7) 5 | -------------------------------------------------------------------------------- /testdata/from-mincaml/cls-bug.ml: -------------------------------------------------------------------------------- 1 | (* 「素朴」なknown function optimizationでは駄目な場合 *) 2 | (* Cf. http://www.yl.is.s.u-tokyo.ac.jp/~sumii/pub/compiler-enshu-2002/Mail/8 *) 3 | let rec f x = x + 123 in 4 | let rec g y = f in 5 | print_int ((g 456) 789) 6 | -------------------------------------------------------------------------------- /testdata/from-mincaml/cls-bug2.ml: -------------------------------------------------------------------------------- 1 | (* thanks to http://ameblo.jp/nuevo-namasute/entry-10006785787.html 2 | and http://blog.livedoor.jp/azounoman/archives/50232574.html *) 3 | let rec f n = 4 | if n < 0 then () else 5 | (print_int n; 6 | let a = Array.make 1 f in 7 | a.(0) (n - 1)) in 8 | f 9 9 | -------------------------------------------------------------------------------- /testdata/from-mincaml/cls-rec.ml: -------------------------------------------------------------------------------- 1 | (* 自由変数のある再帰関数 *) 2 | let x = 10 in 3 | let rec f y = 4 | if y = 0 then 0 else 5 | x + f (y - 1) in 6 | print_int (f 123) 7 | -------------------------------------------------------------------------------- /testdata/from-mincaml/cls-reg-bug.ml: -------------------------------------------------------------------------------- 1 | (* thanks to autotaker: https://github.com/esumii/min-caml/pull/2 *) 2 | external print_newline: unit -> unit = "print_newline"; 3 | let rec h p = 4 | let (v1,v2,v3,v4,v5,v6,v7,v8,v9,v10) = p in 5 | let rec g z = 6 | let r = v1 + v2 + v3 + v4 + v5 + v6 + v7 + v8 + v9 + v10 in 7 | if z > 0 then r else g (-z) in 8 | g 1 in 9 | print_int (h (1,2,3,4,5,6,7,8,9,10)); 10 | print_newline () 11 | -------------------------------------------------------------------------------- /testdata/from-mincaml/even-odd.ml: -------------------------------------------------------------------------------- 1 | let t = 123 in 2 | let f = 456 in 3 | let rec even x = 4 | let rec odd x = 5 | if x > 0 then even (x - 1) else 6 | if x < 0 then even (x + 1) else 7 | f in 8 | if x > 0 then odd (x - 1) else 9 | if x < 0 then odd (x + 1) else 10 | t in 11 | print_int (even 789) 12 | -------------------------------------------------------------------------------- /testdata/from-mincaml/fib.ml: -------------------------------------------------------------------------------- 1 | let rec fib n = 2 | if n <= 1 then n else 3 | fib (n - 1) + fib (n - 2) in 4 | print_int (fib 30) 5 | -------------------------------------------------------------------------------- /testdata/from-mincaml/float.ml: -------------------------------------------------------------------------------- 1 | (* このテストを実行する場合は、Main.file等を呼び出す前に 2 | Typing.extenvを:=等で書き換えて、あらかじめsinやcosなど 3 | 外部関数の型を陽に指定する必要があります（そうしないと 4 | MinCamlでは勝手にint -> intと推論されるため）。 *) 5 | external abs_float: float -> float = "abs_float"; 6 | external sqrt: float -> float = "f_sqrt"; 7 | external sin: float -> float = "f_sin"; 8 | external cos: float -> float = "f_cos"; 9 | print_int 10 | (float_to_int 11 | (((sin ((cos ((sqrt ((abs_float (-.12.3)) +. 0.0)) +. 0.0)) +. 0.0) 12 | +. 4.5 -. 6.7 *. 8.9 /. 1.23456789) +. 0.0) 13 | *. int_to_float 1000000)) 14 | -------------------------------------------------------------------------------- /testdata/from-mincaml/funcomp.ml: -------------------------------------------------------------------------------- 1 | let rec compose f g = 2 | let rec composed x = g (f x) in 3 | composed in 4 | let rec dbl x = x + x in 5 | let rec inc x = x + 1 in 6 | let rec dec x = x - 1 in 7 | let h = compose inc (compose dbl dec) in 8 | print_int (h 123) 9 | -------------------------------------------------------------------------------- /testdata/from-mincaml/gcd.ml: -------------------------------------------------------------------------------- 1 | let rec gcd m n = 2 | if m = 0 then n else 3 | if m <= n then gcd m (n - m) else 4 | gcd n (m - n) in 5 | print_int (gcd 21600 337500) 6 | -------------------------------------------------------------------------------- /testdata/from-mincaml/inprod-loop.ml: -------------------------------------------------------------------------------- 1 | external truncate: float -> int = "truncate"; 2 | let rec inprod v1 v2 acc i = 3 | if i < 0 then acc else 4 | inprod v1 v2 (acc +. v1.(i) *. v2.(i)) (i - 1) in 5 | let v1 = Array.make 3 1.23 in 6 | let v2 = Array.make 3 4.56 in 7 | print_int (truncate (1000000. *. inprod v1 v2 0. 2)) 8 | -------------------------------------------------------------------------------- /testdata/from-mincaml/inprod-rec.ml: -------------------------------------------------------------------------------- 1 | external truncate: float -> int = "truncate"; 2 | let rec inprod v1 v2 i = 3 | if i < 0 then 0.0 else 4 | v1.(i) *. v2.(i) +. inprod v1 v2 (i - 1) in 5 | let v1 = Array.make 3 1.23 in 6 | let v2 = Array.make 3 4.56 in 7 | print_int (truncate (1000000. *. inprod v1 v2 2)) 8 | -------------------------------------------------------------------------------- /testdata/from-mincaml/inprod.ml: -------------------------------------------------------------------------------- 1 | external truncate: float -> int = "truncate"; 2 | let rec getx v = (let (x, y, z) = v in x) in 3 | let rec gety v = (let (x, y, z) = v in y) in 4 | let rec getz v = (let (x, y, z) = v in z) in 5 | let rec inprod v1 v2 = 6 | getx v1 *. getx v2 +. gety v1 *. gety v2 +. getz v1 *. getz v2 in 7 | print_int (truncate (1000000. *. inprod (1., 2., 3.) (4., 5., 6.))) 8 | -------------------------------------------------------------------------------- /testdata/from-mincaml/join-reg.ml: -------------------------------------------------------------------------------- 1 | let rec f _ = 123 in 2 | let rec g _ = 456 in 3 | let rec h _ = 789 in 4 | 5 | let x = f () in 6 | let y = g () in 7 | print_int ((if h () = 0 then x - y else y - x) + x + y) 8 | (* then節ではxがr0でyがr1に、else節ではyがr0でxがr1にある *) 9 | -------------------------------------------------------------------------------- /testdata/from-mincaml/join-reg2.ml: -------------------------------------------------------------------------------- 1 | let rec f _ = 123 in 2 | let rec g _ = 456 in 3 | let rec h _ = 789 in 4 | 5 | let x = f () in 6 | print_int ((if x <= 0 then g () + x else h () - x) + x) 7 | (* then節でもelse節でもxがr1にある *) 8 | (* ただし、if文の前ではxはr0にある *) 9 | -------------------------------------------------------------------------------- /testdata/from-mincaml/join-stack.ml: -------------------------------------------------------------------------------- 1 | let rec f _ = 123 in 2 | let rec g _ = 456 in 3 | let rec h _ = 789 in 4 | 5 | let x = f () in 6 | let y = g () in 7 | print_int ((if h () = 0 then x + 1 else y + 2) + x + y) 8 | (* then節ではxがr0でyがスタックに、else節ではyがr0でxがスタックにある *) 9 | -------------------------------------------------------------------------------- /testdata/from-mincaml/join-stack2.ml: -------------------------------------------------------------------------------- 1 | let rec f _ = 123 in 2 | let rec g _ = 456 in 3 | 4 | let x = f () in 5 | print_int ((if x <= 0 then g () + x else x) + x) 6 | (* xがthen節ではセーブされ、else節ではセーブされない *) 7 | (* さらに、xがthen節ではr0に、else節ではr1にある *) 8 | -------------------------------------------------------------------------------- /testdata/from-mincaml/join-stack3.ml: -------------------------------------------------------------------------------- 1 | let rec f _ = 123 in 2 | let rec g _ = 456 in 3 | let rec h _ = 789 in 4 | 5 | let x = f () in 6 | print_int ((if x <= 0 then g () else h ()) + x) 7 | (* then節でもelse節でもxがセーブされるが、レジスタにはリストアされない *) 8 | -------------------------------------------------------------------------------- /testdata/from-mincaml/manyargs.ml: -------------------------------------------------------------------------------- 1 | (* thanks to https://twitter.com/gan13027830/status/791239623959687168 *) 2 | (* exactly one more arguments than registers; does not copmile *) 3 | let x = 42 in 4 | let rec f y1 y2 y3 y4 y5 = print_int (x + y1 + y2 + y3 + y4 + y5) in 5 | f 1 2 3 4 5 6 | -------------------------------------------------------------------------------- /testdata/from-mincaml/matmul-flat.ml: -------------------------------------------------------------------------------- 1 | external truncate: float -> int = "truncate"; 2 | let rec loop3 i k j a b c = 3 | if k < 0 then () else 4 | (c.(i).(j) <- c.(i).(j) +. a.(i).(k) *. b.(k).(j); 5 | loop3 i (k - 1) j a b c) in 6 | let rec loop2 i m j a b c = 7 | if j < 0 then () else 8 | (loop3 i (m - 1) j a b c; 9 | loop2 i m (j - 1) a b c) in 10 | let rec loop1 i m n a b c = 11 | if i < 0 then () else 12 | (loop2 i m (n - 1) a b c; 13 | loop1 (i - 1) m n a b c) in 14 | let rec mul l m n a b c = 15 | loop1 (l - 1) m n a b c in 16 | let dummy = Array.make 0 0. in 17 | let rec init i n mat = 18 | if i < 0 then () else 19 | (mat.(i) <- Array.make n 0.; 20 | init (i - 1) n mat) in 21 | let rec make m n dummy = 22 | let mat = Array.make m dummy in 23 | init (m - 1) n mat; 24 | mat in 25 | let a = make 2 3 dummy in 26 | let b = make 3 2 dummy in 27 | let c = make 2 2 dummy in 28 | a.(0).(0) <- 1.; a.(0).(1) <- 2.; a.(0).(2) <- 3.; 29 | a.(1).(0) <- 4.; a.(1).(1) <- 5.; a.(1).(2) <- 6.; 30 | b.(0).(0) <- 7.; b.(0).(1) <- 8.; 31 | b.(1).(0) <- 9.; b.(1).(1) <- 10.; 32 | b.(2).(0) <- 11.; b.(2).(1) <- 12.; 33 | mul 2 3 2 a b c; 34 | print_int (truncate (c.(0).(0))); 35 | print_str "\n"; 36 | print_int (truncate (c.(0).(1))); 37 | print_str "\n"; 38 | print_int (truncate (c.(1).(0))); 39 | print_str "\n"; 40 | print_int (truncate (c.(1).(1))); 41 | print_str "\n" 42 | -------------------------------------------------------------------------------- /testdata/from-mincaml/matmul.ml: -------------------------------------------------------------------------------- 1 | external truncate: float -> int = "truncate"; 2 | let rec mul l m n a b c = 3 | let rec loop1 i = 4 | if i < 0 then () else 5 | let rec loop2 j = 6 | if j < 0 then () else 7 | let rec loop3 k = 8 | if k < 0 then () else 9 | (c.(i).(j) <- c.(i).(j) +. a.(i).(k) *. b.(k).(j); 10 | loop3 (k - 1)) in 11 | loop3 (m - 1); 12 | loop2 (j - 1) in 13 | loop2 (n - 1); 14 | loop1 (i - 1) in 15 | loop1 (l - 1) in 16 | let dummy = Array.make 0 0. in 17 | let rec make m n = 18 | let mat = Array.make m dummy in 19 | let rec init i = 20 | if i < 0 then () else 21 | (mat.(i) <- Array.make n 0.; 22 | init (i - 1)) in 23 | init (m - 1); 24 | mat in 25 | let a = make 2 3 in 26 | let b = make 3 2 in 27 | let c = make 2 2 in 28 | a.(0).(0) <- 1.; a.(0).(1) <- 2.; a.(0).(2) <- 3.; 29 | a.(1).(0) <- 4.; a.(1).(1) <- 5.; a.(1).(2) <- 6.; 30 | b.(0).(0) <- 7.; b.(0).(1) <- 8.; 31 | b.(1).(0) <- 9.; b.(1).(1) <- 10.; 32 | b.(2).(0) <- 11.; b.(2).(1) <- 12.; 33 | mul 2 3 2 a b c; 34 | print_int ((truncate (c.(0).(0)))); 35 | print_str "\n"; 36 | print_int ((truncate (c.(0).(1)))); 37 | print_str "\n"; 38 | print_int ((truncate (c.(1).(0)))); 39 | print_str "\n"; 40 | print_int ((truncate (c.(1).(1)))); 41 | print_str "\n" 42 | -------------------------------------------------------------------------------- /testdata/from-mincaml/non-tail-if.ml: -------------------------------------------------------------------------------- 1 | external truncate: float -> int = "truncate"; 2 | let x = truncate 1.23 in 3 | let y = truncate 4.56 in 4 | let z = truncate (-.7.89) in 5 | print_int 6 | ((if z < 0 then y else x) + 7 | (if x > 0 then z else y) + 8 | (if y < 0 then x else z)) 9 | -------------------------------------------------------------------------------- /testdata/from-mincaml/non-tail-if2.ml: -------------------------------------------------------------------------------- 1 | let rec f _ = 12345 in 2 | let y = Array.make 10 3 in 3 | let x = 67890 in 4 | print_int (if y.(0) = 3 then f () + y.(1) + x else 7) 5 | -------------------------------------------------------------------------------- /testdata/from-mincaml/print.ml: -------------------------------------------------------------------------------- 1 | print_int 123; 2 | print_int (-456); 3 | print_int (789+0) 4 | -------------------------------------------------------------------------------- /testdata/from-mincaml/shuffle.ml: -------------------------------------------------------------------------------- 1 | let rec foo a b c d e f = 2 | print_int a; 3 | print_int b; 4 | print_int c; 5 | print_int d; 6 | print_int e; 7 | print_int f in 8 | let rec bar a b c d e f = 9 | foo b a d e f c in 10 | bar 1 2 3 4 5 6 11 | -------------------------------------------------------------------------------- /testdata/from-mincaml/spill.ml: -------------------------------------------------------------------------------- 1 | let rec f a b c d = 2 | let e = a + b in 3 | let f = a + c in 4 | let g = a + d in 5 | let h = b + c in 6 | let i = b + d in 7 | let j = c + d in 8 | 9 | let k = e + f in 10 | let l = e + g in 11 | let m = e + h in 12 | let n = e + i in 13 | let o = e + j in 14 | let p = f + g in 15 | let q = f + h in 16 | let r = f + i in 17 | let s = f + j in 18 | let t = g + h in 19 | let u = g + i in 20 | let v = g + j in 21 | let w = h + i in 22 | let x = h + j in 23 | let y = i + j in 24 | 25 | let aa = k + l in 26 | let ab = k + m in 27 | let ac = k + n in 28 | let ad = k + o in 29 | let ae = k + p in 30 | let af = k + q in 31 | let ag = k + r in 32 | let ah = k + s in 33 | let ai = k + t in 34 | let aj = k + u in 35 | let ak = k + v in 36 | let al = k + w in 37 | let am = k + x in 38 | let an = k + y in 39 | 40 | let z = a + b + c + d + 41 | e + f + g + h + i + j + 42 | k + l + m + n + o + p + q + r + s + t + u + v + w + x + y + 43 | aa + ab + ac + ad + ae + af + ag + ah + ai + aj + ak + al + am + an in 44 | -z in 45 | print_int (f 1 2 3 4) 46 | -------------------------------------------------------------------------------- /testdata/from-mincaml/spill2.ml: -------------------------------------------------------------------------------- 1 | (* http://smpl.seesaa.net/article/9342186.html#comment *) 2 | let rec f _ = 12345 in 3 | let rec g y = y + 1 in 4 | let z = Array.make 10 1 in 5 | let x = f () in 6 | let y = 67890 in 7 | let z0 = z.(0) in 8 | let z1 = z0 + z0 in 9 | let z2 = z1 + z1 in 10 | let z3 = z2 + z2 in 11 | let z4 = z3 + z3 in 12 | let z5 = z4 + z4 in 13 | let z6 = z5 + z5 in 14 | let z7 = z6 + z6 in 15 | let z8 = z7 + z7 in 16 | let z9 = z8 + z8 in 17 | let z10 = z9 + z9 in 18 | let z11 = z10 + z10 in 19 | let z12 = z11 + z11 in 20 | let z13 = z12 + z12 in 21 | let z14 = z13 + z13 in 22 | let z15 = z14 + z14 in 23 | print_int 24 | (if z.(1) = 0 then g y else 25 | z0 + z1 + z2 + z3 + z4 + z5 + z6 + z7 + 26 | z8 + z9 + z10 + z11 + z12 + z13 + z14 + z15 + x) 27 | -------------------------------------------------------------------------------- /testdata/from-mincaml/spill3.ml: -------------------------------------------------------------------------------- 1 | (* http://blog.livedoor.jp/azounoman/archives/50392600.html *) 2 | let rec f x0 = 3 | let x1 = x0 + 1 in 4 | let x2 = x1 + 1 in 5 | let x3 = x2 + 1 in 6 | let x4 = x3 + 1 in 7 | let x5 = x4 + 1 in 8 | let x6 = x5 + 1 in 9 | let x7 = x6 + 1 in 10 | let x8 = x7 + 1 in 11 | let x9 = x8 + 1 in 12 | let x10 = x9 + 1 in 13 | let x11 = x10 + 1 in 14 | let x12 = x11 + 1 in 15 | let x13 = x12 + 1 in 16 | let x14 = x13 + 1 in 17 | let x15 = x14 + 1 in 18 | let x16 = x15 + 1 in 19 | let x17 = x16 + 1 in 20 | let x18 = x17 + 1 in 21 | let x19 = x18 + x1 in 22 | let x20 = x19 + x2 in 23 | let x21 = x20 + x3 in 24 | let x22 = x21 + x4 in 25 | let x23 = x22 + x5 in 26 | let x24 = x23 + x6 in 27 | let x25 = x24 + x7 in 28 | let x26 = x25 + x8 in 29 | let x27 = x26 + x9 in 30 | let x28 = x27 + x10 in 31 | let x29 = x28 + x11 in 32 | let x30 = x29 + x12 in 33 | let x31 = x30 + x13 in 34 | let x32 = x31 + x14 in 35 | let x33 = x32 + x15 in 36 | let x34 = x33 + x16 in 37 | let x35 = x34 + x17 in 38 | let x36 = x35 + x0 in 39 | x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + 40 | x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + 41 | x20 + x21 + x22 + x23 + x24 + x25 + x26 + x27 + x28 + x29 + 42 | x30 + x31 + x32 + x33 + x34 + x35 + x36 + x0 in 43 | print_int (f 0) 44 | -------------------------------------------------------------------------------- /testdata/from-mincaml/sum-tail.ml: -------------------------------------------------------------------------------- 1 | let rec sum acc x = 2 | if x <= 0 then acc else 3 | sum (acc + x) (x - 1) in 4 | print_int (sum 0 10000) 5 | -------------------------------------------------------------------------------- /testdata/from-mincaml/sum.ml: -------------------------------------------------------------------------------- 1 | let rec sum x = 2 | if x <= 0 then 0 else 3 | sum (x - 1) + x in 4 | print_int (sum 10000) 5 | -------------------------------------------------------------------------------- /testdata/from-mincaml/toomanyargs.ml: -------------------------------------------------------------------------------- 1 | (* thanks to https://twitter.com/gan13027830/status/791239623959687168 *) 2 | (* exactly one more arguments than registers; does not copmile *) 3 | let x = 42 in 4 | let rec f y1 y2 y3 y4 y5 y6 = print_int x in 5 | f 1 2 3 4 5 6 6 | -------------------------------------------------------------------------------- /token/token.go: -------------------------------------------------------------------------------- 1 | // Package token defines tokens of GoCaml source codes. 2 | package token 3 | 4 | import ( 5 | "fmt" 6 | "github.com/rhysd/locerr" 7 | ) 8 | 9 | type Kind int 10 | 11 | const ( 12 | ILLEGAL Kind = iota 13 | COMMENT 14 | LPAREN 15 | RPAREN 16 | IDENT 17 | BOOL 18 | NOT 19 | INT 20 | FLOAT 21 | MINUS 22 | PLUS 23 | MINUS_DOT 24 | PLUS_DOT 25 | STAR_DOT 26 | SLASH_DOT 27 | EQUAL 28 | LESS_GREATER 29 | LESS_EQUAL 30 | LESS 31 | GREATER 32 | GREATER_EQUAL 33 | IF 34 | THEN 35 | ELSE 36 | LET 37 | IN 38 | REC 39 | COMMA 40 | ARRAY_MAKE 41 | DOT 42 | LESS_MINUS 43 | SEMICOLON 44 | STAR 45 | SLASH 46 | BAR_BAR 47 | AND_AND 48 | ARRAY_LENGTH 49 | STRING_LITERAL 50 | PERCENT 51 | MATCH 52 | WITH 53 | BAR 54 | SOME 55 | NONE 56 | MINUS_GREATER 57 | FUN 58 | COLON 59 | TYPE 60 | LBRACKET_BAR 61 | BAR_RBRACKET 62 | LBRACKET 63 | RBRACKET 64 | EXTERNAL 65 | EOF 66 | ) 67 | 68 | var tokenTable = [...]string{ 69 | ILLEGAL: "ILLEGAL", 70 | EOF: "EOF", 71 | COMMENT: "COMMENT", 72 | LPAREN: "(", 73 | RPAREN: ")", 74 | IDENT: "IDENT", 75 | BOOL: "BOOL", 76 | NOT: "NOT", 77 | INT: "INT", 78 | FLOAT: "FLOAT", 79 | MINUS: "-", 80 | PLUS: "+", 81 | MINUS_DOT: "-.", 82 | PLUS_DOT: "+.", 83 | STAR_DOT: "*.", 84 | SLASH_DOT: "/.", 85 | EQUAL: "=", 86 | LESS_GREATER: "<>", 87 | LESS_EQUAL: "<=", 88 | LESS: "<", 89 | GREATER: ">", 90 | GREATER_EQUAL: ">=", 91 | IF: "if", 92 | THEN: "then", 93 | ELSE: "else", 94 | LET: "let", 95 | IN: "in", 96 | REC: "rec", 97 | COMMA: ",", 98 | ARRAY_MAKE: "Array.make", 99 | DOT: ".", 100 | LESS_MINUS: "<-", 101 | SEMICOLON: ";", 102 | STAR: "*", 103 | SLASH: "/", 104 | BAR_BAR: "||", 105 | AND_AND: "&&", 106 | ARRAY_LENGTH: "Array.length", 107 | STRING_LITERAL: "STRING_LITERAL", 108 | PERCENT: "%", 109 | MATCH: "match", 110 | WITH: "with", 111 | BAR: "|", 112 | SOME: "Some", 113 | NONE: "None", 114 | MINUS_GREATER: "->", 115 | FUN: "fun", 116 | COLON: ":", 117 | TYPE: "type", 118 | LBRACKET_BAR: "[|", 119 | BAR_RBRACKET: "|]", 120 | LBRACKET: "[", 121 | RBRACKET: "]", 122 | EXTERNAL: "external", 123 | } 124 | 125 | // Token instance for GoCaml. 126 | // It contains its location information and kind. 127 | type Token struct { 128 | Kind Kind 129 | Start locerr.Pos 130 | End locerr.Pos 131 | File *locerr.Source 132 | } 133 | 134 | // String returns an information of token. This method is used mainly for 135 | // debug purpose. 136 | func (tok *Token) String() string { 137 | return fmt.Sprintf( 138 | "<%s:%s>(%d:%d:%d-%d:%d:%d)", 139 | tokenTable[tok.Kind], 140 | tok.Value(), 141 | tok.Start.Line, tok.Start.Column, tok.Start.Offset, 142 | tok.End.Line, tok.End.Column, tok.End.Offset) 143 | } 144 | 145 | // Value returns the corresponding a string part of code. 146 | func (tok *Token) Value() string { 147 | return string(tok.File.Code[tok.Start.Offset:tok.End.Offset]) 148 | } 149 | -------------------------------------------------------------------------------- /token/token_test.go: -------------------------------------------------------------------------------- 1 | package token 2 | 3 | import ( 4 | "github.com/rhysd/locerr" 5 | "testing" 6 | ) 7 | 8 | func TestTokenString(t *testing.T) { 9 | s := locerr.NewDummySource("abcd") 10 | tok := Token{ 11 | Kind: IDENT, 12 | Start: locerr.Pos{1, 1, 2, s}, 13 | End: locerr.Pos{3, 1, 4, s}, 14 | File: s, 15 | } 16 | actual := tok.String() 17 | expected := "(1:2:1-1:4:3)" 18 | if actual != expected { 19 | t.Fatalf("Expected '%s' but actually '%s'", expected, actual) 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /types/env.go: -------------------------------------------------------------------------------- 1 | // Package types provides data structures for types in GoCaml. 2 | package types 3 | 4 | import ( 5 | "fmt" 6 | ) 7 | 8 | type VarMapping struct { 9 | ID VarID 10 | Type Type 11 | } 12 | 13 | // Instantiation is the information of instantiation of a generic type. 14 | type Instantiation struct { 15 | // From is a generic type variable instantiated. 16 | From Type 17 | // To is a type variable instantiated from generic type variable. 18 | To Type 19 | // Mapping from ID of generic type variable to actual instantiated type variable 20 | Mapping []*VarMapping 21 | } 22 | 23 | type External struct { 24 | Type Type 25 | CName string 26 | } 27 | 28 | // Result of type analysis. 29 | type Env struct { 30 | // Types for declarations. This is referred by type variables to resolve 31 | // type variables' actual types 32 | // 33 | // XXX: 34 | // Currently nested identifiers don't work. Example: 35 | // let 36 | // x = 42 37 | // in 38 | // let x = true in print_bool (x); 39 | // print_int (x) 40 | // We need alpha transform before type inference in order to ensure 41 | // all symbol names are unique. 42 | DeclTable map[string]Type 43 | // External variable names which are referred but not defined. 44 | // External variables are exposed as external symbols in other object files. 45 | Externals map[string]*External 46 | // GoCaml uses let-polymorphic type inference. It means that instantiation occurs when new 47 | // symbol is introduced. So instantiation only occurs at variable reference. 48 | RefInsts map[string]*Instantiation 49 | // Mappings from generic type to instantiated types for each declarations. 50 | // e.g. 51 | // 'a -> 'a => {int -> int, bool -> bool, float -> float} 52 | // 53 | // Note: This is set in sema/deref.go 54 | PolyTypes map[Type][]*Instantiation 55 | } 56 | 57 | // NewEnv creates empty Env instance. 58 | func NewEnv() *Env { 59 | return &Env{ 60 | map[string]Type{}, 61 | builtinPopulatedTable(), 62 | map[string]*Instantiation{}, 63 | nil, 64 | } 65 | } 66 | 67 | // TODO: Dump environment as JSON 68 | 69 | func (env *Env) Dump() { 70 | // Note: RefInsts is not displayed because it is filled by ToMIR conversion function and not 71 | // filled by the type analysis. 72 | env.DumpVariables() 73 | fmt.Println() 74 | env.DumpPolyTypes() 75 | fmt.Println() 76 | env.DumpExternals() 77 | } 78 | 79 | func (env *Env) DumpVariables() { 80 | fmt.Println("Variables:") 81 | for s, t := range env.DeclTable { 82 | fmt.Printf(" %s: %s\n", s, t.String()) 83 | } 84 | } 85 | 86 | func (env *Env) DumpExternals() { 87 | fmt.Println("External Variables:") 88 | for s, e := range env.Externals { 89 | fmt.Printf(" %s: %s (=> %s)\n", s, e.Type.String(), e.CName) 90 | } 91 | } 92 | 93 | func (env *Env) DumpPolyTypes() { 94 | fmt.Println("PolyTypes:") 95 | for t, insts := range env.PolyTypes { 96 | fmt.Printf(" '%s' (%d instances) =>\n", t.String(), len(insts)) 97 | for i, inst := range insts { 98 | fmt.Printf(" %d: %s\n", i, inst.To.String()) 99 | } 100 | } 101 | } 102 | 103 | func (env *Env) DumpDebug() { 104 | fmt.Println("Variables:") 105 | for s, t := range env.DeclTable { 106 | fmt.Printf(" %s: %s\n", s, Debug(t)) 107 | } 108 | fmt.Println("\nInstantiations:") 109 | for ref, inst := range env.RefInsts { 110 | fmt.Printf(" '%s'\n", ref) 111 | fmt.Printf(" From: %s\n", Debug(inst.From)) 112 | fmt.Printf(" To: %s\n", Debug(inst.To)) 113 | for i, m := range inst.Mapping { 114 | fmt.Printf(" VAR%d: '%d => '%s'\n", i, m.ID, Debug(m.Type)) 115 | } 116 | } 117 | fmt.Println() 118 | fmt.Println("PolyTypes:") 119 | for t, insts := range env.PolyTypes { 120 | fmt.Printf(" '%s' (%d instance(s)) =>\n", Debug(t), len(insts)) 121 | for i, inst := range insts { 122 | fmt.Printf(" %d: %s\n", i, Debug(inst.To)) 123 | } 124 | } 125 | fmt.Println() 126 | env.DumpExternals() 127 | } 128 | -------------------------------------------------------------------------------- /types/env_test.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | import ( 4 | "bytes" 5 | "io" 6 | "os" 7 | "strings" 8 | "testing" 9 | ) 10 | 11 | func TestDumpResult(t *testing.T) { 12 | env := NewEnv() 13 | env.DeclTable["test_ident"] = IntType 14 | env.DeclTable["test_ident2"] = BoolType 15 | env.DeclTable["external_ident"] = UnitType 16 | env.DeclTable["external_ident2"] = FloatType 17 | 18 | // TODO: Add dummy instantiations 19 | 20 | old := os.Stdout 21 | r, w, _ := os.Pipe() 22 | os.Stdout = w 23 | 24 | env.Dump() 25 | 26 | ch := make(chan string) 27 | go func() { 28 | var buf bytes.Buffer 29 | io.Copy(&buf, r) 30 | ch <- buf.String() 31 | }() 32 | w.Close() 33 | os.Stdout = old 34 | 35 | out := <-ch 36 | for _, s := range []string{ 37 | "Variables:\n", 38 | "test_ident: int", 39 | "test_ident2: bool", 40 | "External Variables:\n", 41 | "external_ident: unit", 42 | "external_ident2: float", 43 | } { 44 | if !strings.Contains(out, s) { 45 | t.Fatalf("Output does not contain '%s': %s", s, out) 46 | } 47 | } 48 | } 49 | 50 | // TODO: TestDumpDebug 51 | 52 | func TestEnvHasBuiltins(t *testing.T) { 53 | env := NewEnv() 54 | if len(env.Externals) == 0 { 55 | t.Fatal("Env must contain some external symbols by default because of builtin symbols") 56 | } 57 | if _, ok := env.Externals["print_int"]; !ok { 58 | t.Fatal("'print_int' is not found though it is builtin:", env.Externals) 59 | } 60 | } 61 | -------------------------------------------------------------------------------- /types/equals.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | // Equals returns given two types are equivalent or not. Note that type variable's ID and level are 4 | // not seen, but free or bound (.IsGeneric() or not) is seen. 5 | func Equals(l, r Type) bool { 6 | switch l := l.(type) { 7 | case *Unit, *Int, *Float, *Bool, *String: 8 | return l == r 9 | case *Tuple: 10 | r, ok := r.(*Tuple) 11 | if !ok || len(l.Elems) != len(r.Elems) { 12 | return false 13 | } 14 | for i, e := range l.Elems { 15 | if !Equals(e, r.Elems[i]) { 16 | return false 17 | } 18 | } 19 | return true 20 | case *Array: 21 | r, ok := r.(*Array) 22 | if !ok { 23 | return false 24 | } 25 | return Equals(l.Elem, r.Elem) 26 | case *Fun: 27 | r, ok := r.(*Fun) 28 | if !ok || !Equals(l.Ret, r.Ret) || len(l.Params) != len(r.Params) { 29 | return false 30 | } 31 | for i, p := range l.Params { 32 | if !Equals(p, r.Params[i]) { 33 | return false 34 | } 35 | } 36 | return true 37 | case *Var: 38 | r, ok := r.(*Var) 39 | if !ok { 40 | return false 41 | } 42 | if l.Ref == nil && r.Ref == nil { 43 | lgen, rgen := l.IsGeneric(), r.IsGeneric() 44 | if lgen && rgen { 45 | return l.ID == r.ID 46 | } 47 | return !lgen && !rgen 48 | } 49 | if l.Ref == nil || r.Ref == nil { 50 | return false 51 | } 52 | return Equals(l.Ref, r.Ref) 53 | case *Option: 54 | r, ok := r.(*Option) 55 | if !ok { 56 | return false 57 | } 58 | return Equals(l.Elem, r.Elem) 59 | default: 60 | panic("Unreachable") 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /types/equals_test.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | import ( 4 | "testing" 5 | ) 6 | 7 | func TestEquals(t *testing.T) { 8 | gen := NewGeneric() 9 | free := NewVar(nil, 0) 10 | cases := []Type{ 11 | IntType, 12 | FloatType, 13 | free, 14 | gen, 15 | &Array{IntType}, 16 | &Option{free}, 17 | NewVar(&Tuple{[]Type{UnitType, NewVar(free, 0), NewVar(gen, 0)}}, 0), 18 | &Fun{free, []Type{&Array{gen}, StringType, BoolType}}, 19 | } 20 | 21 | for i, l := range cases { 22 | if !Equals(l, l) { 23 | s := Debug(l) 24 | t.Error("`%s` == `%s` is false", s, s) 25 | } 26 | j := i + 1 27 | if j == len(cases) { 28 | j = 0 29 | } 30 | r := cases[j] 31 | if Equals(l, r) { 32 | t.Error("`%s` != `%s` is false", Debug(l), Debug(r)) 33 | } 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /types/type_test.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | import ( 4 | "strings" 5 | "testing" 6 | ) 7 | 8 | func TestTupleString(t *testing.T) { 9 | tpl := &Tuple{[]Type{IntType, BoolType, &Tuple{[]Type{FloatType, UnitType}}}} 10 | s := tpl.String() 11 | if s != "int * bool * (float * unit)" { 12 | t.Fatal("Tuple string format is unexpected:", s) 13 | } 14 | // Tuple in other type 15 | v := NewVar(&Tuple{[]Type{IntType, BoolType}}, 0) 16 | s = v.String() 17 | if s != "int * bool" { 18 | t.Fatal("Tuple string nested in other type is unexpected:", s) 19 | } 20 | } 21 | 22 | func TestFunString(t *testing.T) { 23 | fun := &Fun{ 24 | &Fun{IntType, []Type{&Option{StringType}}}, 25 | []Type{ 26 | IntType, 27 | &Fun{&Array{BoolType}, []Type{FloatType}}, 28 | }, 29 | } 30 | s := fun.String() 31 | if s != "int -> (float -> bool array) -> (string option -> int)" { 32 | t.Fatal("Function string format is unexpected:", s) 33 | } 34 | // Fun in other type 35 | v := NewVar(&Fun{IntType, []Type{BoolType}}, 0) 36 | s = v.String() 37 | if s != "bool -> int" { 38 | t.Fatal("Function string nested in other type is unexpected:", s) 39 | } 40 | } 41 | 42 | func TestVarString(t *testing.T) { 43 | var_ := func(t Type) *Var { 44 | return NewVar(t, 0) 45 | } 46 | v := var_(nil) 47 | s := v.String() 48 | if s[0] != '?' { 49 | t.Fatal("Incorrect empty variable format:", s) 50 | } 51 | v = var_(var_(&Option{&Array{StringType}})) 52 | s = v.String() 53 | if s != "string array option" { 54 | t.Fatal("Type variable is not stripped correctly:", s) 55 | } 56 | } 57 | 58 | func TestGenGeneric(t *testing.T) { 59 | g1 := NewGeneric() 60 | g2 := NewVar(nil, 0) 61 | if g2.IsGeneric() { 62 | t.Fatal("Level 0 type variable should not be generic") 63 | } 64 | g2.SetGeneric() 65 | if !g2.IsGeneric() { 66 | t.Fatal("Type variabel after SetGeneric() should eb generic") 67 | } 68 | if g1.ID == g2.ID { 69 | t.Fatal("NewGeneric should generate generic variable with unique ID") 70 | } 71 | if g1.Level != g2.Level { 72 | t.Fatal("NewGeneric should generate generic variables with the same level", g1.Level, g2.Level) 73 | } 74 | 75 | defer func() { 76 | if recover() == nil { 77 | t.Fatal("Making non-empty linked type variable generic should cause panic") 78 | } 79 | }() 80 | v := NewVar(IntType, 0) 81 | v.SetGeneric() 82 | } 83 | 84 | func TestGenericString(t *testing.T) { 85 | s := NewGeneric().String() 86 | if s != "'a" { 87 | t.Fatal("Generic name must start with 'a", s) 88 | } 89 | 90 | g := NewGeneric() 91 | s = (&Tuple{[]Type{g, g}}).String() 92 | if s != "'a * 'a" { 93 | t.Fatal("The same name should be given to the same variable:", s) 94 | } 95 | 96 | g2 := NewGeneric() 97 | s = (&Fun{g2, []Type{g, g2, g}}).String() 98 | if s != "'a -> 'b -> 'a -> 'b" { 99 | t.Fatal("Multiple generic variables must be treated correctly:", s) 100 | } 101 | 102 | ts := make([]Type, 0, 27) 103 | for i := 0; i < 27; i++ { 104 | ts = append(ts, NewGeneric()) 105 | } 106 | s = (&Tuple{ts}).String() 107 | if !strings.HasSuffix(s, " * 'a1") { 108 | t.Fatal("Generic name must be rotated with count:", s) 109 | } 110 | } 111 | 112 | func TestDebug(t *testing.T) { 113 | currentVarID = 0 114 | g := NewGeneric() 115 | ty := NewVar(&Tuple{[]Type{g, g, NewVar(nil, 2)}}, 1) 116 | have := Debug(ty) 117 | want := "?('a(1) * 'a(1) * ?(2, 2), 3, 1)" 118 | if have != want { 119 | t.Fatal("Unexpected debug string:", have, ", want:", want) 120 | } 121 | } 122 | -------------------------------------------------------------------------------- /types/visitor.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | // Visitor is an interface for the structs which is used for traversing Type. 4 | type Visitor interface { 5 | // VisitTopdown defines the process when a type is visited. This method is called before 6 | // children are visited. 7 | // Returned value is a next visitor to use for succeeding visit. When wanting to stop 8 | // visiting, please return nil. 9 | // A visitor visits in depth-first order. 10 | VisitTopdown(t Type) Visitor 11 | // VisitBottomup defines the process when a type is visited. This method is called after 12 | // children were visited. When VisitTopdown returned nil, this method won't be caled for the type. 13 | VisitBottomup(t Type) 14 | } 15 | 16 | // Visit visits the given type with the visitor. 17 | func Visit(vis Visitor, t Type) { 18 | v := vis.VisitTopdown(t) 19 | if v == nil { 20 | return 21 | } 22 | 23 | switch t := t.(type) { 24 | case *Fun: 25 | Visit(v, t.Ret) 26 | for _, p := range t.Params { 27 | Visit(v, p) 28 | } 29 | case *Tuple: 30 | for _, e := range t.Elems { 31 | Visit(v, e) 32 | } 33 | case *Array: 34 | Visit(v, t.Elem) 35 | case *Option: 36 | Visit(v, t.Elem) 37 | case *Var: 38 | if t.Ref != nil { 39 | Visit(v, t.Ref) 40 | } 41 | } 42 | 43 | vis.VisitBottomup(t) 44 | } 45 | -------------------------------------------------------------------------------- /types/visitor_test.go: -------------------------------------------------------------------------------- 1 | package types 2 | 3 | import ( 4 | "bytes" 5 | "fmt" 6 | "io" 7 | "testing" 8 | ) 9 | 10 | type testVisitPath struct { 11 | w io.Writer 12 | } 13 | 14 | func (v *testVisitPath) VisitTopdown(t Type) Visitor { 15 | fmt.Fprintf(v.w, " -> %s (top)", t.String()) 16 | return v 17 | } 18 | 19 | func (v *testVisitPath) VisitBottomup(t Type) { 20 | fmt.Fprintf(v.w, " -> %s (bottom)", t.String()) 21 | } 22 | 23 | func TestVisitTypes(t *testing.T) { 24 | cases := []struct { 25 | input Type 26 | output string 27 | }{ 28 | { 29 | IntType, 30 | "int (top) -> int (bottom)", 31 | }, 32 | { 33 | &Array{IntType}, 34 | "int array (top) -> int (top) -> int (bottom) -> int array (bottom)", 35 | }, 36 | { 37 | &Tuple{[]Type{UnitType, BoolType}}, 38 | "unit * bool (top) -> unit (top) -> unit (bottom) -> bool (top) -> bool (bottom) -> unit * bool (bottom)", 39 | }, 40 | { 41 | &Option{StringType}, 42 | "string option (top) -> string (top) -> string (bottom) -> string option (bottom)", 43 | }, 44 | { 45 | NewVar(IntType, 0), 46 | "int (top) -> int (top) -> int (bottom) -> int (bottom)", 47 | }, 48 | } 49 | 50 | for _, tc := range cases { 51 | var buf bytes.Buffer 52 | v := &testVisitPath{&buf} 53 | Visit(v, tc.input) 54 | have := buf.String() 55 | want := " -> " + tc.output 56 | if have != want { 57 | t.Errorf("Unexpected visiting path for type '%s': %s", tc.input.String(), have) 58 | } 59 | } 60 | } 61 | 62 | type testVisitShallow struct { 63 | last Type 64 | } 65 | 66 | func (v *testVisitShallow) VisitTopdown(t Type) Visitor { 67 | v.last = t 68 | return nil 69 | } 70 | 71 | func (v *testVisitShallow) VisitBottomup(t Type) { 72 | panic(t.String()) 73 | } 74 | 75 | func TestVisitStop(t *testing.T) { 76 | v := &testVisitShallow{} 77 | ty := &Tuple{[]Type{UnitType, &Array{NewVar(IntType, 0)}}} 78 | Visit(v, ty) 79 | if v.last == nil { 80 | t.Fatal("No child was visited") 81 | } 82 | if v.last != ty { 83 | t.Fatal("Only root should be visited:", v.last.String()) 84 | } 85 | } 86 | --------------------------------------------------------------------------------