balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ast-sugar

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-01 16:51:38 +02:00
parent bc7df6a5b4
commit 1f118f7233
4 changed files with 76 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/passes/4-imperative_to_sugar/imperative_to_sugar.ml
View File

@ -37,7 +37,7 @@ let repair_mutable_variable_in_matching (match_body : O.expression) (element_nam
ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result) ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result)
else( else(
let free_var = if (List.mem name free_var) then free_var else name::free_var in let free_var = if (List.mem name free_var) then free_var else name::free_var in
let expr = O.e_let_in (env,None) false false (O.e_record_update (O.e_variable env) (Var.to_name name) (O.e_variable name)) let_result in let expr = O.e_let_in (env,None) false false (O.e_record_update (O.e_variable env) (O.Label (Var.to_name name)) (O.e_variable name)) let_result in
ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs expr) ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs expr)
) )
| E_constant {cons_name=C_MAP_FOLD;arguments= _} | E_constant {cons_name=C_MAP_FOLD;arguments= _}
@ -70,8 +70,8 @@ and repair_mutable_variable_in_loops (for_body : O.expression) (element_names :
else( else(
let free_var = if (List.mem name free_var) then free_var else name::free_var in let free_var = if (List.mem name free_var) then free_var else name::free_var in
let expr = O.e_let_in (env,None) false false ( let expr = O.e_let_in (env,None) false false (
O.e_record_update (O.e_variable env) ("0") O.e_record_update (O.e_variable env) (Label "0")
(O.e_record_update (O.e_record_accessor (O.e_variable env) "0") (Var.to_name name) (O.e_variable name)) (O.e_record_update (O.e_record_accessor (O.e_variable env) (Label "0")) (Label (Var.to_name name)) (O.e_variable name))
) )
let_result in let_result in
ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs expr) ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs expr)
@ -90,12 +90,12 @@ and store_mutable_variable (free_vars : I.expression_variable list) =
if (List.length free_vars == 0) then if (List.length free_vars == 0) then
O.e_unit () O.e_unit ()
else else
let aux var = (Var.to_name var, O.e_variable var) in let aux var = (O.Label (Var.to_name var), O.e_variable var) in
O.e_record_ez (List.map aux free_vars) O.e_record @@ O.LMap.of_list (List.map aux free_vars)
and restore_mutable_variable (expr : O.expression->O.expression_content) (free_vars : O.expression_variable list) (env : O.expression_variable) = and restore_mutable_variable (expr : O.expression->O.expression_content) (free_vars : O.expression_variable list) (env : O.expression_variable) =
let aux (f: O.expression -> O.expression) (ev: O.expression_variable) = let aux (f: O.expression -> O.expression) (ev: O.expression_variable) =
fun expr -> f (O.e_let_in (ev,None) true false (O.e_record_accessor (O.e_variable env) (Var.to_name ev)) expr) fun expr -> f (O.e_let_in (ev,None) true false (O.e_record_accessor (O.e_variable env) (Label (Var.to_name ev))) expr)
in in
let ef = List.fold_left aux (fun e -> e) free_vars in let ef = List.fold_left aux (fun e -> e) free_vars in
expr (ef (O.e_skip ())) expr (ef (O.e_skip ()))
@ -163,7 +163,7 @@ and compile_type_operator : I.type_operator -> O.type_operator result =
let rec compile_expression : I.expression -> O.expression result = let rec compile_expression : I.expression -> O.expression result =
fun e -> fun e ->
let return expr = ok @@ O.make_expr ~loc:e.location expr in let return expr = ok @@ O.make_e ~loc:e.location expr in
match e.expression_content with match e.expression_content with
| I.E_literal literal -> return @@ O.E_literal literal | I.E_literal literal -> return @@ O.E_literal literal
| I.E_constant {cons_name;arguments} -> | I.E_constant {cons_name;arguments} ->
@ -288,7 +288,7 @@ and compile_assign {variable; access_path; expression} expr =
let accessor ?loc s a = let accessor ?loc s a =
match a with match a with
I.Access_tuple _i -> failwith "adding tuple soon" I.Access_tuple _i -> failwith "adding tuple soon"
| I.Access_record a -> ok @@ O.e_record_accessor ?loc s a | I.Access_record a -> ok @@ O.e_record_accessor ?loc s (Label a)
| I.Access_map k -> | I.Access_map k ->
let%bind k = compile_expression k in let%bind k = compile_expression k in
ok @@ O.e_constant ?loc C_MAP_FIND_OPT [k;s] ok @@ O.e_constant ?loc C_MAP_FIND_OPT [k;s]
@ -296,7 +296,7 @@ and compile_assign {variable; access_path; expression} expr =
let update ?loc (s:O.expression) a e = let update ?loc (s:O.expression) a e =
match a with match a with
I.Access_tuple _i -> failwith "adding tuple soon" I.Access_tuple _i -> failwith "adding tuple soon"
| I.Access_record a -> ok @@ O.e_record_update ?loc s a e | I.Access_record a -> ok @@ O.e_record_update ?loc s (Label a) e
| I.Access_map k -> | I.Access_map k ->
let%bind k = compile_expression k in let%bind k = compile_expression k in
ok @@ O.e_constant ?loc C_UPDATE [k;O.e_some (e);s] ok @@ O.e_constant ?loc C_UPDATE [k;O.e_some (e);s]
@ -430,7 +430,7 @@ and compile_while I.{condition;body} =
let for_body = add_to_end for_body ctrl in let for_body = add_to_end for_body ctrl in
let aux name expr= let aux name expr=
O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable binder) "0") (Var.to_name name)) expr O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable binder) (Label "0")) (Label (Var.to_name name))) expr
in in
let init_rec = O.e_tuple [store_mutable_variable @@ captured_name_list] in let init_rec = O.e_tuple [store_mutable_variable @@ captured_name_list] in
let restore = fun expr -> List.fold_right aux captured_name_list expr in let restore = fun expr -> List.fold_right aux captured_name_list expr in
@ -445,7 +445,7 @@ and compile_while I.{condition;body} =
let return_expr = fun expr -> let return_expr = fun expr ->
O.E_let_in {let_binder; mut=false; inline=false; rhs=init_rec; let_result= O.E_let_in {let_binder; mut=false; inline=false; rhs=init_rec; let_result=
O.e_let_in let_binder false false loop @@ O.e_let_in let_binder false false loop @@
O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) "0") @@ O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) (Label"0")) @@
expr expr
} }
in in
@ -461,7 +461,7 @@ and compile_for I.{binder;start;final;increment;body} =
let continue_expr = O.e_constant C_FOLD_CONTINUE [(O.e_variable env_rec)] in let continue_expr = O.e_constant C_FOLD_CONTINUE [(O.e_variable env_rec)] in
let ctrl = let ctrl =
O.e_let_in (binder,Some O.t_int) false false (O.e_constant C_ADD [ O.e_variable binder ; step ]) @@ O.e_let_in (binder,Some O.t_int) false false (O.e_constant C_ADD [ O.e_variable binder ; step ]) @@
O.e_let_in (env_rec, None) false false (O.e_record_update (O.e_variable env_rec) "1" @@ O.e_variable binder)@@ O.e_let_in (env_rec, None) false false (O.e_record_update (O.e_variable env_rec) (Label "1") @@ O.e_variable binder)@@
continue_expr continue_expr
in in
(* Modify the body loop*) (* Modify the body loop*)
@ -470,7 +470,7 @@ and compile_for I.{binder;start;final;increment;body} =
let for_body = add_to_end for_body ctrl in let for_body = add_to_end for_body ctrl in
let aux name expr= let aux name expr=
O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable env_rec) "0") (Var.to_name name)) expr O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable env_rec) (Label "0")) (Label (Var.to_name name))) expr
in in
(* restores the initial value of the free_var*) (* restores the initial value of the free_var*)
@ -479,7 +479,7 @@ and compile_for I.{binder;start;final;increment;body} =
(*Prep the lambda for the fold*) (*Prep the lambda for the fold*)
let stop_expr = O.e_constant C_FOLD_STOP [O.e_variable env_rec] in let stop_expr = O.e_constant C_FOLD_STOP [O.e_variable env_rec] in
let aux_func = O.e_lambda env_rec None None @@ let aux_func = O.e_lambda env_rec None None @@
O.e_let_in (binder,Some O.t_int) false false (O.e_record_accessor (O.e_variable env_rec) "1") @@ O.e_let_in (binder,Some O.t_int) false false (O.e_record_accessor (O.e_variable env_rec) (Label "1")) @@
O.e_cond cond (restore for_body) (stop_expr) in O.e_cond cond (restore for_body) (stop_expr) in
(* Make the fold_while en precharge the vakye *) (* Make the fold_while en precharge the vakye *)
@ -492,7 +492,7 @@ and compile_for I.{binder;start;final;increment;body} =
O.E_let_in {let_binder=(binder, Some O.t_int);mut=false; inline=false;rhs=start;let_result= O.E_let_in {let_binder=(binder, Some O.t_int);mut=false; inline=false;rhs=start;let_result=
O.e_let_in let_binder false false init_rec @@ O.e_let_in let_binder false false init_rec @@
O.e_let_in let_binder false false loop @@ O.e_let_in let_binder false false loop @@
O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) "0") @@ O.e_let_in let_binder false false (O.e_record_accessor (O.e_variable env_rec) (Label "0")) @@
expr expr
} }
in in
@ -508,21 +508,21 @@ and compile_for_each I.{binder;collection;collection_type; body} =
let env = Var.fresh () in let env = Var.fresh () in
let%bind body = compile_expression body in let%bind body = compile_expression body in
let%bind ((_,free_vars), body) = repair_mutable_variable_in_loops body element_names args in let%bind ((_,free_vars), body) = repair_mutable_variable_in_loops body element_names args in
let for_body = add_to_end body @@ (O.e_record_accessor (O.e_variable args) "0") in let for_body = add_to_end body @@ (O.e_record_accessor (O.e_variable args) (Label "0")) in
let init_record = store_mutable_variable free_vars in let init_record = store_mutable_variable free_vars in
let%bind collect = compile_expression collection in let%bind collect = compile_expression collection in
let aux name expr= let aux name expr=
O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) "0") (Var.to_name name)) expr O.e_let_in (name,None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) (Label "0")) (Label (Var.to_name name))) expr
in in
let restore = fun expr -> List.fold_right aux free_vars expr in let restore = fun expr -> List.fold_right aux free_vars expr in
let restore = match collection_type with let restore = match collection_type with
| Map -> (match snd binder with | Map -> (match snd binder with
| Some v -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) "1") "0") | Some v -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) (Label "1")) (Label "0"))
(O.e_let_in (v, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) "1") "1") expr)) (O.e_let_in (v, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) (Label "1")) (Label "1")) expr))
| None -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) "1") "0") expr) | None -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_record_accessor (O.e_variable args) (Label "1")) (Label "0")) expr)
) )
| _ -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_variable args) "1") expr) | _ -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_record_accessor (O.e_variable args) (Label "1")) expr)
in in
let lambda = O.e_lambda args None None (restore for_body) in let lambda = O.e_lambda args None None (restore for_body) in
let%bind op_name = match collection_type with let%bind op_name = match collection_type with

