diff --git a/AST2.ml b/AST2.ml index 1ed380f76..2b255f53b 100644 --- a/AST2.ml +++ b/AST2.ml @@ -174,15 +174,15 @@ let s_operations_decl I.{value={kwd_operations;name;colon;op_type;terminator}; r let () = ignore (kwd_operations,colon,terminator,region) in O.{ name = s_name name; ty = s_type_expr op_type } -let s_empty_list I.{value=(l, (lbracket, rbracket, colon, type_expr), r); region} : O.expr = +let s_empty_list {value=(l, (lbracket, rbracket, colon, type_expr), r); region} : O.expr = let () = ignore (l, lbracket, rbracket, colon, r, region) in Constant (Null (s_type_expr type_expr)) -let s_empty_set I.{value=(l, (lbrace, rbrace, colon, type_expr), r); region} : O.expr = +let s_empty_set {value=(l, (lbrace, rbrace, colon, type_expr), r); region} : O.expr = let () = ignore (l, lbrace, rbrace, colon, r, region) in Constant (EmptySet (s_type_expr type_expr)) -let s_none I.{value=(l, (c_None, colon, type_expr), r); region} : O.expr = +let s_none {value=(l, (c_None, colon, type_expr), r); region} : O.expr = let () = ignore (l, c_None, colon, r, region) in Constant (CNone (s_type_expr type_expr)) @@ -231,18 +231,18 @@ and s_map_lookup I.{value = {map_name; selector; index}; region} : O.expr = let () = ignore (selector, lbracket, rbracket, region2, region) in App { operator = MapLookup; arguments = [Var (s_name map_name); s_expr index_expr] } -and s_some_app I.{value=(c_Some, {value=(l,arguments,r); region=region2}); region} : O.expr = +and s_some_app {value=(c_Some, {value=(l,arguments,r); region=region2}); region} : O.expr = let () = ignore (c_Some,l,r,region2,region) in match s_nsepseq arguments with [] -> Constant Unit | [a] -> s_expr a | l -> App { operator = Tuple; arguments = map s_expr l } -and s_list I.{value=(l, list, r); region} : O.expr = +and s_list {value=(l, list, r); region} : O.expr = let () = ignore (l, r, region) in App { operator = List; arguments = map s_expr (s_nsepseq list) } -and s_set I.{value=(l, set, r); region} : O.expr = +and s_set {value=(l, set, r); region} : O.expr = let () = ignore (l, r, region) in App { operator = Set; arguments = map s_expr (s_nsepseq set) } diff --git a/ParserMain.ml b/ParserMain.ml index 7644a6769..66b96fbca 100644 --- a/ParserMain.ml +++ b/ParserMain.ml @@ -69,3 +69,15 @@ let () = let () = close_all () in print_error ~offsets EvalOpt.mode error | Sys_error msg -> Utils.highlight msg + +(* Temporary: force dune to build AST2.ml *) +let () = + let open AST2 in + let _ = s_ast in + () + +(* Temporary: force dune to build AST2.ml *) +let () = + let open Typecheck2 in + let _ = temporary_force_dune in + () diff --git a/Typecheck2.ml b/Typecheck2.ml new file mode 100644 index 000000000..7f1b5866c --- /dev/null +++ b/Typecheck2.ml @@ -0,0 +1,104 @@ +[@@@warning "-30"] + +module SMap = Map.Make(String) + +module O = struct + type asttodo = [`TODO] (* occurrences of asttodo will point to some part of the original parser AST *) + + type type_name = string + type var_name = { name: string; orig: asttodo } + + type pattern = + PVar of var_name + | PWild + | PInt of Z.t + | PBytes of MBytes.t + | PString of string + | PUnit + | PFalse + | PTrue + | PNone + | PSome of pattern + | PCons of pattern * pattern + | PNull + | PTuple of pattern list + + type type_constructor = + | Option + | List + | Set + | Map + + type type_expr_case = + Prod of type_expr_case list + | Sum of (type_name * type_expr_case) list + | Record of (type_name * type_expr_case) list + | TypeApp of type_constructor * (type_expr_case list) + | Function of { args: type_expr_case list; ret: type_expr_case } + | Ref of type_expr_case + | TC of type_constructor + | String + | Int + | Unit + | Bool + + + type type_expr = { type_expr: type_expr_case; name: string option; orig: AST.type_expr } + + type typed_var = { name:var_name; ty:type_expr; orig: asttodo } + + type type_decl = { name:string; ty:type_expr; orig: asttodo } + + type expr_case = + App of { operator: operator; arguments: expr list } + | Var of typed_var + | Constant of constant + | Lambda of lambda + + and expr = { expr: expr_case; ty:type_expr; orig: asttodo } + + and decl = { var: typed_var; value: expr; orig: asttodo } + + and lambda = { + parameters: typed_var SMap.t; + declarations: decl list; + instructions: instr list; + result: expr; + } + + and operator_case = + Function of string + | Or | And | Lt | Leq | Gt | Geq | Equal | Neq | Cat | Cons | Add | Sub | Mult | Div | Mod + | Neg | Not + | Tuple | Set | List + | MapLookup + + and operator = { operator: operator_case; ty:type_expr; orig: asttodo } + + and constant = + Unit + | Int of Z.t | String of string | Bytes of MBytes.t + | False | True + | Null + | EmptySet + | CNone + + and instr = + Assignment of { name: var_name; value: expr; orig: asttodo } + | While of { condition: expr; body: instr list; orig: asttodo } + | ForCollection of { list: expr; key: var_name; value: var_name option; body: instr list; orig: asttodo } + | If of { condition: expr; ifso: instr list; ifnot: instr list; orig: asttodo } + | Match of { expr: expr; cases: (pattern * instr list) list; orig: asttodo } + | DropUnit of { expr: expr; orig: asttodo } (* expr returns unit, drop the result. Similar to OCaml's ";". *) + | Fail of { expr: expr; orig: asttodo } + + type ast = { + types : type_decl list; + storage_decl : typed_var; + operations_decl : typed_var; + declarations : decl list; + orig: AST.t + } +end + +let temporary_force_dune = 123 diff --git a/Typecheck2.mli b/Typecheck2.mli new file mode 100644 index 000000000..7f1b5866c --- /dev/null +++ b/Typecheck2.mli @@ -0,0 +1,104 @@ +[@@@warning "-30"] + +module SMap = Map.Make(String) + +module O = struct + type asttodo = [`TODO] (* occurrences of asttodo will point to some part of the original parser AST *) + + type type_name = string + type var_name = { name: string; orig: asttodo } + + type pattern = + PVar of var_name + | PWild + | PInt of Z.t + | PBytes of MBytes.t + | PString of string + | PUnit + | PFalse + | PTrue + | PNone + | PSome of pattern + | PCons of pattern * pattern + | PNull + | PTuple of pattern list + + type type_constructor = + | Option + | List + | Set + | Map + + type type_expr_case = + Prod of type_expr_case list + | Sum of (type_name * type_expr_case) list + | Record of (type_name * type_expr_case) list + | TypeApp of type_constructor * (type_expr_case list) + | Function of { args: type_expr_case list; ret: type_expr_case } + | Ref of type_expr_case + | TC of type_constructor + | String + | Int + | Unit + | Bool + + + type type_expr = { type_expr: type_expr_case; name: string option; orig: AST.type_expr } + + type typed_var = { name:var_name; ty:type_expr; orig: asttodo } + + type type_decl = { name:string; ty:type_expr; orig: asttodo } + + type expr_case = + App of { operator: operator; arguments: expr list } + | Var of typed_var + | Constant of constant + | Lambda of lambda + + and expr = { expr: expr_case; ty:type_expr; orig: asttodo } + + and decl = { var: typed_var; value: expr; orig: asttodo } + + and lambda = { + parameters: typed_var SMap.t; + declarations: decl list; + instructions: instr list; + result: expr; + } + + and operator_case = + Function of string + | Or | And | Lt | Leq | Gt | Geq | Equal | Neq | Cat | Cons | Add | Sub | Mult | Div | Mod + | Neg | Not + | Tuple | Set | List + | MapLookup + + and operator = { operator: operator_case; ty:type_expr; orig: asttodo } + + and constant = + Unit + | Int of Z.t | String of string | Bytes of MBytes.t + | False | True + | Null + | EmptySet + | CNone + + and instr = + Assignment of { name: var_name; value: expr; orig: asttodo } + | While of { condition: expr; body: instr list; orig: asttodo } + | ForCollection of { list: expr; key: var_name; value: var_name option; body: instr list; orig: asttodo } + | If of { condition: expr; ifso: instr list; ifnot: instr list; orig: asttodo } + | Match of { expr: expr; cases: (pattern * instr list) list; orig: asttodo } + | DropUnit of { expr: expr; orig: asttodo } (* expr returns unit, drop the result. Similar to OCaml's ";". *) + | Fail of { expr: expr; orig: asttodo } + + type ast = { + types : type_decl list; + storage_decl : typed_var; + operations_decl : typed_var; + declarations : decl list; + orig: AST.t + } +end + +let temporary_force_dune = 123