Add interpreter ("OCaml + printf" by Rodionov Maxim and Zaikin Vladim…

…ir) (Kakadu#74)

* project initialization

Signed-off-by: Maxim Rodionov <[email protected]>

* chore: update .gitignore and .ocamlformat

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: add AST

Signed-off-by: Maxim Rodionov <[email protected]>

* chore: fix linter's comments and delete unnecessary file

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: add an example of representing a factorial using the written types

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: an example of representing a factorial check by compiler

Signed-off-by: Maxim Rodionov <[email protected]>

* test: add cram test for output

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: update AST and an example of representing a factorial

Removed types related to printf, corrected documentation, changed definition of Exp_fun and Exp_apply.

Signed-off-by: Maxim Rodionov <[email protected]>

* docs: add authors' emails

Signed-off-by: Friend-zva <[email protected]>

* refactor: rename 'REPL.ml' to 'main.ml'

Signed-off-by: Friend-zva <[email protected]>

* fix: unused depends

Signed-off-by: Friend-zva <[email protected]>

* feat: add 'parse_constant'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: add base 'parse_pattern', 'parse_expression' and 'parse_binding'

Signed-off-by: Vladimir Zaikin <[email protected]>

* docs: rename 'Str' -> 'Struct' and fix typos

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: add parsing of 'structure', 'structure_item' and refactor some functions
Added 'parse_structure', 'parse_struct_value', 'parse_value_binding_list', 'parse_ident' and renamed 'skip_many' to 'ws'.

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: expand 'parse_expression' and 'parse_pattern'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: add 'parse_expression'

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'chain_left_associative' and 'parse_exp_match'

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: some funs and args in parsing 'expression' and 'pattern'

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: react to zanuda warnings

Change execation parser.
Add 'expect_test' for parser to '/tests/test_parser.ml' and delete 'parser_binding.t'.
Add '.mli' for 'parser.ml' and 'test_parser.ml'.

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: 'parse_pattern', update 'parser.mli' and remove unimplemented functions

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: add parser tests

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: REPL

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: error handling

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: REPL

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: error handling

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: delete dir 'main', add test for parser via REPL

Signed-off-by: Maxim Rodionov <[email protected]>

* chore: remove stanza 'modules' in dune files, edit the test

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'factorial.ml' -> 'factorial.txt'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: missing spaces and types

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: 'parse_exp_let', 'ws1', rewrite 'parse_ident' and parse of tuple with let*

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: replace all liftn with let*

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'parse_expression' and some variable names

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: a test for 'Exp_let'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: 'parse_exp_apply' and a test for it

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: 'parse_exp_apply_op'

Signed-off-by: Vladimir Zaikin <[email protected]>

* docs: add more info to 'README.md'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: 'parse_exp_construct', 'parse_pat_construct', some code refactor
Removed unnecessary code, added a function 'is_empty' due to linter comments.

Signed-off-by: Maxim Rodionov <[email protected]>

* test: for 'Exp_construct'

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'ws1' -> 'keyword' and some typos

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: 'parse_exp_sequence', 'parse_bool_exp', 'parse_bool_pat'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: prevent backtracking for 'parse_structure'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: 'parse_chain_right_associative' and some typos

Signed-off-by: Maxim Rodionov <[email protected]>

* test: for 'parse_chain_right_associative' and for REPL

Signed-off-by: Maxim Rodionov <[email protected]>

* chore: correct the order of tests

Signed-off-by: Maxim Rodionov <[email protected]>

* test: small refactor

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: simplify some checks and concatenation

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: add 'parse_exp_fun' and a test for it

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: implement pretty-printer

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: pretty-print of 'Exp_apply'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: implement draft of qcheck

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: fix linter comments and clean up code

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: rework ast generation

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: zanuda's warnings and 'keyword'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: parsing sequence and construct

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: zanuda comment

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: implement draft of shrink

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: shrink of value_binding and case

Signed-off-by: Vladimir Zaikin <[email protected]>

* test: small refactor

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: simplify some checks and concatenation

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: add 'parse_exp_fun' and a test for it

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: implement pretty-printer

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: pretty-print of 'Exp_apply'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: implement draft of qcheck

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: fix linter comments and clean up code

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: rework ast generation

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: zanuda's warnings and 'keyword'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: parsing sequence and construct

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: zanuda comment

Signed-off-by: Maxim Rodionov <[email protected]>

* chore: formatting

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: library qcheck -> qcheck-core

Signed-off-by: Vladimir Zaikin <[email protected]>

* test: pretty printer

Signed-off-by: Vladimir Zaikin <[email protected]>

* test: 'QCheck_base_runner' and pretty printer's tests

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: add brackets to pretty printer to make the meaning of expressions clear

Signed-off-by: Maxim Rodionov <[email protected]>

* test: update expected result from tests

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: string shrinking

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: parsing, pretty-printing, test for 'option'

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'List.con' -> '::' and rename some vars

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: replace 'run_qchecker.ml'

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: replace 'String.concat' with 'pp_print_list'

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: placement of parentheses in arithmetic expressions in pretty printer

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: rework pretty print of 'Exp_apply', add operators to qcheck

Signed-off-by: Maxim Rodionov <[email protected]>

* test: add pprinter to parser tests

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: tuple signature

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: explicit type assignment

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: match signature

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'Struct_value' and 'Exp_let' signatures

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'Exp_apply' signature

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: shrinker

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: auto generator

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: move shrinker to a separate file

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'Type_tuple' signature

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: construct keyword parsing

Signed-off-by: Maxim Rodionov <[email protected]>

* revert: construct keyword parsing

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: auto generator -> ast

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: 'expression' -> 't'

Signed-off-by: Vladimir Zaikin <[email protected]>

* docs: update 'README.md'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: zanuda's warnings

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: typos and defect in the content of 'ident'

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: 'core_type'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: add 'bin_op' in auto generator

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: parsing and generating 'ident'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: generating constructs

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: 'core_type' and some construct in manual generator

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: manual generator

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: gen 'Exp_fun' and some limits

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: formatting

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: pretty output

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: 'Exp_fun' signature

* refactor: pretty print of 'Type_arrow' and 'Type_tuple'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: 'verbose' option in generator

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: zanuda's warnings

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: 'ppx_deriving_qcheck' in depends

Signed-off-by: Vladimir Zaikin <[email protected]>

* docs: typos in 'README.md'

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: 'run_qchecker': executable -> module of library 'tests'

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: reduce the code, make it more reusable

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: draft version of type inference

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: 'ty' -> 'core_type' and expand 'core_type'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: 'Type_unit' and 'Type_name'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: type inference of 'Exp_tuple', 'Pat_tuple' and tests

* feat: draft version of type inference

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: 'ty' -> 'core_type' and expand 'core_type'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: 'Type_unit' and 'Type_name'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: type inference of 'Exp_tuple', 'Pat_tuple' and tests

* feat: inference of 'Exp_fun', 'Exp_match', 'Exp_sequence', 'Exp_constraint', 'Pat_constraint'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: parsing and generating 'Type_name'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: work with core_type, add 'Type_unit'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: impl prec printer and rebuild 'Exp_apply'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: pretty printer and shrinker

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: rename module R to State, remove unnecessary functions helper

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: inference of 'Exp_construct', 'Pat_construct'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: prec printer

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: inference of 'Exp_apply', 'Exp_ifthenelse' without else branch

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: almost full inference of 'Exp_let', 'Struct_value'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: parse and inference of cons operator

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: 'parse_expression'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: inference of lists, recursive 'Struct_value'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: 'Type_option'

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'let' and 'let rec' inference

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: inferencer to REPL

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: Exp_function

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: parse_expression and generating 'Exp_let'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: inference of 'Exp_function', 'Exp_match'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: pprinter and qcheck

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: clean 'inferencer.mli', improve variable names

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: support for negative numbers

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: names of type variables

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: 'run_tests' -> 'run_tests_main' in qcheck

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: generator type

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: inference of recursive definition

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: explicit assignment of types

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: parsing value_binding and construct 'Some'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: generating value_binding

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: indent in pretty printer

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: 'manytests' for type check

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: remove requirement of parentheses after 'Some'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: remove hanging tests

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: formatting 'manytests'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: symbolic link for 'manytests'

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: react to linter report

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: 'Impossible_error'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: clean qcheck

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: clean pretty printer

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: pretty printer 'core_type'

Signed-off-by: Vladimir Zaikin <[email protected]>

* docs: complement in AST

Signed-off-by: Vladimir Zaikin <[email protected]>

* refactor: rename variables and functions

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: 'parse_expression', expand search for 'Bound_several_times' error

Signed-off-by: Maxim Rodionov <[email protected]>

* docs: type 'error'

Signed-off-by: Maxim Rodionov <[email protected]>

* chore: remove unnecessary variable

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: 'parse_type_var', inference of 'Exp_apply'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: ' in 'Type_var' and 'parse_list_or_option_type'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: shrinker 'core_type'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: 'parse_expression' and clean parsing

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: 'parse_expression' and tests for it

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: react to linter report

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: simple interpreter

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: pp in Ast and 'Struct_eval' in infer and inter

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: 'match_pattern'

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: eval recursive value bindings, 'Exp_apply'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: printer infer result

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: react to linter report

Signed-off-by: Vladimir Zaikin <[email protected]>

* revert: remove 'Type_any'

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: eval 'print_int'

Signed-off-by: Vladimir Zaikin <[email protected]>

* fix: result list of eval

Signed-off-by: Vladimir Zaikin <[email protected]>

* feat: expand 'REPL' with interpeter, simplify 'eval_value_binding_list'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: 'Exp_apply' in 'eval_expression'

Signed-off-by: Maxim Rodionov <[email protected]>

* fix: repl interaction

Signed-off-by: Vladimir Zaikin <[email protected]>

* chore: progress in README

Signed-off-by: Vladimir Zaikin <[email protected]>

* docs: interpreter errors

Signed-off-by: Maxim Rodionov <[email protected]>

* feat: concatenating strings

Signed-off-by: Maxim Rodionov <[email protected]>

* refactor: clean code, tests and output REPL

Signed-off-by: Vladimir Zaikin <[email protected]>

---------

Signed-off-by: Maxim Rodionov <[email protected]>
Signed-off-by: Friend-zva <[email protected]>
Signed-off-by: Vladimir Zaikin <[email protected]>
Co-authored-by: Friend-zva <[email protected]>

OCamlPrintf/README.md

@@ -31,7 +31,12 @@
   - [x] Auto
 - [x] Shrinker
 - [x] Type Checker
-- [ ] Interpreter
+- [x] Interpreter
+- [ ] Support for char, string types and operations with them
+  - [x] Types
+  - [x] Comparison
+  - [x] Concatenation
+- [ ] Support the formatted printing function
 
 ## Build
 
@@ -46,6 +51,8 @@ dune build # Build the project.
 dune runtest # Run all tests.
 dune exec -- repl/REPL.exe -dparsetree -fromfile tests/factorial.txt # Run parser tests and see AST.
 dune exec -- tests/run_qchecker.exe -v # Run qchecker tests with verbose mode.
+dune exec -- repl/REPL.exe -inference # Run inferencer in REPL.
+dune exec repl/REPL.exe # Run interpreter.
 ```
 
 ## Authors

OCamlPrintf/lib/ast.ml

@@ -24,14 +24,15 @@ let bin_op_list =
   ; "/", 1
   ; "+", 2
   ; "-", 2
-  ; ">=", 3
-  ; "<=", 3
-  ; "<>", 3
-  ; "=", 3
-  ; ">", 3
-  ; "<", 3
-  ; "&&", 4
-  ; "||", 5
+  ; "^", 3
+  ; ">=", 4
+  ; "<=", 4
+  ; "<>", 4
+  ; "=", 4
+  ; ">", 4
+  ; "<", 4
+  ; "&&", 5
+  ; "||", 6
   ]
 ;;
 

OCamlPrintf/lib/inferencer.ml

@@ -114,9 +114,8 @@ let pp_scheme ppf = function
 
 module Type = struct
   let rec occurs_in var = function
-    | Type_option ty -> occurs_in var ty
+    | Type_option ty | Type_list ty -> occurs_in var ty
     | Type_var name -> name = var
-    | Type_list ty -> occurs_in var ty
     | Type_tuple (fst_ty, snd_ty, ty_list) ->
       List.exists (occurs_in var) (fst_ty :: snd_ty :: ty_list)
     | Type_arrow (l, r) -> occurs_in var l || occurs_in var r
@@ -125,11 +124,10 @@ module Type = struct
 
   let free_vars =
     let rec helper acc = function
-      | Type_option ty -> helper acc ty
+      | Type_option ty | Type_list ty -> helper acc ty
       | Type_var name -> VarSet.add name acc
       | Type_tuple (fst_ty, snd_ty, ty_list) ->
         List.fold_left helper acc (fst_ty :: snd_ty :: ty_list)
-      | Type_list ty -> helper acc ty
       | Type_arrow (l, r) -> helper (helper acc l) r
       | _ -> acc
     in
@@ -473,7 +471,7 @@ module Infer = struct
         extend_env_with_bind_names env (value_binding :: value_binding_list)
       in
       let* env, sub1 =
-        rec_infer_value_binding_list
+        infer_rec_value_binding_list
           env
           fresh_acc
           Subst.empty
@@ -496,6 +494,7 @@ module Infer = struct
       let* required_arg_ty, required_result_ty =
         match opr with
         | "*" | "/" | "+" | "-" -> return (Type_int, Type_int)
+        | "^" -> return (Type_string, Type_string)
         | ">=" | "<=" | "<>" | "=" | ">" | "<" ->
           let* fresh = fresh_var in
           return (fresh, Type_bool)
@@ -702,8 +701,8 @@ module Infer = struct
       let* new_sub, ty = infer_expression env exp in
       infer_vb new_sub env ty pat rest
 
-  and rec_infer_value_binding_list ?(debug = false) env fresh_acc sub let_binds =
-    let rec_infer_vb new_sub fresh ty id fresh_acc rest ~required_ty =
+  and infer_rec_value_binding_list ?(debug = false) env fresh_acc sub let_binds =
+    let infer_rec_vb new_sub fresh ty id fresh_acc rest ~required_ty =
       let* new_sub =
         match required_ty with
         | Some c_ty ->
@@ -720,73 +719,73 @@ module Infer = struct
       in
       if debug then pp_scheme Format.std_formatter generalized_ty;
       let env = TypeEnv.extend env id generalized_ty in
-      rec_infer_value_binding_list ~debug env fresh_acc composed_sub rest
+      infer_rec_value_binding_list ~debug env fresh_acc composed_sub rest
     in
     match let_binds, fresh_acc with
     | [], _ -> return (env, sub)
     | ( { pat = Pat_var id; exp = (Exp_fun _ | Exp_function _) as exp } :: rest
       , fresh :: fresh_acc ) ->
       let* new_sub, ty = infer_expression env exp in
-      rec_infer_vb new_sub fresh ty id fresh_acc rest ~required_ty:None
+      infer_rec_vb new_sub fresh ty id fresh_acc rest ~required_ty:None
     | ( { pat = Pat_constraint (Pat_var id, pat_ty); exp = Exp_fun (pat, pat_list, exp) }
         :: rest
       , fresh :: fresh_acc ) ->
       let* new_sub, ty =
         infer_expression env (Exp_fun (pat, pat_list, Exp_constraint (exp, pat_ty)))
       in
-      rec_infer_vb new_sub fresh ty id fresh_acc rest ~required_ty:None
+      infer_rec_vb new_sub fresh ty id fresh_acc rest ~required_ty:None
     | ( { pat = Pat_constraint (Pat_var id, pat_ty); exp = Exp_function _ as exp } :: rest
       , fresh :: fresh_acc ) ->
       let* new_sub, ty = infer_expression env (Exp_constraint (exp, pat_ty)) in
-      rec_infer_vb new_sub fresh ty id fresh_acc rest ~required_ty:None
+      infer_rec_vb new_sub fresh ty id fresh_acc rest ~required_ty:None
     | { pat = Pat_var id; exp } :: rest, fresh :: fresh_acc ->
       let* new_sub, ty = infer_expression env exp in
       let update_fresh = Subst.apply new_sub fresh in
       if ty = update_fresh
       then fail `No_arg_rec
-      else rec_infer_vb new_sub fresh ty id fresh_acc rest ~required_ty:None
+      else infer_rec_vb new_sub fresh ty id fresh_acc rest ~required_ty:None
     | { pat = Pat_constraint (Pat_var id, pat_ty); exp } :: rest, fresh :: fresh_acc ->
       let* new_sub, ty = infer_expression env exp in
       let update_fresh = Subst.apply new_sub fresh in
       if ty = update_fresh
       then fail `No_arg_rec
-      else rec_infer_vb new_sub fresh ty id fresh_acc rest ~required_ty:(Some pat_ty)
+      else infer_rec_vb new_sub fresh ty id fresh_acc rest ~required_ty:(Some pat_ty)
     | _ -> fail `No_variable_rec
   ;;
 
-  let infer_srtucture_item ?(debug = false) env ast =
+  let infer_structure_item ~debug (env, out_list) =
     let get_names_from_let_binds env =
       RList.fold_left ~init:(return []) ~f:(fun acc { pat; _ } ->
         extract_names_from_pat
           (fun acc id -> return (acc @ [ Some id, TypeEnv.find_type_exn env id ]))
           acc
           pat)
     in
-    let* _, out_list =
-      RList.fold_left
-        ast
-        ~init:(return (env, []))
-        ~f:(fun (env, out_list) ->
-          function
-          | Struct_eval exp ->
-            let* _, ty = infer_expression env exp in
-            return (env, out_list @ [ None, ty ])
-          | Struct_value (Nonrecursive, value_binding, value_binding_list) ->
-            let value_binding_list = value_binding :: value_binding_list in
-            let* _ = check_names_from_let_binds value_binding_list in
-            let* env, _ = infer_value_binding_list env Subst.empty value_binding_list in
-            let* id_list = get_names_from_let_binds env value_binding_list in
-            if debug then TypeEnv.pp Format.std_formatter env;
-            return (env, out_list @ id_list)
-          | Struct_value (Recursive, value_binding, value_binding_list) ->
-            let value_binding_list = value_binding :: value_binding_list in
-            let* env, fresh_acc = extend_env_with_bind_names env value_binding_list in
-            let* env, _ =
-              rec_infer_value_binding_list env fresh_acc Subst.empty value_binding_list
-            in
-            let* id_list = get_names_from_let_binds env value_binding_list in
-            if debug then TypeEnv.pp Format.std_formatter env;
-            return (env, out_list @ id_list))
+    function
+    | Struct_eval exp ->
+      let* _, ty = infer_expression env exp in
+      return (env, out_list @ [ None, ty ])
+    | Struct_value (Nonrecursive, value_binding, value_binding_list) ->
+      let value_binding_list = value_binding :: value_binding_list in
+      let* _ = check_names_from_let_binds value_binding_list in
+      let* env, _ = infer_value_binding_list env Subst.empty value_binding_list in
+      let* id_list = get_names_from_let_binds env value_binding_list in
+      if debug then TypeEnv.pp Format.std_formatter env;
+      return (env, out_list @ id_list)
+    | Struct_value (Recursive, value_binding, value_binding_list) ->
+      let value_binding_list = value_binding :: value_binding_list in
+      let* env, fresh_acc = extend_env_with_bind_names env value_binding_list in
+      let* env, _ =
+        infer_rec_value_binding_list env fresh_acc Subst.empty value_binding_list
+      in
+      let* id_list = get_names_from_let_binds env value_binding_list in
+      if debug then TypeEnv.pp Format.std_formatter env;
+      return (env, out_list @ id_list)
+  ;;
+
+  let infer_srtucture ~debug env ast =
+    let* env, out_list =
+      RList.fold_left ast ~init:(return (env, [])) ~f:(infer_structure_item ~debug)
     in
     let remove_duplicates =
       let fun_equal el1 el2 =
@@ -799,19 +798,24 @@ module Infer = struct
       | _ :: xs -> xs
       | [] -> []
     in
-    return (remove_duplicates out_list)
+    return (env, remove_duplicates out_list)
   ;;
 end
 
 let empty_env = TypeEnv.empty
 
-let env_with_print_int =
-  TypeEnv.extend
+let env_with_print_funs =
+  let print_fun_list =
+    [ "print_int", Scheme (VarSet.empty, Type_arrow (Type_int, Type_unit))
+    ; "print_endline", Scheme (VarSet.empty, Type_arrow (Type_string, Type_unit))
+    ]
+  in
+  List.fold_left
+    (fun env (id, sch) -> TypeEnv.extend env id sch)
     TypeEnv.empty
-    "print_int"
-    (Scheme (VarSet.empty, Type_arrow (Type_int, Type_unit)))
+    print_fun_list
 ;;
 
-let run_inferencer ?(debug = false) ast env =
-  State.run (Infer.infer_srtucture_item ~debug env ast)
+let run_inferencer ?(debug = false) env ast =
+  State.run (Infer.infer_srtucture ~debug env ast)
 ;;

OCamlPrintf/lib/inferencer.mli

@@ -36,10 +36,10 @@ module TypeEnv : sig
 end
 
 val empty_env : TypeEnv.t
-val env_with_print_int : TypeEnv.t
+val env_with_print_funs : TypeEnv.t
 
 val run_inferencer
   :  ?debug:bool
-  -> Ast.structure_item list
   -> TypeEnv.t
-  -> ((Ast.ident option * Ast.core_type) list, error) result
+  -> Ast.structure
+  -> (TypeEnv.t * (Ast.ident option * Ast.core_type) list, error) result