Added interface for the result of the type annotator.

This commit is contained in:
Georges Dupéron 2019-03-11 03:26:21 +01:00
parent 0fc4903ac2
commit ec706906f1
4 changed files with 226 additions and 6 deletions

12
AST2.ml
View File

@ -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) }

View File

@ -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
()

104
Typecheck2.ml Normal file
View File

@ -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

104
Typecheck2.mli Normal file
View File

@ -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