diff --git a/src/ligo/.old.transpiler.ml b/src/ligo/.old.transpiler.ml
new file mode 100644
index 000000000..8beb2b30f
--- /dev/null
+++ b/src/ligo/.old.transpiler.ml
@@ -0,0 +1,196 @@
+open Mini_c
+module AST = Ligo_parser.Typed.O
+module SMap = Ligo_parser.Typed.SMap
+
+module Rename = struct
+ open! AST
+
+ let rec rename_expr_case (src:string) (dst:string) : expr_case -> expr_case = function
+ | App {operator;arguments} -> App {operator = rename_operator src dst operator ; arguments = rename_exprs src dst arguments}
+ | Var n when n.name.name = src -> Var {n with name = {n.name with name = dst}}
+ | Var n -> Var n
+ | Constant c -> Constant c
+ | Record r -> Record (List.map (fun (key, expr) -> key, rename_expr src dst expr) r)
+ | Lambda {parameter} as l when parameter.name.name = src -> l
+ | Lambda ({instructions;declarations} as l) ->
+ Lambda {l with instructions = rename_instrs src dst instructions ; declarations = rename_declarations src dst declarations}
+
+ and rename_expr (src:string) (dst:string) (e : expr) : expr =
+ { e with expr = rename_expr_case src dst e.expr }
+
+ and rename_exprs src dst exprs = List.map (rename_expr src dst) exprs
+
+ and rename_operator_case (src:string) (dst:string) : operator_case -> operator_case = function
+ | Function n when n.name = src -> Function {n with name = dst}
+ | x -> x
+
+ and rename_operator src dst (o:operator) : operator = {o with operator = rename_operator_case src dst o.operator}
+
+ and rename_var src dst (v:var_name) : var_name =
+ if v.name = src
+ then {v with name = dst}
+ else v
+
+ and rename_instr (src:string) (dst:string) : instr -> instr = function
+ | Assignment {name;value;orig} when name.name = src -> Assignment {name = {name with name = dst};value;orig}
+ | Assignment {name;value;orig} -> Assignment {value = rename_expr src dst value;name;orig}
+ | While {condition;body;orig} -> While {condition = rename_expr src dst condition;body=rename_instrs src dst body;orig}
+ | ForCollection {list;var;body;orig} -> ForCollection {list = rename_expr src dst list;var = rename_var src dst var;
+ body = rename_instrs src dst body;orig}
+ | Match ({expr;cases} as a) -> Match {a with expr = rename_expr src dst expr ; cases = rename_match_cases src dst cases}
+ | ProcedureCall {expr;orig} -> ProcedureCall {expr = rename_expr src dst expr;orig}
+ | Fail {expr;orig} -> Fail {expr = rename_expr src dst expr;orig}
+
+ and rename_instrs src dst : instr list -> instr list = List.map (rename_instr src dst)
+
+ and rename_match_cases (src:string) (dst:string) (m:(_ * instr list) list) =
+ List.map (fun (x, y) -> x, rename_instrs src dst y) m
+
+ and rename_declaration (src:string) (dst:string) ({var} as d: decl) : decl =
+ if var.name.name = src
+ then {d with var = {var with name = {var.name with name = dst}}}
+ else d
+
+ and rename_declarations (src:string) (dst:string) (decls:decl list) =
+ List.map (rename_declaration src dst) decls
+end
+
+let list_of_map m = List.rev @@ SMap.fold (fun _ v prev -> v :: prev) m []
+
+let rec translate_type : AST.type_expr -> type_value result = fun {type_expr} ->
+ match type_expr with
+ | Unit -> ok (`Base Unit)
+ | Int -> ok (`Base Int)
+ | String -> ok (`Base String)
+ | Bool -> ok (`Base Bool)
+ | Sum m ->
+ let node = Append_tree.of_list @@ List.map snd @@ list_of_map m in
+ let aux a b : type_value result =
+ let%bind a = a in
+ let%bind b = b in
+ ok (`Or (a, b))
+ in
+ Append_tree.fold_ne translate_type aux node
+ | Record r ->
+ let node = Append_tree.of_list @@ List.map snd @@ list_of_map r in
+ let aux a b : type_value result =
+ let%bind a = a in
+ let%bind b = b in
+ ok (`Pair (a, b))
+ in
+ Append_tree.fold_ne translate_type aux node
+ | Ref t -> translate_type t
+ | Function {arg;ret} ->
+ let%bind arg = translate_type arg in
+ let%bind ret = translate_type ret in
+ ok (`Function(arg, ret))
+ | TypeApp _ -> simple_fail "No type application"
+
+let translate_constant : AST.constant -> value result = function
+ | Unit -> ok `Unit
+ | String s -> ok (`String s)
+ | Int n -> ok (`Int (Z.to_int n))
+ | False -> ok (`Bool false)
+ | True -> ok (`Bool true)
+ | _ -> simple_fail ""
+
+let rec translate_lambda : AST.lambda -> anon_function result =
+ fun {declarations;parameter;instructions;result} ->
+ let ({name;ty}:AST.typed_var) = parameter in
+ let%bind input_ty = translate_type ty in
+ let%bind output_ty = translate_type result.ty in
+ let%bind result = translate_expr result in
+ let%bind (declaration_statements : statement list) = translate_declarations declarations in
+ let%bind (instruction_statements : statement list) = translate_instructions instructions in
+ let body = declaration_statements @ instruction_statements in
+ ok {content={binder=name.name;input=input_ty;output=output_ty;body;result} ; capture = No_capture}
+
+and translate_expr' : AST.expr_case -> expression' result = function
+ | Var {name} -> ok (Var name.name)
+ | Constant cst ->
+ let%bind value = translate_constant cst in
+ ok (Literal value)
+ | Lambda _ -> simple_fail "Mini_c doesn't deal with lambda in expressions yet"
+ | _ -> simple_fail ""
+
+and translate_expr env : AST.expr -> expression result = fun {expr;ty} ->
+ let%bind expr = translate_expr' expr in
+ let%bind ty = translate_type ty in
+ ok (expr, ty, env)
+
+and translate_declaration : AST.decl -> statement result = fun {var;value} ->
+ let%bind expr = translate_expr value in
+ ok (Assignment(Variable(var.name.name, expr)))
+
+and translate_declarations : AST.decl list -> statement list result = fun declarations ->
+ bind_list @@ List.map translate_declaration declarations
+
+and translate_match (expr:AST.expr) (cases: (AST.pattern * AST.instr list) list) : statement result =
+ match cases with
+ | [(AST.PTrue, instrs_true) ; (AST.PFalse, instrs_false) ] ->
+ let%bind cond = translate_expr expr in
+ let%bind b_true = translate_instructions instrs_true in
+ let%bind b_false = translate_instructions instrs_false in
+ ok (Cond (cond, b_true, b_false))
+ | [(AST.PFalse, instrs_false) ; (AST.PTrue, instrs_true) ] ->
+ let%bind cond = translate_expr expr in
+ let%bind b_true = translate_instructions instrs_true in
+ let%bind b_false = translate_instructions instrs_false in
+ ok (Cond (cond, b_true, b_false))
+ | _ -> simple_fail "unrecognized pattern"
+
+and translate_instruction : AST.instr -> statement result = function
+ | Assignment {name ; value} ->
+ let%bind expr = translate_expr value in
+ ok (Assignment (Variable(name.name, expr)))
+ | While {condition ; body} ->
+ let%bind block = translate_instructions body in
+ let%bind cond = translate_expr condition in
+ ok (While (cond, block))
+ | ForCollection _ -> simple_fail "We don't deal with for collection yet"
+ | Match {expr;cases} -> translate_match expr cases
+ | Fail _ -> simple_fail "Fail have to be added in Mini_C"
+ | ProcedureCall _ -> simple_fail "Drop Unit have to be added in Mini_C"
+
+and translate_instructions : AST.instr list -> statement list result = fun instrs ->
+ bind_list @@ List.map translate_instruction instrs
+
+let translate_program : AST.ast -> block result = fun {declarations} ->
+ translate_declarations declarations
+
+let rec to_mini_c_value' : (AST.expr_case * AST.type_expr) -> value result = function
+ | Constant c, _ -> translate_constant c
+ | App {arguments;operator = {operator = Constructor c ; ty = {type_expr = Sum lst}}}, _ ->
+ let node = Append_tree.of_list @@ List.map fst @@ list_of_map lst in
+ let%bind lst =
+ trace_option (simple_error "Not constructor of variant type") @@
+ Append_tree.exists_path (fun (x:AST.name_and_region) -> x.name = c.name) node in
+ let arg = List.hd arguments in
+ let%bind arg = to_mini_c_value arg in
+ let ors = List.fold_left (fun b a -> if a then `Right b else `Left b) arg (List.rev lst) in
+ ok ors
+ | App _, _ -> simple_fail "Applications aren't value"
+ | Record lst, _ ->
+ let node = Append_tree.of_list @@ List.map snd lst in
+ let aux a b =
+ let%bind a = a in
+ let%bind b = b in
+ ok (`Pair (a, b))
+ in
+ Append_tree.fold_ne to_mini_c_value aux node
+ | Lambda _, _-> simple_fail "Lambda aren't value yet"
+ | Var _, _-> simple_fail "Var aren't value yet"
+
+and to_mini_c_value : AST.expr -> value result = fun {expr;ty} ->
+ to_mini_c_value' (expr, ty)
+
+let ghost expr ty : AST.expr = {expr;ty;orig=`TODO}
+
+let of_mini_c_value ({type_expr} as ty, v : AST.type_expr * value) : AST.expr result = match (type_expr, v) with
+ | String, `String s -> ok @@ ghost (Constant (String s)) ty
+ | Bool, `Bool b -> ok @@ ghost (Constant (if b then True else False)) ty
+ | Unit, `Unit -> ok @@ ghost (Constant (Unit)) ty
+ | Int, `Int n -> ok @@ ghost (Constant (Int (Z.of_int n))) ty
+ | Function _, _ -> simple_fail "Functions aren't retrieved from Mini_C yet"
+ | _ -> simple_fail "of_mini_c_value error"
+
diff --git a/src/ligo/ast_simplified.ml b/src/ligo/ast_simplified.ml
index 99ae6824b..4af3fab57 100644
--- a/src/ligo/ast_simplified.ml
+++ b/src/ligo/ast_simplified.ml
@@ -41,18 +41,21 @@ and type_expression =
| Type_variable of type_name
| Type_constant of type_name * te list
+and lambda = {
+ binder: name ;
+ input_type: type_expression ;
+ output_type: type_expression ;
+ result: ae ;
+ body: block ;
+}
+
and expression =
(* Base *)
| Literal of literal
| Constant of name * ae list (* For language constants, like (Cons hd tl) or (plus i j) *)
| Variable of name
- | Lambda of {
- binder: name ;
- input_type: type_expression ;
- output_type: type_expression ;
- result: ae ;
- body: block ;
- }
+ | Lambda of lambda
+ | Application of ae * ae
(* Tuple *)
| Tuple of ae list
| Tuple_accessor of ae * int (* Access n'th tuple's element *)
@@ -63,6 +66,7 @@ and expression =
| Record_accessor of ae * string
and literal =
+ | Unit
| Bool of bool
| Number of int
| String of string
@@ -92,3 +96,126 @@ and matching =
match_some : name * b ;
}
| Match_tuple of (name * b) list
+
+let ae expression = {expression ; type_annotation = None}
+
+open Ligo_helpers.Trace
+
+module Simplify = struct
+ module Raw = Ligo_parser.AST
+
+ let nseq_to_list (hd, tl) = hd :: tl
+ let npseq_to_list (hd, tl) = hd :: (List.map snd tl)
+
+ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
+ match t with
+ | TPar x -> simpl_type_expression x.value.inside
+ | TAlias v -> ok @@ Type_variable v.value
+ | TApp x ->
+ let (name, tuple) = x.value in
+ let%bind lst = bind_list
+ @@ List.map simpl_type_expression
+ @@ npseq_to_list tuple.value.inside in
+ ok @@ Type_constant (name.value, lst)
+ | TProd p ->
+ let%bind lst = bind_list
+ @@ List.map simpl_type_expression
+ @@ npseq_to_list p.value in
+ ok @@ Type_tuple lst
+ | TRecord r ->
+ let aux = fun (x, y) -> let%bind y = simpl_type_expression y in ok (x, y) in
+ let%bind lst = bind_list
+ @@ List.map aux
+ @@ List.map (fun (x:Raw.field_decl Raw.reg) -> (x.value.field_name.value, x.value.field_type))
+ @@ npseq_to_list r.value.fields in
+ let m = List.fold_left (fun m (x, y) -> SMap.add x y m) SMap.empty lst in
+ ok @@ Type_record m
+ | TSum s ->
+ let aux (v:Raw.variant Raw.reg) =
+ let%bind te = simpl_list_type_expression
+ @@ npseq_to_list v.value.product.value in
+ ok (v.value.constr.value, te)
+ in
+ let%bind lst = bind_list
+ @@ List.map aux
+ @@ npseq_to_list s.value in
+ let m = List.fold_left (fun m (x, y) -> SMap.add x y m) SMap.empty lst in
+ ok @@ Type_sum m
+
+ and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result =
+ match lst with
+ | [] -> assert false
+ | [hd] -> simpl_type_expression hd
+ | lst ->
+ let%bind lst = bind_list @@ List.map simpl_type_expression lst in
+ ok @@ Type_tuple lst
+
+ let rec simpl_expression (t:Raw.expr) : ae result =
+ match t with
+ | EVar c -> ok @@ ae @@ Variable c.value
+ | ECall x ->
+ let (name, args) = x.value in
+ let f = name.value in
+ let%bind arg = simpl_list_expression
+ @@ npseq_to_list args.value.inside in
+ ok @@ ae @@ Application (ae @@ Variable f, arg)
+ | EPar x -> simpl_expression x.value.inside
+ | EUnit _ -> ok @@ ae @@ Literal Unit
+ | EBytes x -> ok @@ ae @@ Literal (Bytes (fst x.value))
+ | ETuple tpl ->
+ simpl_list_expression
+ @@ npseq_to_list tpl.value.inside
+ | EConstr (ConstrApp c) ->
+ let (c, args) = c.value in
+ let%bind arg =
+ simpl_list_expression
+ @@ npseq_to_list args.value.inside in
+ ok @@ ae @@ Constructor (c.value, arg)
+ | EArith (Add c) ->
+ let%bind (a, b) = simpl_binop c.value in
+ ok @@ ae @@ Constant ("ADD", [a;b])
+ | EArith (Int n) ->
+ let n = Z.to_int @@ snd @@ n.value in
+ ok @@ ae @@ Literal (Number n)
+ | EArith _ -> simple_fail "arith: not supported yet"
+ | EString (String s) ->
+ ok @@ ae @@ Literal (String s.value)
+ | EString _ -> simple_fail "string: not supported yet"
+ | _ -> simple_fail "todo"
+
+ and simpl_binop (t:_ Raw.bin_op) : (ae * ae) result =
+ let%bind a = simpl_expression t.arg1 in
+ let%bind b = simpl_expression t.arg2 in
+ ok (a, b)
+
+ and simpl_list_expression (lst:Raw.expr list) : ae result =
+ match lst with
+ | [] -> ok @@ ae @@ Literal Unit
+ | [hd] -> simpl_expression hd
+ | lst ->
+ let%bind lst = bind_list @@ List.map simpl_expression lst in
+ ok @@ ae @@ Tuple lst
+
+ and simpl_lambda (t:Raw.lambda_decl) : lambda result = simple_fail "todo"
+
+ and simpl_declaration (t:Raw.declaration) : declaration result =
+ let open! Raw in
+ match t with
+ | TypeDecl x ->
+ let {name;type_expr} : Raw.type_decl = x.value in
+ let%bind type_expression = simpl_type_expression type_expr in
+ ok @@ Type_declaration {type_name=name.value;type_expression}
+ | ConstDecl x ->
+ let {name;const_type;init} = x.value in
+ let%bind expression = simpl_expression init in
+ let%bind t = simpl_type_expression const_type in
+ let type_annotation = Some t in
+ ok @@ Constant_declaration {name=name.value;annotated_expression={expression with type_annotation}}
+ | LambdaDecl (FunDecl x) ->
+ let {name;param;ret_type;local_decls;block;return} : fun_decl = x.value in
+ simple_fail "todo"
+ | _ -> simple_fail "todo"
+
+ let simpl_program (t:Raw.ast) : program result =
+ bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl
+end
diff --git a/src/ligo/ligo-helpers/trace.ml b/src/ligo/ligo-helpers/trace.ml
index a3dc4e7f2..8fefe7910 100644
--- a/src/ligo/ligo-helpers/trace.ml
+++ b/src/ligo/ligo-helpers/trace.ml
@@ -38,6 +38,10 @@ let trace err = function
| Ok _ as o -> o
| Errors errs -> Errors (err :: errs)
+let to_option = function
+ | Ok o -> Some o
+ | Errors _ -> None
+
let trace_option error = function
| None -> fail error
| Some s -> ok s
diff --git a/src/ligo/ligo-parser/AST.ml b/src/ligo/ligo-parser/AST.ml
index 914950944..9ee644047 100644
--- a/src/ligo/ligo-parser/AST.ml
+++ b/src/ligo/ligo-parser/AST.ml
@@ -1,4 +1,4 @@
-(* Abstract Syntax Tree (AST) for Ligo *)
+(* Abstract Syntax Tree (AST) for LIGO *)
(* To disable warning about multiply-defined record labels. *)
@@ -37,9 +37,10 @@ let sepseq_to_region to_region = function
None -> Region.ghost
| Some seq -> nsepseq_to_region to_region seq
-(* Keywords of Ligo *)
+(* Keywords of LIGO *)
type kwd_begin = Region.t
+type kwd_case = Region.t
type kwd_const = Region.t
type kwd_down = Region.t
type kwd_else = Region.t
@@ -51,14 +52,14 @@ type kwd_function = Region.t
type kwd_if = Region.t
type kwd_in = Region.t
type kwd_is = Region.t
-type kwd_match = Region.t
+type kwd_map = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
-type kwd_null = Region.t
type kwd_of = Region.t
-type kwd_operations = Region.t
+type kwd_patch = Region.t
type kwd_procedure = Region.t
type kwd_record = Region.t
+type kwd_skip = Region.t
type kwd_step = Region.t
type kwd_storage = Region.t
type kwd_then = Region.t
@@ -89,7 +90,7 @@ type rbracket = Region.t
type cons = Region.t
type vbar = Region.t
type arrow = Region.t
-type ass = Region.t
+type assign = Region.t
type equal = Region.t
type colon = Region.t
type bool_or = Region.t
@@ -120,25 +121,29 @@ type field_name = string reg
type map_name = string reg
type constr = string reg
-(* Comma-separated non-empty lists *)
-
-type 'a csv = ('a, comma) nsepseq
-
-(* Bar-separated non-empty lists *)
-
-type 'a bsv = ('a, vbar) nsepseq
-
(* Parentheses *)
-type 'a par = (lpar * 'a * rpar) reg
+type 'a par = {
+ lpar : lpar;
+ inside : 'a;
+ rpar : rpar
+}
(* Brackets compounds *)
-type 'a brackets = (lbracket * 'a * rbracket) reg
+type 'a brackets = {
+ lbracket : lbracket;
+ inside : 'a;
+ rbracket : rbracket
+}
(* Braced compounds *)
-type 'a braces = (lbrace * 'a * rbrace) reg
+type 'a braces = {
+ lbrace : lbrace;
+ inside : 'a;
+ rbrace : rbrace
+}
(* The Abstract Syntax Tree *)
@@ -150,11 +155,9 @@ type t = {
and ast = t
and declaration =
- TypeDecl of type_decl reg
-| ConstDecl of const_decl reg
-| StorageDecl of storage_decl reg
-| OpDecl of operations_decl reg
-| LambdaDecl of lambda_decl
+ TypeDecl of type_decl reg
+| ConstDecl of const_decl reg
+| LambdaDecl of lambda_decl
and const_decl = {
kwd_const : kwd_const;
@@ -166,22 +169,6 @@ and const_decl = {
terminator : semi option
}
-and storage_decl = {
- kwd_storage : kwd_storage;
- name : variable;
- colon : colon;
- store_type : type_expr;
- terminator : semi option
-}
-
-and operations_decl = {
- kwd_operations : kwd_operations;
- name : variable;
- colon : colon;
- op_type : type_expr;
- terminator : semi option
-}
-
(* Type declarations *)
and type_decl = {
@@ -193,24 +180,36 @@ and type_decl = {
}
and type_expr =
- Prod of cartesian
-| Sum of (variant, vbar) nsepseq reg
-| Record of record_type
-| TypeApp of (type_name * type_tuple) reg
-| ParType of type_expr par
+ TProd of cartesian
+| TSum of (variant reg, vbar) nsepseq reg
+| TRecord of record_type reg
+| TApp of (type_name * type_tuple) reg
+| TPar of type_expr par reg
| TAlias of variable
and cartesian = (type_expr, times) nsepseq reg
-and variant = (constr * kwd_of * cartesian) reg
+and variant = {
+ constr : constr;
+ kwd_of : kwd_of;
+ product : cartesian
+}
-and record_type = (kwd_record * field_decls * kwd_end) reg
+and record_type = {
+ kwd_record : kwd_record;
+ fields : field_decls;
+ kwd_end : kwd_end
+}
-and field_decls = (field_decl, semi) nsepseq
+and field_decls = (field_decl reg, semi) nsepseq
-and field_decl = (variable * colon * type_expr) reg
+and field_decl = {
+ field_name : field_name;
+ colon : colon;
+ field_type : type_expr
+}
-and type_tuple = (type_name, comma) nsepseq par
+and type_tuple = (type_expr, comma) nsepseq par reg
(* Function and procedure declarations *)
@@ -246,22 +245,50 @@ and proc_decl = {
and entry_decl = {
kwd_entrypoint : kwd_entrypoint;
name : variable;
- param : parameters;
+ param : entry_params;
+ colon : colon;
+ ret_type : type_expr;
kwd_is : kwd_is;
local_decls : local_decl list;
block : block reg;
+ kwd_with : kwd_with;
+ return : expr;
terminator : semi option
}
-and parameters = (param_decl, semi) nsepseq par
+and parameters = (param_decl, semi) nsepseq par reg
+
+and entry_params = (entry_param_decl, semi) nsepseq par reg
+
+and entry_param_decl =
+ EntryConst of param_const reg
+| EntryVar of param_var reg
+| EntryStore of storage reg
+
+and storage = {
+ kwd_storage : kwd_storage;
+ var : variable;
+ colon : colon;
+ storage_type : type_expr
+}
and param_decl =
- ParamConst of param_const
-| ParamVar of param_var
+ ParamConst of param_const reg
+| ParamVar of param_var reg
-and param_const = (kwd_const * variable * colon * type_expr) reg
+and param_const = {
+ kwd_const : kwd_const;
+ var : variable;
+ colon : colon;
+ param_type : type_expr
+}
-and param_var = (kwd_var * variable * colon * type_expr) reg
+and param_var = {
+ kwd_var : kwd_var;
+ var : variable;
+ colon : colon;
+ param_type : type_expr
+}
and block = {
opening : kwd_begin;
@@ -280,25 +307,59 @@ and var_decl = {
name : variable;
colon : colon;
var_type : type_expr;
- ass : ass;
+ assign : assign;
init : expr;
terminator : semi option
}
-and instructions = (instruction, semi) nsepseq reg
+and instructions = (instruction, semi) nsepseq
and instruction =
Single of single_instr
| Block of block reg
and single_instr =
- Cond of conditional reg
-| Match of match_instr reg
-| Ass of ass_instr
-| Loop of loop
-| ProcCall of fun_call
-| Null of kwd_null
-| Fail of (kwd_fail * expr) reg
+ Cond of conditional reg
+| Case of case_instr reg
+| Assign of assignment reg
+| Loop of loop
+| ProcCall of fun_call
+| Fail of fail_instr reg
+| Skip of kwd_skip
+| RecordPatch of record_patch reg
+| MapPatch of map_patch reg
+
+and map_patch = {
+ kwd_patch : kwd_patch;
+ path : path;
+ kwd_with : kwd_with;
+ map_inj : map_injection reg
+}
+
+and map_injection = {
+ opening : kwd_map;
+ bindings : (binding reg, semi) nsepseq;
+ terminator : semi option;
+ close : kwd_end
+}
+
+and binding = {
+ source : expr;
+ arrow : arrow;
+ image : expr
+}
+
+and record_patch = {
+ kwd_patch : kwd_patch;
+ path : path;
+ kwd_with : kwd_with;
+ record_inj : record_injection reg
+}
+
+and fail_instr = {
+ kwd_fail : kwd_fail;
+ fail_expr : expr
+}
and conditional = {
kwd_if : kwd_if;
@@ -309,26 +370,46 @@ and conditional = {
ifnot : instruction
}
-and match_instr = {
- kwd_match : kwd_match;
+and case_instr = {
+ kwd_case : kwd_case;
expr : expr;
- kwd_with : kwd_with;
+ kwd_of : kwd_of;
lead_vbar : vbar option;
cases : cases;
kwd_end : kwd_end
}
-and cases = (case, vbar) nsepseq reg
+and cases = (case reg, vbar) nsepseq reg
-and case = (pattern * arrow * instruction) reg
+and case = {
+ pattern : pattern;
+ arrow : arrow;
+ instr : instruction
+}
-and ass_instr = (variable * ass * expr) reg
+and assignment = {
+ lhs : lhs;
+ assign : assign;
+ rhs : rhs
+}
+
+and lhs =
+ Path of path
+| MapPath of map_lookup reg
+
+and rhs =
+ Expr of expr
+| NoneExpr of c_None
and loop =
- While of while_loop
+ While of while_loop reg
| For of for_loop
-and while_loop = (kwd_while * expr * block reg) reg
+and while_loop = {
+ kwd_while : kwd_while;
+ cond : expr;
+ block : block reg
+}
and for_loop =
ForInt of for_int reg
@@ -336,7 +417,7 @@ and for_loop =
and for_int = {
kwd_for : kwd_for;
- ass : ass_instr;
+ assign : var_assign reg;
down : kwd_down option;
kwd_to : kwd_to;
bound : expr;
@@ -344,6 +425,12 @@ and for_int = {
block : block reg
}
+and var_assign = {
+ name : variable;
+ assign : assign;
+ expr : expr
+}
+
and for_collect = {
kwd_for : kwd_for;
var : variable;
@@ -356,150 +443,270 @@ and for_collect = {
(* Expressions *)
and expr =
- Or of (expr * bool_or * expr) reg
-| And of (expr * bool_and * expr) reg
-| Lt of (expr * lt * expr) reg
-| Leq of (expr * leq * expr) reg
-| Gt of (expr * gt * expr) reg
-| Geq of (expr * geq * expr) reg
-| Equal of (expr * equal * expr) reg
-| Neq of (expr * neq * expr) reg
-| Cat of (expr * cat * expr) reg
-| Cons of (expr * cons * expr) reg
-| Add of (expr * plus * expr) reg
-| Sub of (expr * minus * expr) reg
-| Mult of (expr * times * expr) reg
-| Div of (expr * slash * expr) reg
-| Mod of (expr * kwd_mod * expr) reg
-| Neg of (minus * expr) reg
-| Not of (kwd_not * expr) reg
-| Int of (Lexer.lexeme * Z.t) reg
-| Var of Lexer.lexeme reg
-| String of Lexer.lexeme reg
-| Bytes of (Lexer.lexeme * MBytes.t) reg
-| False of c_False
-| True of c_True
-| Unit of c_Unit
-| Tuple of tuple
-| List of (expr, comma) nsepseq brackets
-| EmptyList of empty_list
-| Set of (expr, comma) nsepseq braces
-| EmptySet of empty_set
-| NoneExpr of none_expr
-| FunCall of fun_call
-| ConstrApp of constr_app
-| SomeApp of (c_Some * arguments) reg
-| MapLookUp of map_lookup reg
-| ParExpr of expr par
+ ELogic of logic_expr
+| EArith of arith_expr
+| EString of string_expr
+| EList of list_expr
+| ESet of set_expr
+| EConstr of constr_expr
+| ERecord of record_expr
+| EMap of map_expr
+| EVar of Lexer.lexeme reg
+| ECall of fun_call
+| EBytes of (Lexer.lexeme * Hex.t) reg
+| EUnit of c_Unit
+| ETuple of tuple
+| EPar of expr par reg
-and tuple = (expr, comma) nsepseq par
+and map_expr =
+ MapLookUp of map_lookup reg
+| MapInj of map_injection reg
-and empty_list =
- (lbracket * rbracket * colon * type_expr) par
+and map_lookup = {
+ path : path;
+ index : expr brackets reg
+}
-and empty_set =
- (lbrace * rbrace * colon * type_expr) par
+and path =
+ Name of variable
+| RecordPath of record_projection reg
-and none_expr =
- (c_None * colon * type_expr) par
+and logic_expr =
+ BoolExpr of bool_expr
+| CompExpr of comp_expr
+
+and bool_expr =
+ Or of bool_or bin_op reg
+| And of bool_and bin_op reg
+| Not of kwd_not un_op reg
+| False of c_False
+| True of c_True
+
+and 'a bin_op = {
+ op : 'a;
+ arg1 : expr;
+ arg2 : expr
+}
+
+and 'a un_op = {
+ op : 'a;
+ arg : expr
+}
+
+and comp_expr =
+ Lt of lt bin_op reg
+| Leq of leq bin_op reg
+| Gt of gt bin_op reg
+| Geq of geq bin_op reg
+| Equal of equal bin_op reg
+| Neq of neq bin_op reg
+
+and arith_expr =
+ Add of plus bin_op reg
+| Sub of minus bin_op reg
+| Mult of times bin_op reg
+| Div of slash bin_op reg
+| Mod of kwd_mod bin_op reg
+| Neg of minus un_op reg
+| Int of (Lexer.lexeme * Z.t) reg
+
+and string_expr =
+ Cat of cat bin_op reg
+| String of Lexer.lexeme reg
+
+and list_expr =
+ Cons of cons bin_op reg
+| List of (expr, comma) nsepseq brackets reg
+| EmptyList of empty_list reg
+
+and set_expr =
+ Set of (expr, comma) nsepseq braces reg
+| EmptySet of empty_set reg
+
+and constr_expr =
+ SomeApp of (c_Some * arguments) reg
+| NoneExpr of none_expr reg
+| ConstrApp of (constr * arguments) reg
+
+and record_expr =
+ RecordInj of record_injection reg
+| RecordProj of record_projection reg
+
+and record_injection = {
+ opening : kwd_record;
+ fields : (field_assign reg, semi) nsepseq;
+ terminator : semi option;
+ close : kwd_end
+}
+
+and field_assign = {
+ field_name : field_name;
+ equal : equal;
+ field_expr : expr
+}
+
+and record_projection = {
+ record_name : variable;
+ selector : dot;
+ field_path : (field_name, dot) nsepseq
+}
+
+and tuple = (expr, comma) nsepseq par reg
+
+and empty_list = typed_empty_list par
+
+and typed_empty_list = {
+ lbracket : lbracket;
+ rbracket : rbracket;
+ colon : colon;
+ list_type : type_expr
+}
+
+and empty_set = typed_empty_set par
+
+and typed_empty_set = {
+ lbrace : lbrace;
+ rbrace : rbrace;
+ colon : colon;
+ set_type : type_expr
+}
+
+and none_expr = typed_none_expr par
+
+and typed_none_expr = {
+ c_None : c_None;
+ colon : colon;
+ opt_type : type_expr
+}
and fun_call = (fun_name * arguments) reg
and arguments = tuple
-and constr_app = (constr * arguments) reg
-
-and map_lookup = {
- map_name : variable;
- selector : dot;
- index : expr brackets
-}
-
(* Patterns *)
-and pattern = (core_pattern, cons) nsepseq reg
-
-and core_pattern =
- PVar of Lexer.lexeme reg
+and pattern =
+ PCons of (pattern, cons) nsepseq reg
+| PVar of Lexer.lexeme reg
| PWild of wild
| PInt of (Lexer.lexeme * Z.t) reg
-| PBytes of (Lexer.lexeme * MBytes.t) reg
+| PBytes of (Lexer.lexeme * Hex.t) reg
| PString of Lexer.lexeme reg
| PUnit of c_Unit
| PFalse of c_False
| PTrue of c_True
| PNone of c_None
-| PSome of (c_Some * core_pattern par) reg
+| PSome of (c_Some * pattern par reg) reg
| PList of list_pattern
-| PTuple of (core_pattern, comma) nsepseq par
+| PTuple of (pattern, comma) nsepseq par reg
and list_pattern =
- Sugar of (core_pattern, comma) sepseq brackets
-| Raw of (core_pattern * cons * pattern) par
+ Sugar of (pattern, comma) sepseq brackets reg
+| Raw of (pattern * cons * pattern) par reg
(* Projecting regions *)
open! Region
let type_expr_to_region = function
- Prod {region; _}
-| Sum {region; _}
-| Record {region; _}
-| TypeApp {region; _}
-| ParType {region; _}
+ TProd {region; _}
+| TSum {region; _}
+| TRecord {region; _}
+| TApp {region; _}
+| TPar {region; _}
| TAlias {region; _} -> region
-let expr_to_region = function
- Or {region; _}
-| And {region; _}
-| Lt {region; _}
-| Leq {region; _}
-| Gt {region; _}
-| Geq {region; _}
-| Equal {region; _}
-| Neq {region; _}
-| Cat {region; _}
-| Cons {region; _}
-| Add {region; _}
-| Sub {region; _}
-| Mult {region; _}
-| Div {region; _}
-| Mod {region; _}
-| Neg {region; _}
-| Not {region; _}
-| Int {region; _}
-| Var {region; _}
-| String {region; _}
-| Bytes {region; _}
-| False region
-| True region
-| Unit region
-| Tuple {region; _}
+let rec expr_to_region = function
+ ELogic e -> logic_expr_to_region e
+| EArith e -> arith_expr_to_region e
+| EString e -> string_expr_to_region e
+| EList e -> list_expr_to_region e
+| ESet e -> set_expr_to_region e
+| EConstr e -> constr_expr_to_region e
+| ERecord e -> record_expr_to_region e
+| EMap e -> map_expr_to_region e
+| EVar {region; _}
+| ECall {region; _}
+| EBytes {region; _}
+| EUnit region
+| ETuple {region; _}
+| EPar {region; _} -> region
+
+and map_expr_to_region = function
+ MapLookUp {region; _}
+| MapInj {region; _} -> region
+
+and logic_expr_to_region = function
+ BoolExpr e -> bool_expr_to_region e
+| CompExpr e -> comp_expr_to_region e
+
+and bool_expr_to_region = function
+ Or {region; _}
+| And {region; _}
+| Not {region; _}
+| False region
+| True region -> region
+
+and comp_expr_to_region = function
+ Lt {region; _}
+| Leq {region; _}
+| Gt {region; _}
+| Geq {region; _}
+| Equal {region; _}
+| Neq {region; _} -> region
+
+and arith_expr_to_region = function
+| Add {region; _}
+| Sub {region; _}
+| Mult {region; _}
+| Div {region; _}
+| Mod {region; _}
+| Neg {region; _}
+| Int {region; _} -> region
+
+and string_expr_to_region = function
+ Cat {region; _}
+| String {region; _} -> region
+
+and list_expr_to_region = function
+ Cons {region; _}
| List {region; _}
-| EmptyList {region; _}
-| Set {region; _}
-| EmptySet {region; _}
-| NoneExpr {region; _}
-| FunCall {region; _}
+| EmptyList {region; _} -> region
+
+and set_expr_to_region = function
+ Set {region; _}
+| EmptySet {region; _} -> region
+
+and constr_expr_to_region = function
+ NoneExpr {region; _}
| ConstrApp {region; _}
-| SomeApp {region; _}
-| MapLookUp {region; _}
-| ParExpr {region; _} -> region
+| SomeApp {region; _} -> region
+
+and record_expr_to_region = function
+ RecordInj {region; _}
+| RecordProj {region; _} -> region
+
+let path_to_region = function
+ Name var -> var.region
+| RecordPath {region; _} -> region
let instr_to_region = function
- Single Cond {region;_}
-| Single Match {region; _}
-| Single Ass {region; _}
+ Single Cond {region; _}
+| Single Case {region; _}
+| Single Assign {region; _}
| Single Loop While {region; _}
| Single Loop For ForInt {region; _}
| Single Loop For ForCollect {region; _}
| Single ProcCall {region; _}
-| Single Null region
+| Single Skip region
| Single Fail {region; _}
+| Single RecordPatch {region; _}
+| Single MapPatch {region; _}
| Block {region; _} -> region
-let core_pattern_to_region = function
- PVar {region; _}
+let pattern_to_region = function
+ PCons {region; _}
+| PVar {region; _}
| PWild region
| PInt {region; _}
| PBytes {region; _}
@@ -520,6 +727,14 @@ let local_decl_to_region = function
| LocalConst {region; _}
| LocalVar {region; _} -> region
+let lhs_to_region = function
+ Path path -> path_to_region path
+| MapPath {region; _} -> region
+
+let rhs_to_region = function
+ Expr e -> expr_to_region e
+| NoneExpr r -> r
+
(* Printing the tokens with their source regions *)
let printf = Printf.printf
@@ -558,7 +773,7 @@ let print_string {region; value=lexeme} =
let print_bytes {region; value = lexeme, abstract} =
printf "%s: Bytes (\"%s\", \"0x%s\")\n"
(compact region) lexeme
- (MBytes.to_hex abstract |> Hex.to_string)
+ (Hex.to_string abstract)
let print_int {region; value = lexeme, abstract} =
printf "%s: Int (\"%s\", %s)\n"
@@ -573,11 +788,9 @@ let rec print_tokens ast =
print_token eof "EOF"
and print_decl = function
- TypeDecl decl -> print_type_decl decl
-| ConstDecl decl -> print_const_decl decl
-| StorageDecl decl -> print_storage_decl decl
-| OpDecl decl -> print_operations_decl decl
-| LambdaDecl decl -> print_lambda_decl decl
+ TypeDecl decl -> print_type_decl decl
+| ConstDecl decl -> print_const_decl decl
+| LambdaDecl decl -> print_lambda_decl decl
and print_const_decl {value; _} =
let {kwd_const; name; colon; const_type;
@@ -590,24 +803,6 @@ and print_const_decl {value; _} =
print_expr init;
print_terminator terminator
-and print_storage_decl {value; _} =
- let {kwd_storage; name; colon;
- store_type; terminator} = value in
- print_token kwd_storage "storage";
- print_var name;
- print_token colon ":";
- print_type_expr store_type;
- print_terminator terminator
-
-and print_operations_decl {value; _} =
- let {kwd_operations; name; colon;
- op_type; terminator} = value in
- print_token kwd_operations "operations";
- print_var name;
- print_token colon ":";
- print_type_expr op_type;
- print_terminator terminator
-
and print_type_decl {value; _} =
let {kwd_type; name; kwd_is;
type_expr; terminator} = value in
@@ -618,29 +813,29 @@ and print_type_decl {value; _} =
print_terminator terminator
and print_type_expr = function
- Prod cartesian -> print_cartesian cartesian
-| Sum sum_type -> print_sum_type sum_type
-| Record record_type -> print_record_type record_type
-| TypeApp type_app -> print_type_app type_app
-| ParType par_type -> print_par_type par_type
+ TProd cartesian -> print_cartesian cartesian
+| TSum sum_type -> print_sum_type sum_type
+| TRecord record_type -> print_record_type record_type
+| TApp type_app -> print_type_app type_app
+| TPar par_type -> print_par_type par_type
| TAlias type_alias -> print_var type_alias
and print_cartesian {value; _} =
print_nsepseq "*" print_type_expr value
and print_variant {value; _} =
- let constr, kwd_of, cartesian = value in
+ let {constr; kwd_of; product} = value in
print_constr constr;
print_token kwd_of "of";
- print_cartesian cartesian
+ print_cartesian product
and print_sum_type {value; _} =
print_nsepseq "|" print_variant value
and print_record_type {value; _} =
- let kwd_record, field_decls, kwd_end = value in
+ let {kwd_record; fields; kwd_end} = value in
print_token kwd_record "record";
- print_field_decls field_decls;
+ print_field_decls fields;
print_token kwd_end "end"
and print_type_app {value; _} =
@@ -649,24 +844,24 @@ and print_type_app {value; _} =
print_type_tuple type_tuple
and print_par_type {value; _} =
- let lpar, type_expr, rpar = value in
+ let {lpar; inside; rpar} = value in
print_token lpar "(";
- print_type_expr type_expr;
+ print_type_expr inside;
print_token rpar ")"
and print_field_decls sequence =
print_nsepseq ";" print_field_decl sequence
and print_field_decl {value; _} =
- let var, colon, type_expr = value in
- print_var var;
+ let {field_name; colon; field_type} = value in
+ print_var field_name;
print_token colon ":";
- print_type_expr type_expr
+ print_type_expr field_type
and print_type_tuple {value; _} =
- let lpar, sequence, rpar = value in
+ let {lpar; inside; rpar} = value in
print_token lpar "(";
- print_nsepseq "," print_var sequence;
+ print_nsepseq "," print_type_expr inside;
print_token rpar ")"
and print_lambda_decl = function
@@ -702,20 +897,43 @@ and print_proc_decl {value; _} =
print_terminator terminator
and print_entry_decl {value; _} =
- let {kwd_entrypoint; name; param; kwd_is;
- local_decls; block; terminator} = value in
- print_token kwd_entrypoint "entrypoint";
- print_var name;
- print_parameters param;
- print_token kwd_is "is";
- print_local_decls local_decls;
- print_block block;
- print_terminator terminator
+ let {kwd_entrypoint; name; param; colon;
+ ret_type; kwd_is; local_decls;
+ block; kwd_with; return; terminator} = value in
+ print_token kwd_entrypoint "entrypoint";
+ print_var name;
+ print_entry_params param;
+ print_token colon ":";
+ print_type_expr ret_type;
+ print_token kwd_is "is";
+ print_local_decls local_decls;
+ print_block block;
+ print_token kwd_with "with";
+ print_expr return;
+ print_terminator terminator
+
+and print_entry_params {value; _} =
+ let {lpar; inside; rpar} = value in
+ print_token lpar "(";
+ print_nsepseq ";" print_entry_param_decl inside;
+ print_token rpar ")"
+
+and print_entry_param_decl = function
+ EntryConst param_const -> print_param_const param_const
+| EntryVar param_var -> print_param_var param_var
+| EntryStore param_store -> print_storage param_store
+
+and print_storage {value; _} =
+ let {kwd_storage; var; colon; storage_type} = value in
+ print_token kwd_storage "storage";
+ print_var var;
+ print_token colon ":";
+ print_type_expr storage_type
and print_parameters {value; _} =
- let lpar, sequence, rpar = value in
+ let {lpar; inside; rpar} = value in
print_token lpar "(";
- print_nsepseq ";" print_param_decl sequence;
+ print_nsepseq ";" print_param_decl inside;
print_token rpar ")"
and print_param_decl = function
@@ -723,18 +941,18 @@ and print_param_decl = function
| ParamVar param_var -> print_param_var param_var
and print_param_const {value; _} =
- let kwd_const, variable, colon, type_expr = value in
+ let {kwd_const; var; colon; param_type} = value in
print_token kwd_const "const";
- print_var variable;
+ print_var var;
print_token colon ":";
- print_type_expr type_expr
+ print_type_expr param_type
and print_param_var {value; _} =
- let kwd_var, variable, colon, type_expr = value in
+ let {kwd_var; var; colon; param_type} = value in
print_token kwd_var "var";
- print_var variable;
+ print_var var;
print_token colon ":";
- print_type_expr type_expr
+ print_type_expr param_type
and print_block {value; _} =
let {opening; instr; terminator; close} = value in
@@ -753,34 +971,36 @@ and print_local_decl = function
and print_var_decl {value; _} =
let {kwd_var; name; colon; var_type;
- ass; init; terminator} = value in
+ assign; init; terminator} = value in
print_token kwd_var "var";
print_var name;
print_token colon ":";
print_type_expr var_type;
- print_token ass ":=";
+ print_token assign ":=";
print_expr init;
print_terminator terminator
-and print_instructions {value; _} =
- print_nsepseq ";" print_instruction value
+and print_instructions sequence =
+ print_nsepseq ";" print_instruction sequence
and print_instruction = function
Single instr -> print_single_instr instr
| Block block -> print_block block
and print_single_instr = function
- Cond {value; _} -> print_conditional value
-| Match {value; _} -> print_match_instr value
-| Ass instr -> print_ass_instr instr
-| Loop loop -> print_loop loop
-| ProcCall fun_call -> print_fun_call fun_call
-| Null kwd_null -> print_token kwd_null "null"
-| Fail {value; _} -> print_fail value
+ Cond {value; _} -> print_conditional value
+| Case {value; _} -> print_case_instr value
+| Assign assign -> print_assignment assign
+| Loop loop -> print_loop loop
+| ProcCall fun_call -> print_fun_call fun_call
+| Fail {value; _} -> print_fail value
+| Skip kwd_skip -> print_token kwd_skip "skip"
+| RecordPatch {value; _} -> print_record_patch value
+| MapPatch {value; _} -> print_map_patch value
-and print_fail (kwd_fail, expr) =
+and print_fail {kwd_fail; fail_expr} =
print_token kwd_fail "fail";
- print_expr expr
+ print_expr fail_expr
and print_conditional node =
let {kwd_if; test; kwd_then; ifso;
@@ -792,12 +1012,12 @@ and print_conditional node =
print_token kwd_else "else";
print_instruction ifnot
-and print_match_instr node =
- let {kwd_match; expr; kwd_with;
+and print_case_instr (node : case_instr) =
+ let {kwd_case; expr; kwd_of;
lead_vbar; cases; kwd_end} = node in
- print_token kwd_match "match";
+ print_token kwd_case "case";
print_expr expr;
- print_token kwd_with "with";
+ print_token kwd_of "of";
print_token_opt lead_vbar "|";
print_cases cases;
print_token kwd_end "end"
@@ -810,25 +1030,33 @@ and print_cases {value; _} =
print_nsepseq "|" print_case value
and print_case {value; _} =
- let pattern, arrow, instruction = value in
+ let {pattern; arrow; instr} = value in
print_pattern pattern;
print_token arrow "->";
- print_instruction instruction
+ print_instruction instr
-and print_ass_instr {value; _} =
- let variable, ass, expr = value in
- print_var variable;
- print_token ass ":=";
- print_expr expr
+and print_assignment {value; _} =
+ let {lhs; assign; rhs} = value in
+ print_lhs lhs;
+ print_token assign ":=";
+ print_rhs rhs
+
+and print_rhs = function
+ Expr e -> print_expr e
+| NoneExpr r -> print_token r "None"
+
+and print_lhs = function
+ Path path -> print_path path
+| MapPath {value; _} -> print_map_lookup value
and print_loop = function
- While while_loop -> print_while_loop while_loop
+ While {value; _} -> print_while_loop value
| For for_loop -> print_for_loop for_loop
-and print_while_loop {value; _} =
- let kwd_while, expr, block = value in
+and print_while_loop value =
+ let {kwd_while; cond; block} = value in
print_token kwd_while "while";
- print_expr expr;
+ print_expr cond;
print_block block
and print_for_loop = function
@@ -836,15 +1064,21 @@ and print_for_loop = function
| ForCollect for_collect -> print_for_collect for_collect
and print_for_int ({value; _} : for_int reg) =
- let {kwd_for; ass; down; kwd_to;
+ let {kwd_for; assign; down; kwd_to;
bound; step; block} = value in
- print_token kwd_for "for";
- print_ass_instr ass;
- print_down down;
- print_token kwd_to "to";
- print_expr bound;
- print_step step;
- print_block block
+ print_token kwd_for "for";
+ print_var_assign assign;
+ print_down down;
+ print_token kwd_to "to";
+ print_expr bound;
+ print_step step;
+ print_block block
+
+and print_var_assign {value; _} =
+ let {name; assign; expr} = value in
+ print_var name;
+ print_token assign ":=";
+ print_expr expr
and print_down = function
Some kwd_down -> print_token kwd_down "down"
@@ -857,8 +1091,7 @@ and print_step = function
| None -> ()
and print_for_collect ({value; _} : for_collect reg) =
- let {kwd_for; var; bind_to;
- kwd_in; expr; block} = value in
+ let {kwd_for; var; bind_to; kwd_in; expr; block} = value in
print_token kwd_for "for";
print_var var;
print_bind_to bind_to;
@@ -873,103 +1106,198 @@ and print_bind_to = function
| None -> ()
and print_expr = function
- Or {value = expr1, bool_or, expr2; _} ->
- print_expr expr1; print_token bool_or "||"; print_expr expr2
-| And {value = expr1, bool_and, expr2; _} ->
- print_expr expr1; print_token bool_and "&&"; print_expr expr2
-| Lt {value = expr1, lt, expr2; _} ->
- print_expr expr1; print_token lt "<"; print_expr expr2
-| Leq {value = expr1, leq, expr2; _} ->
- print_expr expr1; print_token leq "<="; print_expr expr2
-| Gt {value = expr1, gt, expr2; _} ->
- print_expr expr1; print_token gt ">"; print_expr expr2
-| Geq {value = expr1, geq, expr2; _} ->
- print_expr expr1; print_token geq ">="; print_expr expr2
-| Equal {value = expr1, equal, expr2; _} ->
- print_expr expr1; print_token equal "="; print_expr expr2
-| Neq {value = expr1, neq, expr2; _} ->
- print_expr expr1; print_token neq "=/="; print_expr expr2
-| Cat {value = expr1, cat, expr2; _} ->
- print_expr expr1; print_token cat "^"; print_expr expr2
-| Cons {value = expr1, cons, expr2; _} ->
- print_expr expr1; print_token cons "#"; print_expr expr2
-| Add {value = expr1, add, expr2; _} ->
- print_expr expr1; print_token add "+"; print_expr expr2
-| Sub {value = expr1, sub, expr2; _} ->
- print_expr expr1; print_token sub "-"; print_expr expr2
-| Mult {value = expr1, mult, expr2; _} ->
- print_expr expr1; print_token mult "*"; print_expr expr2
-| Div {value = expr1, div, expr2; _} ->
- print_expr expr1; print_token div "/"; print_expr expr2
-| Mod {value = expr1, kwd_mod, expr2; _} ->
- print_expr expr1; print_token kwd_mod "mod"; print_expr expr2
-| Neg {value = minus, expr; _} ->
- print_token minus "-"; print_expr expr
-| Not {value = kwd_not, expr; _} ->
- print_token kwd_not "not"; print_expr expr
-| Int i -> print_int i
-| Var var -> print_var var
-| String s -> print_string s
-| Bytes b -> print_bytes b
-| False region -> print_token region "False"
-| True region -> print_token region "True"
-| Unit region -> print_token region "Unit"
-| Tuple tuple -> print_tuple tuple
-| List list -> print_list list
-| EmptyList elist -> print_empty_list elist
-| Set set -> print_set set
-| EmptySet eset -> print_empty_set eset
-| NoneExpr nexpr -> print_none_expr nexpr
-| FunCall fun_call -> print_fun_call fun_call
-| ConstrApp capp -> print_constr_app capp
-| SomeApp sapp -> print_some_app sapp
-| MapLookUp lookup -> print_map_lookup lookup
-| ParExpr pexpr -> print_par_expr pexpr
+ ELogic e -> print_logic_expr e
+| EArith e -> print_arith_expr e
+| EString e -> print_string_expr e
+| EList e -> print_list_expr e
+| ESet e -> print_set_expr e
+| EConstr e -> print_constr_expr e
+| ERecord e -> print_record_expr e
+| EMap e -> print_map_expr e
+| EVar v -> print_var v
+| ECall e -> print_fun_call e
+| EBytes b -> print_bytes b
+| EUnit r -> print_token r "Unit"
+| ETuple e -> print_tuple e
+| EPar e -> print_par_expr e
+
+and print_map_expr = function
+ MapLookUp {value; _} -> print_map_lookup value
+| MapInj inj ->
+ print_map_injection inj
+
+and print_map_lookup {path; index} =
+ let {lbracket; inside; rbracket} = index.value in
+ print_path path;
+ print_token lbracket "[";
+ print_expr inside;
+ print_token rbracket "]"
+
+and print_path = function
+ Name var -> print_var var
+| RecordPath path -> print_record_projection path
+
+and print_logic_expr = function
+ BoolExpr e -> print_bool_expr e
+| CompExpr e -> print_comp_expr e
+
+and print_bool_expr = function
+ Or {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "||"; print_expr arg2
+| And {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "&&"; print_expr arg2
+| Not {value = {op; arg}; _} ->
+ print_token op "not"; print_expr arg
+| False region -> print_token region "False"
+| True region -> print_token region "True"
+
+and print_comp_expr = function
+ Lt {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "<"; print_expr arg2
+| Leq {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "<="; print_expr arg2
+| Gt {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op ">"; print_expr arg2
+| Geq {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op ">="; print_expr arg2
+| Equal {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "="; print_expr arg2
+| Neq {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "=/="; print_expr arg2
+
+and print_arith_expr = function
+ Add {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "+"; print_expr arg2
+| Sub {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "-"; print_expr arg2
+| Mult {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "*"; print_expr arg2
+| Div {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "/"; print_expr arg2
+| Mod {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "mod"; print_expr arg2
+| Neg {value = {op; arg}; _} ->
+ print_token op "-"; print_expr arg
+| Int i -> print_int i
+
+and print_string_expr = function
+ Cat {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "^"; print_expr arg2
+| String s -> print_string s
+
+and print_list_expr = function
+ Cons {value = {arg1; op; arg2}; _} ->
+ print_expr arg1; print_token op "#"; print_expr arg2
+| List e -> print_list e
+| EmptyList e -> print_empty_list e
+
+and print_set_expr = function
+ Set e -> print_set e
+| EmptySet e -> print_empty_set e
+
+and print_constr_expr = function
+ SomeApp e -> print_some_app e
+| NoneExpr e -> print_none_expr e
+| ConstrApp e -> print_constr_app e
+
+and print_record_expr = function
+ RecordInj e -> print_record_injection e
+| RecordProj e -> print_record_projection e
+
+and print_record_injection {value; _} =
+ let {opening; fields; terminator; close} = value in
+ print_token opening "record";
+ print_nsepseq ";" print_field_assign fields;
+ print_terminator terminator;
+ print_token close "end"
+
+and print_field_assign {value; _} =
+ let {field_name; equal; field_expr} = value in
+ print_var field_name;
+ print_token equal "=";
+ print_expr field_expr
+
+and print_record_projection {value; _} =
+ let {record_name; selector; field_path} = value in
+ print_var record_name;
+ print_token selector ".";
+ print_field_path field_path
+
+and print_field_path sequence =
+ print_nsepseq "." print_var sequence
+
+and print_record_patch node =
+ let {kwd_patch; path; kwd_with; record_inj} = node in
+ print_token kwd_patch "patch";
+ print_path path;
+ print_token kwd_with "with";
+ print_record_injection record_inj
+
+and print_map_patch node =
+ let {kwd_patch; path; kwd_with; map_inj} = node in
+ print_token kwd_patch "patch";
+ print_path path;
+ print_token kwd_with "with";
+ print_map_injection map_inj
+
+and print_map_injection {value; _} =
+ let {opening; bindings; terminator; close} = value in
+ print_token opening "record";
+ print_nsepseq ";" print_binding bindings;
+ print_terminator terminator;
+ print_token close "end"
+
+and print_binding {value; _} =
+ let {source; arrow; image} = value in
+ print_expr source;
+ print_token arrow "->";
+ print_expr image
and print_tuple {value; _} =
- let lpar, sequence, rpar = value in
+ let {lpar; inside; rpar} = value in
print_token lpar "(";
- print_nsepseq "," print_expr sequence;
+ print_nsepseq "," print_expr inside;
print_token rpar ")"
and print_list {value; _} =
- let lbra, sequence, rbra = value in
- print_token lbra "[";
- print_nsepseq "," print_expr sequence;
- print_token rbra "]"
+ let {lbracket; inside; rbracket} = value in
+ print_token lbracket "[";
+ print_nsepseq "," print_expr inside;
+ print_token rbracket "]"
and print_empty_list {value; _} =
- let lpar, (lbracket, rbracket, colon, type_expr),
- rpar = value in
+ let {lpar; inside; rpar} = value in
+ let {lbracket; rbracket; colon; list_type} = inside in
print_token lpar "(";
print_token lbracket "[";
print_token rbracket "]";
print_token colon ":";
- print_type_expr type_expr;
+ print_type_expr list_type;
print_token rpar ")"
and print_set {value; _} =
- let lbrace, sequence, rbrace = value in
+ let {lbrace; inside; rbrace} = value in
print_token lbrace "{";
- print_nsepseq "," print_expr sequence;
+ print_nsepseq "," print_expr inside;
print_token rbrace "}"
and print_empty_set {value; _} =
- let lpar, (lbrace, rbrace, colon, type_expr),
- rpar = value in
+ let {lpar; inside; rpar} = value in
+ let {lbrace; rbrace; colon; set_type} = inside in
print_token lpar "(";
print_token lbrace "{";
print_token rbrace "}";
print_token colon ":";
- print_type_expr type_expr;
+ print_type_expr set_type;
print_token rpar ")"
and print_none_expr {value; _} =
- let lpar, (c_None, colon, type_expr), rpar = value in
+ let {lpar; inside; rpar} = value in
+ let {c_None; colon; opt_type} = inside in
print_token lpar "(";
print_token c_None "None";
print_token colon ":";
- print_type_expr type_expr;
+ print_type_expr opt_type;
print_token rpar ")"
and print_fun_call {value; _} =
@@ -987,37 +1315,26 @@ and print_some_app {value; _} =
print_token c_Some "Some";
print_tuple arguments
-and print_map_lookup {value; _} =
- let {map_name; selector; index} = value in
- let {value = lbracket, expr, rbracket; _} = index in
- print_var map_name;
- print_token selector ".";
- print_token lbracket "[";
- print_expr expr;
- print_token rbracket "]"
-
and print_par_expr {value; _} =
- let lpar, expr, rpar = value in
+ let {lpar; inside; rpar} = value in
print_token lpar "(";
- print_expr expr;
+ print_expr inside;
print_token rpar ")"
-and print_pattern {value; _} =
- print_nsepseq "#" print_core_pattern value
-
-and print_core_pattern = function
- PVar var -> print_var var
-| PWild wild -> print_token wild "_"
-| PInt i -> print_int i
-| PBytes b -> print_bytes b
-| PString s -> print_string s
-| PUnit region -> print_token region "Unit"
-| PFalse region -> print_token region "False"
-| PTrue region -> print_token region "True"
-| PNone region -> print_token region "None"
-| PSome psome -> print_psome psome
-| PList pattern -> print_list_pattern pattern
-| PTuple ptuple -> print_ptuple ptuple
+and print_pattern = function
+ PCons {value; _} -> print_nsepseq "#" print_pattern value
+| PVar var -> print_var var
+| PWild wild -> print_token wild "_"
+| PInt i -> print_int i
+| PBytes b -> print_bytes b
+| PString s -> print_string s
+| PUnit region -> print_token region "Unit"
+| PFalse region -> print_token region "False"
+| PTrue region -> print_token region "True"
+| PNone region -> print_token region "None"
+| PSome psome -> print_psome psome
+| PList pattern -> print_list_pattern pattern
+| PTuple ptuple -> print_ptuple ptuple
and print_psome {value; _} =
let c_Some, patterns = value in
@@ -1025,9 +1342,9 @@ and print_psome {value; _} =
print_patterns patterns
and print_patterns {value; _} =
- let lpar, core_pattern, rpar = value in
+ let {lpar; inside; rpar} = value in
print_token lpar "(";
- print_core_pattern core_pattern;
+ print_pattern inside;
print_token rpar ")"
and print_list_pattern = function
@@ -1035,23 +1352,24 @@ and print_list_pattern = function
| Raw raw -> print_raw raw
and print_sugar {value; _} =
- let lbracket, sequence, rbracket = value in
+ let {lbracket; inside; rbracket} = value in
print_token lbracket "[";
- print_sepseq "," print_core_pattern sequence;
+ print_sepseq "," print_pattern inside;
print_token rbracket "]"
and print_raw {value; _} =
- let lpar, (core_pattern, cons, pattern), rpar = value in
- print_token lpar "(";
- print_core_pattern core_pattern;
- print_token cons "#";
- print_pattern pattern;
- print_token rpar ")"
+ let {lpar; inside; rpar} = value in
+ let head, cons, tail = inside in
+ print_token lpar "(";
+ print_pattern head;
+ print_token cons "#";
+ print_pattern tail;
+ print_token rpar ")"
and print_ptuple {value; _} =
- let lpar, sequence, rpar = value in
+ let {lpar; inside; rpar} = value in
print_token lpar "(";
- print_nsepseq "," print_core_pattern sequence;
+ print_nsepseq "," print_pattern inside;
print_token rpar ")"
and print_terminator = function
diff --git a/src/ligo/ligo-parser/AST.mli b/src/ligo/ligo-parser/AST.mli
index 1b2611d93..5a7777499 100644
--- a/src/ligo/ligo-parser/AST.mli
+++ b/src/ligo/ligo-parser/AST.mli
@@ -1,4 +1,4 @@
-(* Abstract Syntax Tree (AST) for Ligo *)
+(* Abstract Syntax Tree (AST) for LIGO *)
[@@@warning "-30"]
@@ -21,9 +21,10 @@ val nseq_to_region : ('a -> Region.t) -> 'a nseq -> Region.t
val nsepseq_to_region : ('a -> Region.t) -> ('a,'sep) nsepseq -> Region.t
val sepseq_to_region : ('a -> Region.t) -> ('a,'sep) sepseq -> Region.t
-(* Keywords of Ligo *)
+(* Keywords of LIGO *)
type kwd_begin = Region.t
+type kwd_case = Region.t
type kwd_const = Region.t
type kwd_down = Region.t
type kwd_else = Region.t
@@ -35,14 +36,14 @@ type kwd_function = Region.t
type kwd_if = Region.t
type kwd_in = Region.t
type kwd_is = Region.t
-type kwd_match = Region.t
+type kwd_map = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
-type kwd_null = Region.t
type kwd_of = Region.t
-type kwd_operations = Region.t
+type kwd_patch = Region.t
type kwd_procedure = Region.t
type kwd_record = Region.t
+type kwd_skip = Region.t
type kwd_step = Region.t
type kwd_storage = Region.t
type kwd_then = Region.t
@@ -62,34 +63,34 @@ type c_Unit = Region.t
(* Symbols *)
-type semi = Region.t
-type comma = Region.t
-type lpar = Region.t
-type rpar = Region.t
-type lbrace = Region.t
-type rbrace = Region.t
-type lbracket = Region.t
-type rbracket = Region.t
-type cons = Region.t
-type vbar = Region.t
-type arrow = Region.t
-type ass = Region.t
-type equal = Region.t
-type colon = Region.t
-type bool_or = Region.t
-type bool_and = Region.t
-type lt = Region.t
-type leq = Region.t
-type gt = Region.t
-type geq = Region.t
-type neq = Region.t
-type plus = Region.t
-type minus = Region.t
-type slash = Region.t
-type times = Region.t
-type dot = Region.t
-type wild = Region.t
-type cat = Region.t
+type semi = Region.t (* ";" *)
+type comma = Region.t (* "," *)
+type lpar = Region.t (* "(" *)
+type rpar = Region.t (* ")" *)
+type lbrace = Region.t (* "{" *)
+type rbrace = Region.t (* "}" *)
+type lbracket = Region.t (* "[" *)
+type rbracket = Region.t (* "]" *)
+type cons = Region.t (* "#" *)
+type vbar = Region.t (* "|" *)
+type arrow = Region.t (* "->" *)
+type assign = Region.t (* ":=" *)
+type equal = Region.t (* "=" *)
+type colon = Region.t (* ":" *)
+type bool_or = Region.t (* "||" *)
+type bool_and = Region.t (* "&&" *)
+type lt = Region.t (* "<" *)
+type leq = Region.t (* "<=" *)
+type gt = Region.t (* ">" *)
+type geq = Region.t (* ">=" *)
+type neq = Region.t (* "=/=" *)
+type plus = Region.t (* "+" *)
+type minus = Region.t (* "-" *)
+type slash = Region.t (* "/" *)
+type times = Region.t (* "*" *)
+type dot = Region.t (* "." *)
+type wild = Region.t (* "_" *)
+type cat = Region.t (* "^" *)
(* Virtual tokens *)
@@ -104,25 +105,29 @@ type field_name = string reg
type map_name = string reg
type constr = string reg
-(* Comma-separated non-empty lists *)
-
-type 'a csv = ('a, comma) nsepseq
-
-(* Bar-separated non-empty lists *)
-
-type 'a bsv = ('a, vbar) nsepseq
-
(* Parentheses *)
-type 'a par = (lpar * 'a * rpar) reg
+type 'a par = {
+ lpar : lpar;
+ inside : 'a;
+ rpar : rpar
+}
(* Brackets compounds *)
-type 'a brackets = (lbracket * 'a * rbracket) reg
+type 'a brackets = {
+ lbracket : lbracket;
+ inside : 'a;
+ rbracket : rbracket
+}
(* Braced compounds *)
-type 'a braces = (lbrace * 'a * rbrace) reg
+type 'a braces = {
+ lbrace : lbrace;
+ inside : 'a;
+ rbrace : rbrace
+}
(* The Abstract Syntax Tree *)
@@ -134,11 +139,9 @@ type t = {
and ast = t
and declaration =
- TypeDecl of type_decl reg
-| ConstDecl of const_decl reg
-| StorageDecl of storage_decl reg
-| OpDecl of operations_decl reg
-| LambdaDecl of lambda_decl
+ TypeDecl of type_decl reg
+| ConstDecl of const_decl reg
+| LambdaDecl of lambda_decl
and const_decl = {
kwd_const : kwd_const;
@@ -150,22 +153,6 @@ and const_decl = {
terminator : semi option
}
-and storage_decl = {
- kwd_storage : kwd_storage;
- name : variable;
- colon : colon;
- store_type : type_expr;
- terminator : semi option
-}
-
-and operations_decl = {
- kwd_operations : kwd_operations;
- name : variable;
- colon : colon;
- op_type : type_expr;
- terminator : semi option
-}
-
(* Type declarations *)
and type_decl = {
@@ -177,30 +164,42 @@ and type_decl = {
}
and type_expr =
- Prod of cartesian
-| Sum of (variant, vbar) nsepseq reg
-| Record of record_type
-| TypeApp of (type_name * type_tuple) reg
-| ParType of type_expr par
+ TProd of cartesian
+| TSum of (variant reg, vbar) nsepseq reg
+| TRecord of record_type reg
+| TApp of (type_name * type_tuple) reg
+| TPar of type_expr par reg
| TAlias of variable
and cartesian = (type_expr, times) nsepseq reg
-and variant = (constr * kwd_of * cartesian) reg
+and variant = {
+ constr : constr;
+ kwd_of : kwd_of;
+ product : cartesian
+}
-and record_type = (kwd_record * field_decls * kwd_end) reg
+and record_type = {
+ kwd_record : kwd_record;
+ fields : field_decls;
+ kwd_end : kwd_end
+}
-and field_decls = (field_decl, semi) nsepseq
+and field_decls = (field_decl reg, semi) nsepseq
-and field_decl = (variable * colon * type_expr) reg
+and field_decl = {
+ field_name : field_name;
+ colon : colon;
+ field_type : type_expr
+}
-and type_tuple = (type_name, comma) nsepseq par
+and type_tuple = (type_expr, comma) nsepseq par reg
(* Function and procedure declarations *)
and lambda_decl =
- FunDecl of fun_decl reg
-| ProcDecl of proc_decl reg
+ FunDecl of fun_decl reg
+| ProcDecl of proc_decl reg
| EntryDecl of entry_decl reg
and fun_decl = {
@@ -230,22 +229,50 @@ and proc_decl = {
and entry_decl = {
kwd_entrypoint : kwd_entrypoint;
name : variable;
- param : parameters;
+ param : entry_params;
+ colon : colon;
+ ret_type : type_expr;
kwd_is : kwd_is;
local_decls : local_decl list;
block : block reg;
+ kwd_with : kwd_with;
+ return : expr;
terminator : semi option
}
-and parameters = (param_decl, semi) nsepseq par
+and parameters = (param_decl, semi) nsepseq par reg
+
+and entry_params = (entry_param_decl, semi) nsepseq par reg
+
+and entry_param_decl =
+ EntryConst of param_const reg
+| EntryVar of param_var reg
+| EntryStore of storage reg
+
+and storage = {
+ kwd_storage : kwd_storage;
+ var : variable;
+ colon : colon;
+ storage_type : type_expr
+}
and param_decl =
- ParamConst of param_const
-| ParamVar of param_var
+ ParamConst of param_const reg
+| ParamVar of param_var reg
-and param_const = (kwd_const * variable * colon * type_expr) reg
+and param_const = {
+ kwd_const : kwd_const;
+ var : variable;
+ colon : colon;
+ param_type : type_expr
+}
-and param_var = (kwd_var * variable * colon * type_expr) reg
+and param_var = {
+ kwd_var : kwd_var;
+ var : variable;
+ colon : colon;
+ param_type : type_expr
+}
and block = {
opening : kwd_begin;
@@ -264,25 +291,59 @@ and var_decl = {
name : variable;
colon : colon;
var_type : type_expr;
- ass : ass;
+ assign : assign;
init : expr;
terminator : semi option
}
-and instructions = (instruction, semi) nsepseq reg
+and instructions = (instruction, semi) nsepseq
and instruction =
Single of single_instr
| Block of block reg
and single_instr =
- Cond of conditional reg
-| Match of match_instr reg
-| Ass of ass_instr
-| Loop of loop
-| ProcCall of fun_call
-| Null of kwd_null
-| Fail of (kwd_fail * expr) reg
+ Cond of conditional reg
+| Case of case_instr reg
+| Assign of assignment reg
+| Loop of loop
+| ProcCall of fun_call
+| Fail of fail_instr reg
+| Skip of kwd_skip
+| RecordPatch of record_patch reg
+| MapPatch of map_patch reg
+
+and map_patch = {
+ kwd_patch : kwd_patch;
+ path : path;
+ kwd_with : kwd_with;
+ map_inj : map_injection reg
+}
+
+and map_injection = {
+ opening : kwd_map;
+ bindings : (binding reg, semi) nsepseq;
+ terminator : semi option;
+ close : kwd_end
+}
+
+and binding = {
+ source : expr;
+ arrow : arrow;
+ image : expr
+}
+
+and record_patch = {
+ kwd_patch : kwd_patch;
+ path : path;
+ kwd_with : kwd_with;
+ record_inj : record_injection reg
+}
+
+and fail_instr = {
+ kwd_fail : kwd_fail;
+ fail_expr : expr
+}
and conditional = {
kwd_if : kwd_if;
@@ -293,26 +354,46 @@ and conditional = {
ifnot : instruction
}
-and match_instr = {
- kwd_match : kwd_match;
+and case_instr = {
+ kwd_case : kwd_case;
expr : expr;
- kwd_with : kwd_with;
+ kwd_of : kwd_of;
lead_vbar : vbar option;
cases : cases;
kwd_end : kwd_end
}
-and cases = (case, vbar) nsepseq reg
+and cases = (case reg, vbar) nsepseq reg
-and case = (pattern * arrow * instruction) reg
+and case = {
+ pattern : pattern;
+ arrow : arrow;
+ instr : instruction
+}
-and ass_instr = (variable * ass * expr) reg
+and assignment = {
+ lhs : lhs;
+ assign : assign;
+ rhs : rhs;
+}
+
+and lhs =
+ Path of path
+| MapPath of map_lookup reg
+
+and rhs =
+ Expr of expr
+| NoneExpr of c_None
and loop =
- While of while_loop
+ While of while_loop reg
| For of for_loop
-and while_loop = (kwd_while * expr * block reg) reg
+and while_loop = {
+ kwd_while : kwd_while;
+ cond : expr;
+ block : block reg
+}
and for_loop =
ForInt of for_int reg
@@ -320,7 +401,7 @@ and for_loop =
and for_int = {
kwd_for : kwd_for;
- ass : ass_instr;
+ assign : var_assign reg;
down : kwd_down option;
kwd_to : kwd_to;
bound : expr;
@@ -328,6 +409,12 @@ and for_int = {
block : block reg
}
+and var_assign = {
+ name : variable;
+ assign : assign;
+ expr : expr
+}
+
and for_collect = {
kwd_for : kwd_for;
var : variable;
@@ -340,98 +427,177 @@ and for_collect = {
(* Expressions *)
and expr =
- Or of (expr * bool_or * expr) reg
-| And of (expr * bool_and * expr) reg
-| Lt of (expr * lt * expr) reg
-| Leq of (expr * leq * expr) reg
-| Gt of (expr * gt * expr) reg
-| Geq of (expr * geq * expr) reg
-| Equal of (expr * equal * expr) reg
-| Neq of (expr * neq * expr) reg
-| Cat of (expr * cat * expr) reg
-| Cons of (expr * cons * expr) reg
-| Add of (expr * plus * expr) reg
-| Sub of (expr * minus * expr) reg
-| Mult of (expr * times * expr) reg
-| Div of (expr * slash * expr) reg
-| Mod of (expr * kwd_mod * expr) reg
-| Neg of (minus * expr) reg
-| Not of (kwd_not * expr) reg
-| Int of (Lexer.lexeme * Z.t) reg
-| Var of Lexer.lexeme reg
-| String of Lexer.lexeme reg
-| Bytes of (Lexer.lexeme * MBytes.t) reg
-| False of c_False
-| True of c_True
-| Unit of c_Unit
-| Tuple of tuple
-| List of (expr, comma) nsepseq brackets
-| EmptyList of empty_list
-| Set of (expr, comma) nsepseq braces
-| EmptySet of empty_set
-| NoneExpr of none_expr
-| FunCall of fun_call
-| ConstrApp of constr_app
-| SomeApp of (c_Some * arguments) reg
-| MapLookUp of map_lookup reg
-| ParExpr of expr par
+ ELogic of logic_expr
+| EArith of arith_expr
+| EString of string_expr
+| EList of list_expr
+| ESet of set_expr
+| EConstr of constr_expr
+| ERecord of record_expr
+| EMap of map_expr
+| EVar of Lexer.lexeme reg
+| ECall of fun_call
+| EBytes of (Lexer.lexeme * Hex.t) reg
+| EUnit of c_Unit
+| ETuple of tuple
+| EPar of expr par reg
-and tuple = (expr, comma) nsepseq par
+and map_expr =
+ MapLookUp of map_lookup reg
+| MapInj of map_injection reg
-and empty_list =
- (lbracket * rbracket * colon * type_expr) par
+and map_lookup = {
+ path : path;
+ index : expr brackets reg
+}
-and empty_set =
- (lbrace * rbrace * colon * type_expr) par
+and path =
+ Name of variable
+| RecordPath of record_projection reg
-and none_expr =
- (c_None * colon * type_expr) par
+and logic_expr =
+ BoolExpr of bool_expr
+| CompExpr of comp_expr
+
+and bool_expr =
+ Or of bool_or bin_op reg
+| And of bool_and bin_op reg
+| Not of kwd_not un_op reg
+| False of c_False
+| True of c_True
+
+and 'a bin_op = {
+ op : 'a;
+ arg1 : expr;
+ arg2 : expr
+}
+
+and 'a un_op = {
+ op : 'a;
+ arg : expr
+}
+
+and comp_expr =
+ Lt of lt bin_op reg
+| Leq of leq bin_op reg
+| Gt of gt bin_op reg
+| Geq of geq bin_op reg
+| Equal of equal bin_op reg
+| Neq of neq bin_op reg
+
+and arith_expr =
+ Add of plus bin_op reg
+| Sub of minus bin_op reg
+| Mult of times bin_op reg
+| Div of slash bin_op reg
+| Mod of kwd_mod bin_op reg
+| Neg of minus un_op reg
+| Int of (Lexer.lexeme * Z.t) reg
+
+and string_expr =
+ Cat of cat bin_op reg
+| String of Lexer.lexeme reg
+
+and list_expr =
+ Cons of cons bin_op reg
+| List of (expr, comma) nsepseq brackets reg
+| EmptyList of empty_list reg
+
+and set_expr =
+ Set of (expr, comma) nsepseq braces reg
+| EmptySet of empty_set reg
+
+and constr_expr =
+ SomeApp of (c_Some * arguments) reg
+| NoneExpr of none_expr reg
+| ConstrApp of (constr * arguments) reg
+
+and record_expr =
+ RecordInj of record_injection reg
+| RecordProj of record_projection reg
+
+and record_injection = {
+ opening : kwd_record;
+ fields : (field_assign reg, semi) nsepseq;
+ terminator : semi option;
+ close : kwd_end
+}
+
+and field_assign = {
+ field_name : field_name;
+ equal : equal;
+ field_expr : expr
+}
+
+and record_projection = {
+ record_name : variable;
+ selector : dot;
+ field_path : (field_name, dot) nsepseq
+}
+
+and tuple = (expr, comma) nsepseq par reg
+
+and empty_list = typed_empty_list par
+
+and typed_empty_list = {
+ lbracket : lbracket;
+ rbracket : rbracket;
+ colon : colon;
+ list_type : type_expr
+}
+
+and empty_set = typed_empty_set par
+
+and typed_empty_set = {
+ lbrace : lbrace;
+ rbrace : rbrace;
+ colon : colon;
+ set_type : type_expr
+}
+
+and none_expr = typed_none_expr par
+
+and typed_none_expr = {
+ c_None : c_None;
+ colon : colon;
+ opt_type : type_expr
+}
and fun_call = (fun_name * arguments) reg
and arguments = tuple
-and constr_app = (constr * arguments) reg
-
-and map_lookup = {
- map_name : variable;
- selector : dot;
- index : expr brackets
-}
-
(* Patterns *)
-and pattern = (core_pattern, cons) nsepseq reg
-
-and core_pattern =
- PVar of Lexer.lexeme reg
+and pattern =
+ PCons of (pattern, cons) nsepseq reg
+| PVar of Lexer.lexeme reg
| PWild of wild
| PInt of (Lexer.lexeme * Z.t) reg
-| PBytes of (Lexer.lexeme * MBytes.t) reg
+| PBytes of (Lexer.lexeme * Hex.t) reg
| PString of Lexer.lexeme reg
| PUnit of c_Unit
| PFalse of c_False
| PTrue of c_True
| PNone of c_None
-| PSome of (c_Some * core_pattern par) reg
+| PSome of (c_Some * pattern par reg) reg
| PList of list_pattern
-| PTuple of (core_pattern, comma) nsepseq par
+| PTuple of (pattern, comma) nsepseq par reg
and list_pattern =
- Sugar of (core_pattern, comma) sepseq brackets
-| Raw of (core_pattern * cons * pattern) par
+ Sugar of (pattern, comma) sepseq brackets reg
+| Raw of (pattern * cons * pattern) par reg
(* Projecting regions *)
-val type_expr_to_region : type_expr -> Region.t
-
-val expr_to_region : expr -> Region.t
-
-val instr_to_region : instruction -> Region.t
-
-val core_pattern_to_region : core_pattern -> Region.t
-
+val type_expr_to_region : type_expr -> Region.t
+val expr_to_region : expr -> Region.t
+val instr_to_region : instruction -> Region.t
+val pattern_to_region : pattern -> Region.t
val local_decl_to_region : local_decl -> Region.t
+val path_to_region : path -> Region.t
+val lhs_to_region : lhs -> Region.t
+val rhs_to_region : rhs -> Region.t
(* Printing *)
diff --git a/src/ligo/ligo-parser/AST2.ml b/src/ligo/ligo-parser/AST2.ml
index b71c7f472..c09011c9c 100644
--- a/src/ligo/ligo-parser/AST2.ml
+++ b/src/ligo/ligo-parser/AST2.ml
@@ -18,7 +18,7 @@ module O = struct
PVar of var_name
| PWild
| PInt of Z.t
- | PBytes of MBytes.t
+ | PBytes of Hex.t
| PString of string
| PUnit
| PFalse
@@ -42,6 +42,7 @@ module O = struct
| Function of { arg: type_expr; ret: type_expr }
| Ref of type_expr
| String
+ | Bytes
| Int
| Unit
| Bool
@@ -80,7 +81,7 @@ module O = struct
and constant =
Unit
- | Int of Z.t | String of string | Bytes of MBytes.t
+ | Int of Z.t | String of string | Bytes of Hex.t
| False | True
| Null of type_expr
| EmptySet of type_expr
@@ -653,7 +654,7 @@ let s_ast (ast : I.ast) : O.ast =
(* and s_bytes {region; value = lexeme, abstract} = *)
(* printf "%s: Bytes (\"%s\", \"0x%s\")\n" *)
(* (compact region) lexeme *)
-(* (MBytes.to_hex abstract |> Hex.to_string) *)
+(* (Hex.to_string abstract) *)
(* and s_int {region; value = lexeme, abstract} = *)
(* printf "%s: Int (\"%s\", %s)\n" *)
diff --git a/src/ligo/ligo-parser/EvalOpt.ml b/src/ligo/ligo-parser/EvalOpt.ml
index 13c9f51ad..20d039603 100644
--- a/src/ligo/ligo-parser/EvalOpt.ml
+++ b/src/ligo/ligo-parser/EvalOpt.ml
@@ -1,4 +1,4 @@
-(* Parsing the command-line option for testing the Ligo lexer and
+(* Parsing the command-line option for testing the LIGO lexer and
parser *)
let printf = Printf.printf
@@ -11,16 +11,17 @@ let abort msg =
let help () =
let file = Filename.basename Sys.argv.(0) in
- printf "Usage: %s [