2
src/passes/6-sugar_to_core/sugar_to_core.ml
View File

@ -293,7 +293,7 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
let rec uncompile_expression : O.expression -> I.expression result = let rec uncompile_expression : O.expression -> I.expression result =
fun e -> fun e ->
let return expr = ok @@ I.make_expr ~loc:e.location expr in let return expr = ok @@ I.make_e ~loc:e.location expr in
match e.expression_content with match e.expression_content with
O.E_literal lit -> return @@ I.E_literal lit O.E_literal lit -> return @@ I.E_literal lit
| O.E_constant {cons_name;arguments} -> | O.E_constant {cons_name;arguments} ->

113
src/stages/2-ast_sugar/combinators.ml
View File

@ -79,83 +79,72 @@ let t_operator op lst: type_expression result =
| TC_contract _ , [t] -> ok @@ t_contract t | TC_contract _ , [t] -> ok @@ t_contract t
| _ , _ -> fail @@ bad_type_operator op | _ , _ -> fail @@ bad_type_operator op
let make_expr ?(loc = Location.generated) expression_content = let make_e ?(loc = Location.generated) expression_content =
let location = loc in let location = loc in
{ expression_content; location } { expression_content; location }
let e_var ?loc (n: string) : expression = make_expr ?loc @@ E_variable (Var.of_name n) let e_literal ?loc l : expression = make_e ?loc @@ E_literal l
let e_literal ?loc l : expression = make_expr ?loc @@ E_literal l let e_unit ?loc () : expression = make_e ?loc @@ E_literal (Literal_unit)
let e_unit ?loc () : expression = make_expr ?loc @@ E_literal (Literal_unit) let e_int ?loc n : expression = make_e ?loc @@ E_literal (Literal_int n)
let e_int ?loc n : expression = make_expr ?loc @@ E_literal (Literal_int n) let e_nat ?loc n : expression = make_e ?loc @@ E_literal (Literal_nat n)
let e_nat ?loc n : expression = make_expr ?loc @@ E_literal (Literal_nat n) let e_timestamp ?loc n : expression = make_e ?loc @@ E_literal (Literal_timestamp n)
let e_timestamp ?loc n : expression = make_expr ?loc @@ E_literal (Literal_timestamp n) let e_bool ?loc b : expression = make_e ?loc @@ E_literal (Literal_bool b)
let e_bool ?loc b : expression = make_expr ?loc @@ E_literal (Literal_bool b) let e_string ?loc s : expression = make_e ?loc @@ E_literal (Literal_string s)
let e_string ?loc s : expression = make_expr ?loc @@ E_literal (Literal_string s) let e_address ?loc s : expression = make_e ?loc @@ E_literal (Literal_address s)
let e_address ?loc s : expression = make_expr ?loc @@ E_literal (Literal_address s) let e_mutez ?loc s : expression = make_e ?loc @@ E_literal (Literal_mutez s)
let e_mutez ?loc s : expression = make_expr ?loc @@ E_literal (Literal_mutez s) let e_signature ?loc s : expression = make_e ?loc @@ E_literal (Literal_signature s)
let e_signature ?loc s : expression = make_expr ?loc @@ E_literal (Literal_signature s) let e_key ?loc s : expression = make_e ?loc @@ E_literal (Literal_key s)
let e_key ?loc s : expression = make_expr ?loc @@ E_literal (Literal_key s) let e_key_hash ?loc s : expression = make_e ?loc @@ E_literal (Literal_key_hash s)
let e_key_hash ?loc s : expression = make_expr ?loc @@ E_literal (Literal_key_hash s) let e_chain_id ?loc s : expression = make_e ?loc @@ E_literal (Literal_chain_id s)
let e_chain_id ?loc s : expression = make_expr ?loc @@ E_literal (Literal_chain_id s)
let e'_bytes b : expression_content result = let e'_bytes b : expression_content result =
let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in
ok @@ E_literal (Literal_bytes bytes) ok @@ E_literal (Literal_bytes bytes)
let e_bytes_hex ?loc b : expression result = let e_bytes_hex ?loc b : expression result =
let%bind e' = e'_bytes b in let%bind e' = e'_bytes b in
ok @@ make_expr ?loc e' ok @@ make_e ?loc e'
let e_bytes_raw ?loc (b: bytes) : expression = let e_bytes_raw ?loc (b: bytes) : expression =
make_expr ?loc @@ E_literal (Literal_bytes b) make_e ?loc @@ E_literal (Literal_bytes b)
let e_bytes_string ?loc (s: string) : expression = let e_bytes_string ?loc (s: string) : expression =
make_expr ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s))) make_e ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s)))
let e_some ?loc s : expression = make_expr ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]} let e_some ?loc s : expression = make_e ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]}
let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NONE; arguments = []} let e_none ?loc () : expression = make_e ?loc @@ E_constant {cons_name = C_NONE; arguments = []}
let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a}
let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b}
let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; path = Label b}
let e_record_accessor_list ?loc a b = List.fold_left (fun a b -> e_record_accessor ?loc a b) a b
let e_variable ?loc v = make_expr ?loc @@ E_variable v
let e_let_in ?loc (binder, ascr) mut inline rhs let_result =
make_expr ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline; mut }
let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b}
let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst}
let e_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty} let e_constant ?loc name lst = make_e ?loc @@ E_constant {cons_name=name ; arguments = lst}
let e_variable ?loc v = make_e ?loc @@ E_variable v
let e_application ?loc a b = make_e ?loc @@ E_application {lamb=a ; args=b}
let e_lambda ?loc binder input_type output_type result : expression = make_e ?loc @@ E_lambda {binder; input_type; output_type; result}
let e_recursive ?loc fun_name fun_type lambda = make_e ?loc @@ E_recursive {fun_name; fun_type; lambda}
let e_let_in ?loc (binder, ascr) mut inline rhs let_result = make_e ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline; mut }
let e_cond ?loc condition then_clause else_clause = make_expr ?loc @@ E_cond {condition;then_clause;else_clause} let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = Constructor s; element = a}
let e_sequence ?loc expr1 expr2 = make_expr ?loc @@ E_sequence {expr1; expr2} let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}
let e_skip ?loc () = make_expr ?loc @@ E_skip
let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst let e_record ?loc map : expression = make_e ?loc @@ E_record map
let e_set ?loc lst : expression = make_expr ?loc @@ E_set lst let e_record_accessor ?loc record path = make_e ?loc @@ E_record_accessor {record; path}
let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst let e_record_update ?loc record path update = make_e ?loc @@ E_record_update {record; path; update}
let e_big_map ?loc lst : expression = make_expr ?loc @@ E_big_map lst
let e_look_up ?loc a b : expression = make_expr ?loc @@ E_look_up (a,b)
let ez_match_variant (lst : ((string * string) * 'a) list) = let e_annotation ?loc anno_expr ty = make_e ?loc @@ E_ascription {anno_expr; type_annotation = ty}
let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in
Match_variant (lst,())
let e_matching_variant ?loc a (lst : ((string * string)* 'a) list) =
e_matching ?loc a (ez_match_variant lst)
let e_record_ez ?loc (lst : (string * expr) list) : expression =
let map = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in
make_expr ?loc @@ E_record map
let e_record ?loc map =
let lst = Map.String.to_kv_list map in
e_record_ez ?loc lst
let e_record_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {record = a; path= Label b}
let e_record_update ?loc record path update = let e_tuple ?loc lst : expression = make_e ?loc @@ E_tuple lst
let path = Label path in let e_tuple_accessor ?loc tuple path = make_e ?loc @@ E_tuple_accessor {tuple; path}
make_expr ?loc @@ E_record_update {record; path; update} let e_tuple_update ?loc tuple path update = make_e ?loc @@ E_tuple_update {tuple; path; update}
let e_pair ?loc a b : expression = e_tuple ?loc [a;b]
let e_cond ?loc condition then_clause else_clause = make_e ?loc @@ E_cond {condition;then_clause;else_clause}
let e_sequence ?loc expr1 expr2 = make_e ?loc @@ E_sequence {expr1; expr2}
let e_skip ?loc () = make_e ?loc @@ E_skip
let e_list ?loc lst : expression = make_e ?loc @@ E_list lst
let e_set ?loc lst : expression = make_e ?loc @@ E_set lst
let e_map ?loc lst : expression = make_e ?loc @@ E_map lst
let e_big_map ?loc lst : expression = make_e ?loc @@ E_big_map lst
let e_look_up ?loc a b : expression = make_e ?loc @@ E_look_up (a,b)
let make_option_typed ?loc e t_opt = let make_option_typed ?loc e t_opt =
match t_opt with match t_opt with
| None -> e | None -> e
| Some t -> e_annotation ?loc e t | Some t -> e_annotation ?loc e t
let e_tuple ?loc lst : expression = e_record_ez ?loc (tuple_to_record lst)
let e_pair ?loc a b : expression = e_tuple ?loc [a;b]
let e_typed_none ?loc t_opt = let e_typed_none ?loc t_opt =
let type_annotation = t_option t_opt in let type_annotation = t_option t_opt in
@ -170,18 +159,6 @@ let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map
let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k) let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k)
let e_lambda ?loc (binder : expression_variable)
(input_type : type_expression option)
(output_type : type_expression option)
(result : expression)
: expression =
make_expr ?loc @@ E_lambda {
binder = binder ;
input_type = input_type ;
output_type = output_type ;
result ;
}
let e_recursive ?loc fun_name fun_type lambda = make_expr ?loc @@ E_recursive {fun_name; fun_type; lambda}
let get_e_record_accessor = fun t -> let get_e_record_accessor = fun t ->
match t with match t with

21
src/stages/2-ast_sugar/combinators.mli
View File

@ -46,8 +46,7 @@ val t_map : type_expression -> type_expression -> type_expression
val t_operator : type_operator -> type_expression list -> type_expression result val t_operator : type_operator -> type_expression list -> type_expression result
val t_set : type_expression -> type_expression val t_set : type_expression -> type_expression
val make_expr : ?loc:Location.t -> expression_content -> expression val make_e : ?loc:Location.t -> expression_content -> expression
val e_var : ?loc:Location.t -> string -> expression
val e_literal : ?loc:Location.t -> literal -> expression val e_literal : ?loc:Location.t -> literal -> expression
val e_unit : ?loc:Location.t -> unit -> expression val e_unit : ?loc:Location.t -> unit -> expression
val e_int : ?loc:Location.t -> int -> expression val e_int : ?loc:Location.t -> int -> expression
@ -77,13 +76,17 @@ val e_application : ?loc:Location.t -> expression -> expression -> expression
val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> bool -> expression -> expression -> expression val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> bool -> expression -> expression -> expression
val e_record : ?loc:Location.t -> expr Map.String.t -> expression val e_record : ?loc:Location.t -> expr label_map -> expression
val e_record_update : ?loc:Location.t -> expression -> string -> expression -> expression val e_record_accessor : ?loc:Location.t -> expression -> label -> expression
val e_record_accessor : ?loc:Location.t -> expression -> string -> expression val e_record_update : ?loc:Location.t -> expression -> label -> expression -> expression
val e_record_accessor_list : ?loc:Location.t -> expression -> string list -> expression
val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
val e_tuple : ?loc:Location.t -> expression list -> expression
val e_tuple_accessor : ?loc:Location.t -> expression -> int -> expression
val e_tuple_update : ?loc:Location.t -> expression -> int -> expression -> expression
val e_pair : ?loc:Location.t -> expression -> expression -> expression
val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
val e_sequence : ?loc:Location.t -> expression -> expression -> expression val e_sequence : ?loc:Location.t -> expression -> expression -> expression
val e_skip : ?loc:Location.t -> unit -> expression val e_skip : ?loc:Location.t -> unit -> expression
@ -95,9 +98,6 @@ val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
val e_look_up : ?loc:Location.t -> expression -> expression -> expression val e_look_up : ?loc:Location.t -> expression -> expression -> expression
val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
val e_matching_bool : ?loc:Location.t -> expression -> expression -> expression -> expression
val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content
val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression
val make_option_typed : ?loc:Location.t -> expression -> type_expression option -> expression val make_option_typed : ?loc:Location.t -> expression -> type_expression option -> expression
@ -109,9 +109,6 @@ val e_typed_map : ?loc:Location.t -> ( expression * expression ) list -> type_e
val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression
val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression
val e_record_ez : ?loc:Location.t -> (string * expression) list -> expression
val e_tuple : ?loc:Location.t -> expression list -> expression
val e_pair : ?loc:Location.t -> expression -> expression -> expression
val assert_e_accessor : expression_content -> unit result val assert_e_accessor : expression_content -> unit result