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

Merge branch 'ast/loop_construct_for_ast_imperative' into 'dev'

Browse Source 
Add for, for_each, while construct in ast_imperatve

See merge request ligolang/ligo!531
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-27 18:28:52 +00:00
commit 63793ddc76
19 changed files with 911 additions and 444 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

170
src/bin/expect_tests/contract_tests.ml
View File

@ -10,10 +10,10 @@ let%expect_test _ =
[%expect {| 1870 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ;
[%expect {| 1324 bytes |}] ;
[%expect {| 1294 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ;
[%expect {| 3231 bytes |}] ;
[%expect {| 2935 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ;
[%expect {| 589 bytes |}] ;
@ -312,11 +312,8 @@ let%expect_test _ =
SWAP ;
CAR ;
CDR ;
DUP ;
DIP { DIP 2 { DUP } ; DIG 2 } ;
PAIR ;
DIP { DIP { DUP } ; SWAP } ;
PAIR ;
DIP { DUP } ;
SWAP ;
DIP 3 { DUP } ;
DIG 3 ;
CAR ;
@ -333,31 +330,31 @@ let%expect_test _ =
PAIR ;
DUP ;
CAR ;
CAR ;
CDR ;
DIP { DUP } ;
SWAP ;
CAR ;
CDR ;
CAR ;
DIP 2 { DUP } ;
DIG 2 ;
CDR ;
DIP 2 { DUP } ;
DIG 2 ;
DIP { DIP { DUP } ; SWAP } ;
DIP { DUP } ;
SWAP ;
DIP { DIP 2 { DUP } ; DIG 2 } ;
PAIR ;
DIP 3 { DUP } ;
DIG 3 ;
DIP 2 { DUP } ;
DIG 2 ;
IF_CONS
{ DIP 4 { DUP } ;
DIG 4 ;
{ DIP 5 { DUP } ;
DIG 5 ;
DIP 4 { DUP } ;
DIG 4 ;
CAR ;
DIP { DIP { DUP } ; SWAP ; HASH_KEY } ;
COMPARE ;
EQ ;
IF { DIP 5 { DUP } ;
DIG 5 ;
IF { DIP 6 { DUP } ;
DIG 6 ;
DIP 2 { DUP } ;
DIG 2 ;
DIP { DIP 5 { DUP } ;
@ -371,8 +368,8 @@ let%expect_test _ =
PAIR ;
PACK } } ;
CHECK_SIGNATURE ;
IF { DIP 6 { DUP } ;
DIG 6 ;
IF { DIP 7 { DUP } ;
DIG 7 ;
PUSH nat 1 ;
ADD ;
DIP { DUP } ;
@ -407,9 +404,10 @@ let%expect_test _ =
CAR ;
DIP 2 { DUP } ;
DIG 2 ;
CAR ;
SWAP ;
CDR ;
SWAP ;
CAR ;
PAIR ;
SWAP ;
CDR ;
@ -421,10 +419,9 @@ let%expect_test _ =
CAR ;
DIP 3 { DUP } ;
DIG 3 ;
CAR ;
SWAP ;
CDR ;
SWAP ;
CAR ;
PAIR ;
SWAP ;
CDR ;
@ -460,16 +457,14 @@ let%expect_test _ =
DIP { DROP 2 } } ;
DIP 3 { DUP } ;
DIG 3 ;
CAR ;
DIP { DUP } ;
PAIR ;
DIP { DROP 3 } } ;
DUP ;
CAR ;
CAR ;
SWAP ;
DIP { DROP 4 } } ;
DIP 2 { DUP } ;
DIG 2 ;
UNIT ;
EXEC ;
DIP { DUP ; CDR } ;
DIP { DUP } ;
PAIR ;
DIP { DROP 7 } } } |} ]
@ -628,13 +623,9 @@ let%expect_test _ =
GT ;
IF { PUSH string "Maximum number of proposal reached" ; FAILWITH }
{ PUSH unit Unit } ;
DIP 8 { DUP } ;
DIG 8 ;
DIP { DIP 3 { DUP } ; DIG 3 } ;
PAIR ;
DIP { DIP 7 { DUP } ; DIG 7 ; NIL operation ; SWAP ; PAIR } ;
PAIR ;
DIP { DIP 2 { DUP } ; DIG 2 } ;
DIP 2 { DUP } ;
DIG 2 ;
NIL operation ;
PAIR ;
DIP 4 { DUP } ;
DIG 4 ;
@ -689,32 +680,26 @@ let%expect_test _ =
SWAP ;
CDR ;
CAR ;
DIP 2 { DUP } ;
DIG 2 ;
CDR ;
CDR ;
DIP { DUP } ;
SWAP ;
DIP { DUP } ;
PAIR ;
DIP { DIP 2 { DUP } ; DIG 2 } ;
PAIR ;
DIP 2 { DUP } ;
DIG 2 ;
DIP { DIP 12 { DUP } ; DIG 12 } ;
SWAP ;
DIP { DIP 11 { DUP } ; DIG 11 } ;
MEM ;
IF { DIP 3 { DUP } ;
DIG 3 ;
DIP 3 { DUP } ;
DIG 3 ;
DIP { DIP 2 { DUP } ;
DIG 2 ;
IF { DIP 2 { DUP } ;
DIG 2 ;
DIP 2 { DUP } ;
DIG 2 ;
DIP { DIP 4 { DUP } ;
DIG 4 ;
CDR ;
CDR ;
PUSH nat 1 ;
SWAP ;
SUB ;
ABS ;
SOME ;
DIP { DIP 4 { DUP } ; DIG 4 ; CDR ; CAR ; CAR } } ;
DIP { DIP 3 { DUP } ; DIG 3 ; CDR ; CAR ; CAR } } ;
UPDATE ;
DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ;
PAIR ;
@ -723,23 +708,21 @@ let%expect_test _ =
PAIR ;
DIP { DUP } ;
SWAP ;
CAR ;
DIP { DUP } ;
PAIR ;
DIP { DROP } }
SWAP ;
DIP { DROP 2 } }
{ DUP } ;
DIP 4 { DUP } ;
DIG 4 ;
DIP 5 { DUP } ;
DIG 5 ;
DIP 6 { DUP } ;
DIG 6 ;
CAR ;
DIP 2 { DUP } ;
DIG 2 ;
CDR ;
DIP { DROP ; CDR } ;
PAIR ;
CAR ;
DIP { DROP 6 } } ;
DIP { DROP 5 } } ;
DIP 4 { DUP } ;
DIG 4 ;
DIP 4 { DUP } ;
@ -749,12 +732,10 @@ let%expect_test _ =
PAIR ;
DIP 3 { DUP } ;
DIG 3 ;
DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ;
SWAP ;
PAIR ;
CDR ;
SWAP ;
PAIR ;
PAIR ;
DIP 2 { DUP } ;
DIG 2 ;
SWAP ;
@ -785,8 +766,6 @@ let%expect_test _ =
PAIR } ;
DUP ;
CAR ;
CDR ;
CDR ;
DIP { DUP ; CDR } ;
PAIR ;
DIP { DROP 15 } } ;
@ -800,9 +779,8 @@ let%expect_test _ =
SWAP ;
CAR ;
PACK ;
DUP ;
DIP { DIP { DUP } ; SWAP } ;
PAIR ;
DIP { DUP } ;
SWAP ;
DIP { DUP } ;
SWAP ;
DIP { DIP 2 { DUP } ; DIG 2 ; CAR ; CDR ; CDR } ;
@ -851,12 +829,7 @@ let%expect_test _ =
DIP { DROP 2 } }
{ DUP } ;
DUP ;
DIP 3 { DUP } ;
DIG 3 ;
DIP { DIP 6 { DUP } ; DIG 6 } ;
PAIR ;
DIP { DUP } ;
PAIR ;
DUP ;
DIP 4 { DUP } ;
DIG 4 ;
SIZE ;
@ -878,10 +851,9 @@ let%expect_test _ =
PAIR ;
DIP { DUP } ;
SWAP ;
CAR ;
DIP { DUP } ;
PAIR ;
DIP { DROP } }
SWAP ;
DIP { DROP 2 } }
{ DUP ;
DIP 2 { DUP } ;
DIG 2 ;
@ -898,47 +870,15 @@ let%expect_test _ =
SWAP ;
PAIR ;
PAIR ;
SWAP ;
CAR ;
PAIR } ;
DIP { DROP } } ;
DIP 7 { DUP } ;
DIG 7 ;
DIP 3 { DUP } ;
DIG 3 ;
DIP { DROP ; DUP } ;
SWAP ;
CAR ;
PAIR ;
DIP { DUP } ;
SWAP ;
CAR ;
CDR ;
SWAP ;
CDR ;
SWAP ;
PAIR ;
DIP { DUP } ;
SWAP ;
CDR ;
SWAP ;
CAR ;
PAIR ;
DIP { DUP } ;
SWAP ;
CAR ;
CDR ;
SWAP ;
CDR ;
SWAP ;
PAIR ;
DIP { DUP } ;
SWAP ;
CDR ;
SWAP ;
CAR ;
PAIR ;
DIP { DROP 7 } } ;
DIP { DROP 8 } } ;
DUP ;
CDR ;
NIL operation ;
PAIR ;
DIP { DROP 6 } } ;
@ -1174,7 +1114,7 @@ let%expect_test _ =
let%expect_test _ =
run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ;
[%expect {|
ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#654 = #P in let p = rhs#654.0 in let s = rhs#654.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#701 = #P in let p = rhs#701.0 in let s = rhs#701.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
If you're not sure how to fix this error, you can
@ -1187,7 +1127,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8,
run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ;
[%expect {|
ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#657 = #P in let p = rhs#657.0 in let s = rhs#657.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#704 = #P in let p = rhs#704.0 in let s = rhs#704.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
If you're not sure how to fix this error, you can

1
src/passes/2-concrete_to_imperative/dune
View File

@ -6,7 +6,6 @@
tezos-utils
parser
ast_imperative
self_ast_imperative
operators)
(modules cameligo pascaligo concrete_to_imperative)
(preprocess

323
src/passes/2-concrete_to_imperative/pascaligo.ml
View File

@ -14,90 +14,6 @@ let pseq_to_list = function
| Some lst -> npseq_to_list lst
let get_value : 'a Raw.reg -> 'a = fun x -> x.value
and repair_mutable_variable_in_matching (for_body : expression) (element_names : expression_variable list) (env : expression_variable) =
let%bind captured_names = Self_ast_imperative.fold_map_expression
(* TODO : these should use Variables sets *)
(fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) ->
match ass_exp.expression_content with
| E_let_in {let_binder;mut=false;rhs;let_result} ->
let (name,_) = let_binder in
ok (true,(name::decl_var, free_var),e_let_in let_binder false false rhs let_result)
| E_let_in {let_binder;mut=true; rhs;let_result} ->
let (name,_) = let_binder in
if List.mem name decl_var then
ok (true,(decl_var, free_var), e_let_in let_binder false false rhs let_result)
else(
let free_var = if (List.mem name free_var) then free_var else name::free_var in
let expr = e_let_in (env,None) false false (e_update (e_variable env) (Var.to_name name) (e_variable name)) let_result in
ok (true,(decl_var, free_var), e_let_in let_binder false false rhs expr)
)
| E_variable name ->
if List.mem name decl_var || List.mem name free_var || Var.equal name env then
ok (true,(decl_var, free_var), e_variable name)
else
ok (true, (decl_var, name::free_var), e_variable name)
| E_constant {cons_name=C_MAP_FOLD;arguments= _}
| E_constant {cons_name=C_SET_FOLD;arguments= _}
| E_constant {cons_name=C_LIST_FOLD;arguments= _}
| E_matching _ -> ok @@ (false, (decl_var,free_var),ass_exp)
| _ -> ok (true, (decl_var, free_var),ass_exp)
)
(element_names,[])
for_body in
ok @@ captured_names
and repair_mutable_variable_in_loops (for_body : expression) (element_names : expression_variable list) (env : expression_variable) =
let%bind captured_names = Self_ast_imperative.fold_map_expression
(* TODO : these should use Variables sets *)
(fun (decl_var,free_var : expression_variable list * expression_variable list) (ass_exp : expression) ->
match ass_exp.expression_content with
| E_let_in {let_binder;mut=false;rhs;let_result} ->
let (name,_) = let_binder in
ok (true,(name::decl_var, free_var),e_let_in let_binder false false rhs let_result)
| E_let_in {let_binder;mut=true; rhs;let_result} ->
let (name,_) = let_binder in
if List.mem name decl_var then
ok (true,(decl_var, free_var), e_let_in let_binder false false rhs let_result)
else(
let free_var = if (List.mem name free_var) then free_var else name::free_var in
let expr = e_let_in (env,None) false false (
e_update (e_variable env) ("0")
(e_update (e_accessor (e_variable env) "0") (Var.to_name name) (e_variable name))
)
let_result in
ok (true,(decl_var, free_var), e_let_in let_binder false false rhs expr)
)
| E_variable name ->
if List.mem name decl_var || List.mem name free_var || Var.equal name env then
ok (true,(decl_var, free_var), e_variable name)
else
ok (true,(decl_var, name::free_var), e_variable name)
| E_constant {cons_name=C_MAP_FOLD;arguments= _}
| E_constant {cons_name=C_SET_FOLD;arguments= _}
| E_constant {cons_name=C_LIST_FOLD;arguments= _}
| E_matching _ -> ok @@ (false,(decl_var,free_var),ass_exp)
| _ -> ok (true,(decl_var, free_var),ass_exp)
)
(element_names,[])
for_body in
ok @@ captured_names
and store_mutable_variable (free_vars : expression_variable list) =
if (List.length free_vars == 0) then
e_unit ()
else
let aux var = (Var.to_name var, e_variable var) in
e_record_ez (List.map aux free_vars)
and restore_mutable_variable (expr : expression->expression) (free_vars : expression_variable list) (env :expression_variable) =
let aux (f:expression -> expression) (ev:expression_variable) =
ok @@ fun expr -> f (e_let_in (ev,None) true false (e_accessor (e_variable env) (Var.to_name ev)) expr)
in
let%bind ef = bind_fold_list aux (fun e -> e) free_vars in
ok @@ fun expr'_opt -> match expr'_opt with
| None -> ok @@ expr (ef (e_skip ()))
| Some expr' -> ok @@ expr (ef expr')
module Errors = struct
@ -433,10 +349,7 @@ let rec compile_expression (t:Raw.expr) : expr result =
let%bind expr = compile_expression c.test in
let%bind match_true = compile_expression c.ifso in
let%bind match_false = compile_expression c.ifnot in
let match_expr = e_matching expr ~loc (Match_bool {match_true; match_false}) in
let env = Var.fresh () in
let%bind (_, match_expr) = repair_mutable_variable_in_matching match_expr [] env in
return @@ match_expr
return @@ e_matching expr ~loc (Match_bool {match_true; match_false})
| ECase c -> (
let (c , loc) = r_split c in
@ -450,10 +363,7 @@ let rec compile_expression (t:Raw.expr) : expr result =
@@ List.map get_value
@@ npseq_to_list c.cases.value in
let%bind cases = compile_cases lst in
let match_expr = e_matching ~loc e cases in
let env = Var.fresh () in
let%bind (_, match_expr) = repair_mutable_variable_in_matching match_expr [] env in
return @@ match_expr
return @@ e_matching ~loc e cases
)
| EMap (MapInj mi) -> (
let (mi , loc) = r_split mi in
@ -819,35 +729,6 @@ and compile_statement_list statements =
hook (compile_data_declaration d :: acc) statements
in bind_list @@ hook [] (List.rev statements)
and get_case_variables (t:Raw.pattern) : expression_variable list result =
match t with
| PConstr PFalse _
| PConstr PTrue _
| PConstr PNone _ -> ok @@ []
| PConstr PSomeApp v -> (let (_,v) = v.value in get_case_variables (v.value.inside))
| PConstr PConstrApp v -> (
match v.value with
| constr, None -> ok @@ [ Var.of_name constr.value]
| constr, pat_opt ->
let%bind pat =
trace_option (unsupported_cst_constr t) @@
pat_opt in
let pat = npseq_to_list pat.value.inside in
let%bind var = bind_map_list get_case_variables pat in
ok @@ [Var.of_name constr.value ] @ (List.concat var)
)
| PList PNil _ -> ok @@ []
| PList PCons c -> (
match c.value with
| a, [(_, b)] ->
let%bind a = get_case_variables a in
let%bind b = get_case_variables b in
ok @@ a@b
| _ -> fail @@ unsupported_deep_list_patterns c
)
| PVar v -> ok @@ [Var.of_name v.value]
| p -> fail @@ unsupported_cst_constr p
and compile_single_instruction : Raw.instruction -> (_ -> expression result) result =
fun t ->
match t with
@ -877,14 +758,33 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
return_statement @@ e_skip ~loc ()
)
| Loop (While l) ->
compile_while_loop l.value
let (wl, loc) = r_split l in
let%bind condition = compile_expression wl.cond in
let%bind body = compile_block wl.block.value in
let%bind body = body @@ None in
return_statement @@ e_while ~loc condition body
| Loop (For (ForInt fi)) -> (
let%bind loop = compile_for_int fi.value in
ok loop
let (fi,loc) = r_split fi in
let binder = Var.of_name fi.assign.value.name.value in
let%bind start = compile_expression fi.assign.value.expr in
let%bind bound = compile_expression fi.bound in
let increment = e_int 1 in
let%bind body = compile_block fi.block.value in
let%bind body = body @@ None in
return_statement @@ e_for ~loc binder start bound increment body
)
| Loop (For (ForCollect fc)) ->
let%bind loop = compile_for_collect fc.value in
ok loop
let (fc,loc) = r_split fc in
let binder = (Var.of_name fc.var.value, Option.map (fun x -> Var.of_name (snd x:string Raw.reg).value) fc.bind_to) in
let%bind collection = compile_expression fc.expr in
let collection_type = match fc.collection with
| Map _ -> Map
| Set _ -> Set
| List _ -> List
in
let%bind body = compile_block fc.block.value in
let%bind body = body @@ None in
return_statement @@ e_for_each ~loc binder collection collection_type body
| Cond c -> (
let (c , loc) = r_split c in
let%bind expr = compile_expression c.test in
@ -906,26 +806,10 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
compile_block value
| ShortBlock {value; _} ->
compile_statements @@ fst value.inside in
let env = Var.fresh () in
let%bind match_true' = match_true None in
let%bind match_false' = match_false None in
let%bind match_true = match_true @@ Some (e_variable env) in
let%bind match_false = match_false @@ Some (e_variable env) in
let%bind ((_,free_vars_true), match_true) = repair_mutable_variable_in_matching match_true [] env in
let%bind ((_,free_vars_false), match_false) = repair_mutable_variable_in_matching match_false [] env in
let free_vars = free_vars_true @ free_vars_false in
if (List.length free_vars != 0) then
let match_expr = e_matching expr ~loc (Match_bool {match_true; match_false}) in
let return_expr = fun expr ->
e_let_in (env,None) false false (store_mutable_variable free_vars) @@
e_let_in (env,None) false false match_expr @@
expr
in
restore_mutable_variable return_expr free_vars env
else
return_statement @@ e_matching expr ~loc (Match_bool {match_true=match_true'; match_false=match_false'})
let%bind match_true = match_true None in
let%bind match_false = match_false None in
return_statement @@ e_matching expr ~loc (Match_bool {match_true; match_false})
)
| Assign a -> (
let (a , loc) = r_split a in
@ -954,9 +838,8 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
| CaseInstr c -> (
let (c , loc) = r_split c in
let%bind expr = compile_expression c.expr in
let env = Var.fresh () in
let%bind (fv,cases) =
let aux fv (x : Raw.if_clause Raw.case_clause Raw.reg) =
let%bind cases =
let aux (x : Raw.if_clause Raw.case_clause Raw.reg) =
let%bind case_clause =
match x.value.rhs with
ClauseInstr i ->
@ -967,28 +850,13 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
compile_block value
| ShortBlock {value; _} ->
compile_statements @@ fst value.inside in
let%bind case_clause'= case_clause @@ None in
let%bind case_clause = case_clause @@ Some(e_variable env) in
let%bind case_vars = get_case_variables x.value.pattern in
let%bind ((_,free_vars), case_clause) = repair_mutable_variable_in_matching case_clause case_vars env in
ok (free_vars::fv,(x.value.pattern, case_clause, case_clause')) in
bind_fold_map_list aux [] (npseq_to_list c.cases.value) in
let free_vars = List.concat fv in
if (List.length free_vars == 0) then (
let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in
let%bind m = compile_cases cases in
return_statement @@ e_matching ~loc expr m
) else (
let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in
let%bind m = compile_cases cases in
let match_expr = e_matching ~loc expr m in
let return_expr = fun expr ->
e_let_in (env,None) false false (store_mutable_variable free_vars) @@
e_let_in (env,None) false false match_expr @@
expr
in
restore_mutable_variable return_expr free_vars env
)
let%bind case_clause = case_clause None in
ok (x.value.pattern, case_clause) in
bind_list
@@ List.map aux
@@ npseq_to_list c.cases.value in
let%bind m = compile_cases cases in
return_statement @@ e_matching ~loc expr m
)
| RecordPatch r -> (
let reg = r.region in
@ -1204,121 +1072,6 @@ and compile_statements : Raw.statements -> (_ -> expression result) result =
and compile_block : Raw.block -> (_ -> expression result) result =
fun t -> compile_statements t.statements
and compile_while_loop : Raw.while_loop -> (_ -> expression result) result = fun wl ->
let env_rec = Var.fresh () in
let binder = Var.fresh () in
let%bind cond = compile_expression wl.cond in
let ctrl =
(e_variable binder)
in
let%bind for_body = compile_block wl.block.value in
let%bind for_body = for_body @@ Some( ctrl ) in
let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [] binder in
let aux name expr=
e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr
in
let init_rec = e_tuple [store_mutable_variable @@ captured_name_list] in
let restore = fun expr -> List.fold_right aux captured_name_list expr in
let continue_expr = e_constant C_FOLD_CONTINUE [for_body] in
let stop_expr = e_constant C_FOLD_STOP [e_variable binder] in
let aux_func =
e_lambda binder None None @@
restore @@
e_cond cond continue_expr stop_expr in
let loop = e_constant C_FOLD_WHILE [aux_func; e_variable env_rec] in
let return_expr = fun expr ->
e_let_in (env_rec,None) false false init_rec @@
e_let_in (env_rec,None) false false loop @@
e_let_in (env_rec,None) false false (e_accessor (e_variable env_rec) "0") @@
expr
in
restore_mutable_variable return_expr captured_name_list env_rec
and compile_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
let env_rec = Var.fresh () in
let binder = Var.fresh () in
let name = fi.assign.value.name.value in
let it = Var.of_name name in
let var = e_variable it in
(*Make the cond and the step *)
let%bind value = compile_expression fi.assign.value.expr in
let%bind bound = compile_expression fi.bound in
let cond = e_annotation (e_constant C_LE [var ; bound]) t_bool in
let step = e_int 1 in
let continue_expr = e_constant C_FOLD_CONTINUE [(e_variable binder)] in
let ctrl =
e_let_in (it,Some t_int) false false (e_constant C_ADD [ var ; step ]) @@
e_let_in (binder, None) false false (e_update (e_variable binder) "1" var)@@
continue_expr
in
(* Modify the body loop*)
let%bind for_body = compile_block fi.block.value in
let%bind for_body = for_body @@ Some ctrl in
let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [it] binder in
let aux name expr=
e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr
in
(* restores the initial value of the free_var*)
let restore = fun expr -> List.fold_right aux captured_name_list expr in
(*Prep the lambda for the fold*)
let stop_expr = e_constant C_FOLD_STOP [e_variable binder] in
let aux_func = e_lambda binder None None @@
e_let_in (it,Some t_int) false false (e_accessor (e_variable binder) "1") @@
e_cond cond (restore for_body) (stop_expr) in
(* Make the fold_while en precharge the vakye *)
let loop = e_constant C_FOLD_WHILE [aux_func; e_variable env_rec] in
let init_rec = e_pair (store_mutable_variable @@ captured_name_list) var in
let return_expr = fun expr ->
e_let_in (it, Some t_int) false false value @@
e_let_in (env_rec,None) false false init_rec @@
e_let_in (env_rec,None) false false loop @@
e_let_in (env_rec,None) false false (e_accessor (e_variable env_rec) "0") @@
expr
in
restore_mutable_variable return_expr captured_name_list env_rec
and compile_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc ->
let binder = Var.of_name "arguments" in
let%bind element_names = ok @@ match fc.bind_to with
| Some v -> [Var.of_name fc.var.value;Var.of_name (snd v).value]
| None -> [Var.of_name fc.var.value] in
let env = Var.fresh () in
let%bind for_body = compile_block fc.block.value in
let%bind for_body = for_body @@ Some (e_accessor (e_variable binder) "0") in
let%bind ((_,free_vars), for_body) = repair_mutable_variable_in_loops for_body element_names binder in
let init_record = store_mutable_variable free_vars in
let%bind collect = compile_expression fc.expr in
let aux name expr=
e_let_in (name,None) false false (e_accessor (e_accessor (e_variable binder) "0") (Var.to_name name)) expr
in
let restore = fun expr -> List.fold_right aux free_vars expr in
let restore = match fc.collection with
| Map _ -> (match fc.bind_to with
| Some v -> fun expr -> restore (e_let_in (Var.of_name fc.var.value, None) false false (e_accessor (e_accessor (e_variable binder) "1") "0")
(e_let_in (Var.of_name (snd v).value, None) false false (e_accessor (e_accessor (e_variable binder) "1") "1") expr))
| None -> fun expr -> restore (e_let_in (Var.of_name fc.var.value, None) false false (e_accessor (e_accessor (e_variable binder) "1") "0") expr)
)
| _ -> fun expr -> restore (e_let_in (Var.of_name fc.var.value, None) false false (e_accessor (e_variable binder) "1") expr)
in
let lambda = e_lambda binder None None (restore for_body) in
let op_name = match fc.collection with
| Map _ -> C_MAP_FOLD | Set _ -> C_SET_FOLD | List _ -> C_LIST_FOLD in
let fold = fun expr ->
e_let_in (env,None) false false (e_constant op_name [lambda; collect ; init_record]) @@
expr
in
restore_mutable_variable fold free_vars env
and compile_declaration_list declarations : declaration Location.wrap list result =
let open Raw in

34
src/passes/3-self_ast_imperative/helpers.ml
View File

@ -63,6 +63,17 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
let ab = (expr1,expr2) in
let%bind res = bind_fold_pair self init' ab in
ok res
| E_for {body; _} ->
let%bind res = self init' body in
ok res
| E_for_each {collection; body; _} ->
let%bind res = self init' collection in
let%bind res = self res body in
ok res
| E_while {condition; body} ->
let%bind res = self init' condition in
let%bind res = self res body in
ok res
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
@ -176,6 +187,18 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
let%bind (expr1,expr2) = bind_map_pair self (expr1,expr2) in
return @@ E_sequence {expr1;expr2}
)
| E_for {binder; start; final; increment; body} ->
let%bind body = self body in
return @@ E_for {binder; start; final; increment; body}
| E_for_each {binder; collection; collection_type; body} ->
let%bind collection = self collection in
let%bind body = self body in
return @@ E_for_each {binder; collection; collection_type; body}
| E_while {condition; body} ->
let%bind condition = self condition in
let%bind body = self body in
return @@ E_while {condition; body}
| E_literal _ | E_variable _ | E_skip as e' -> return e'
and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
@ -323,6 +346,17 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
let%bind (res,(expr1,expr2)) = bind_fold_map_pair self init' (expr1,expr2) in
ok (res, return @@ E_sequence {expr1;expr2})
)
| E_for {binder; start; final; increment; body} ->
let%bind (res, body) = self init' body in
ok (res, return @@ E_for {binder; start; final; increment; body})
| E_for_each {binder; collection; collection_type; body} ->
let%bind res,collection = self init' collection in
let%bind res,body = self res body in
ok (res, return @@ E_for_each {binder; collection; collection_type; body})
| E_while {condition; body} ->
let%bind res,condition = self init' condition in
let%bind res,body = self res body in
ok (res, return @@ E_while {condition; body})
| E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e')
and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->

1
src/passes/4-imperative_to_sugar/dune
View File

@ -5,6 +5,7 @@
simple-utils
ast_imperative
ast_sugar
self_ast_sugar
proto-alpha-utils
)
(preprocess

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

@ -2,6 +2,105 @@ module I = Ast_imperative
module O = Ast_sugar
open Trace
module Errors = struct
let bad_collection expr =
let title () = "" in
let message () = Format.asprintf "\nCannot loop over this collection : %a\n" I.PP.expression expr in
let data = [
("location",
fun () -> Format.asprintf "%a" Location.pp expr.location)
] in
error ~data title message
end
let rec add_to_end (expression: O.expression) to_add =
match expression.expression_content with
| O.E_let_in lt ->
let lt = {lt with let_result = add_to_end lt.let_result to_add} in
{expression with expression_content = O.E_let_in lt}
| O.E_sequence seq ->
let seq = {seq with expr2 = add_to_end seq.expr2 to_add} in
{expression with expression_content = O.E_sequence seq}
| _ -> O.e_sequence expression to_add
let repair_mutable_variable_in_matching (match_body : O.expression) (element_names : O.expression_variable list) (env : I.expression_variable) =
let%bind ((dv,fv),mb) = Self_ast_sugar.fold_map_expression
(* TODO : these should use Variables sets *)
(fun (decl_var,free_var : O.expression_variable list * O.expression_variable list) (ass_exp : O.expression) ->
match ass_exp.expression_content with
| E_let_in {let_binder;mut=false;rhs;let_result} ->
let (name,_) = let_binder in
ok (true,(name::decl_var, free_var),O.e_let_in let_binder false false rhs let_result)
| E_let_in {let_binder;mut=true; rhs;let_result} ->
let (name,_) = let_binder in
if List.mem name decl_var then
ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result)
else(
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_update (O.e_variable env) (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)
)
| E_constant {cons_name=C_MAP_FOLD;arguments= _}
| E_constant {cons_name=C_SET_FOLD;arguments= _}
| E_constant {cons_name=C_LIST_FOLD;arguments= _}
| E_matching _ -> ok @@ (false, (decl_var,free_var),ass_exp)
| _ -> ok (true, (decl_var, free_var),ass_exp)
)
(element_names,[])
match_body in
ok @@ ((dv,fv),mb)
and repair_mutable_variable_in_loops (for_body : O.expression) (element_names : O.expression_variable list) (env : O.expression_variable) =
let%bind ((dv,fv),fb) = Self_ast_sugar.fold_map_expression
(* TODO : these should use Variables sets *)
(fun (decl_var,free_var : O.expression_variable list * O.expression_variable list) (ass_exp : O.expression) ->
(* Format.printf "debug: dv:%a; fv:%a; expr:%a \n%!"
(I.PP.list_sep_d I.PP.expression_variable) decl_var
(I.PP.list_sep_d I.PP.expression_variable) decl_var
O.PP.expression ass_exp
;*)
match ass_exp.expression_content with
| E_let_in {let_binder;mut=false;} ->
let (name,_) = let_binder in
ok (true,(name::decl_var, free_var),ass_exp)
| E_let_in {let_binder;mut=true; rhs;let_result} ->
let (name,_) = let_binder in
if List.mem name decl_var then
ok (true,(decl_var, free_var), O.e_let_in let_binder false false rhs let_result)
else(
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_update (O.e_variable env) ("0")
(O.e_update (O.e_accessor (O.e_variable env) "0") (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)
)
| E_constant {cons_name=C_MAP_FOLD;arguments= _}
| E_constant {cons_name=C_SET_FOLD;arguments= _}
| E_constant {cons_name=C_LIST_FOLD;arguments= _}
| E_matching _ -> ok @@ (false,(decl_var,free_var),ass_exp)
| _ -> ok (true,(decl_var, free_var),ass_exp)
)
(element_names,[])
for_body in
ok @@ ((dv,fv),fb)
and store_mutable_variable (free_vars : I.expression_variable list) =
if (List.length free_vars == 0) then
O.e_unit ()
else
let aux var = (Var.to_name var, O.e_variable var) in
O.e_record_ez (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) =
let aux (f: O.expression -> O.expression) (ev: O.expression_variable) =
fun expr -> f (O.e_let_in (ev,None) true false (O.e_accessor (O.e_variable env) (Var.to_name ev)) expr)
in
let ef = List.fold_left aux (fun e -> e) free_vars in
expr (ef (O.e_skip ()))
let rec compile_type_expression : I.type_expression -> O.type_expression result =
fun te ->
let return te = ok @@ O.make_t te in
@ -79,19 +178,18 @@ let rec compile_expression : I.expression -> O.expression result =
let%bind fun_type = compile_type_expression fun_type in
let%bind lambda = compile_lambda lambda in
return @@ O.E_recursive {fun_name;fun_type;lambda}
| I.E_let_in {let_binder;mut=_;inline;rhs;let_result} ->
| I.E_let_in {let_binder;mut;inline;rhs;let_result} ->
let (binder,ty_opt) = let_binder in
let%bind ty_opt = bind_map_option compile_type_expression ty_opt in
let%bind rhs = compile_expression rhs in
let%bind let_result = compile_expression let_result in
return @@ O.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
return @@ O.E_let_in {let_binder=(binder,ty_opt);mut;inline;rhs;let_result}
| I.E_constructor {constructor;element} ->
let%bind element = compile_expression element in
return @@ O.E_constructor {constructor;element}
| I.E_matching {matchee; cases} ->
let%bind matchee = compile_expression matchee in
let%bind cases = compile_matching cases in
return @@ O.E_matching {matchee;cases}
| I.E_matching m ->
let%bind m = compile_matching m in
return @@ m
| I.E_record record ->
let record = I.LMap.to_kv_list record in
let%bind record =
@ -136,43 +234,237 @@ let rec compile_expression : I.expression -> O.expression result =
| I.E_sequence {expr1; expr2} ->
let%bind expr1 = compile_expression expr1 in
let%bind expr2 = compile_expression expr2 in
return @@ O.E_sequence {expr1; expr2}
ok @@ add_to_end expr1 expr2
| I.E_skip -> return @@ O.E_skip
| I.E_for f ->
let%bind f = compile_for f in
return @@ f
| I.E_for_each fe ->
let%bind fe = compile_for_each fe in
return @@ fe
| I.E_while w ->
let%bind w = compile_while w in
return @@ w
and compile_lambda : I.lambda -> O.lambda result =
fun {binder;input_type;output_type;result}->
let%bind input_type = bind_map_option compile_type_expression input_type in
let%bind output_type = bind_map_option compile_type_expression output_type in
let%bind result = compile_expression result in
ok @@ O.{binder;input_type;output_type;result}
and compile_matching : I.matching_expr -> O.matching_expr result =
fun m ->
match m with
and compile_matching : I.matching -> O.expression_content result =
fun {matchee;cases} ->
let%bind matchee = compile_expression matchee in
match cases with
| I.Match_bool {match_true;match_false} ->
let%bind match_true = compile_expression match_true in
let%bind match_false = compile_expression match_false in
ok @@ O.Match_bool {match_true;match_false}
| I.Match_list {match_nil;match_cons} ->
let%bind match_nil = compile_expression match_nil in
let (hd,tl,expr,tv) = match_cons in
let%bind expr = compile_expression expr in
ok @@ O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
let%bind match_true' = compile_expression match_true in
let%bind match_false' = compile_expression match_false in
let env = Var.fresh () in
let%bind ((_,free_vars_true), match_true) = repair_mutable_variable_in_matching match_true' [] env in
let%bind ((_,free_vars_false), match_false) = repair_mutable_variable_in_matching match_false' [] env in
let match_true = add_to_end match_true (O.e_variable env) in
let match_false = add_to_end match_false (O.e_variable env) in
let free_vars = List.sort_uniq Var.compare @@ free_vars_true @ free_vars_false in
if (List.length free_vars != 0) then
let match_expr = O.e_matching matchee (O.Match_bool {match_true; match_false}) in
let return_expr = fun expr ->
O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars);
let_result=O.e_let_in (env,None) false false match_expr @@
expr
}
in
ok @@ restore_mutable_variable return_expr free_vars env
else
ok @@ O.E_matching {matchee;cases=O.Match_bool {match_true=match_true';match_false=match_false'}}
| I.Match_option {match_none;match_some} ->
let%bind match_none = compile_expression match_none in
let%bind match_none' = compile_expression match_none in
let (n,expr,tv) = match_some in
let%bind expr = compile_expression expr in
ok @@ O.Match_option {match_none; match_some=(n,expr,tv)}
let%bind expr' = compile_expression expr in
let env = Var.fresh () in
let%bind ((_,free_vars_none), match_none) = repair_mutable_variable_in_matching match_none' [] env in
let%bind ((_,free_vars_some), expr) = repair_mutable_variable_in_matching expr' [n] env in
let match_none = add_to_end match_none (O.e_variable env) in
let expr = add_to_end expr (O.e_variable env) in
let free_vars = List.sort_uniq Var.compare @@ free_vars_none @ free_vars_some in
if (List.length free_vars != 0) then
let match_expr = O.e_matching matchee (O.Match_option {match_none; match_some=(n,expr,tv)}) in
let return_expr = fun expr ->
O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars);
let_result=O.e_let_in (env,None) false false match_expr @@
expr
}
in
ok @@ restore_mutable_variable return_expr free_vars env
else
ok @@ O.E_matching {matchee; cases=O.Match_option {match_none=match_none'; match_some=(n,expr',tv)}}
| I.Match_list {match_nil;match_cons} ->
let%bind match_nil' = compile_expression match_nil in
let (hd,tl,expr,tv) = match_cons in
let%bind expr' = compile_expression expr in
let env = Var.fresh () in
let%bind ((_,free_vars_nil), match_nil) = repair_mutable_variable_in_matching match_nil' [] env in
let%bind ((_,free_vars_cons), expr) = repair_mutable_variable_in_matching expr' [hd;tl] env in
let match_nil = add_to_end match_nil (O.e_variable env) in
let expr = add_to_end expr (O.e_variable env) in
let free_vars = List.sort_uniq Var.compare @@ free_vars_nil @ free_vars_cons in
if (List.length free_vars != 0) then
let match_expr = O.e_matching matchee (O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}) in
let return_expr = fun expr ->
O.E_let_in {let_binder=(env,None); mut=false; inline=false;rhs=(store_mutable_variable free_vars);
let_result=O.e_let_in (env,None) false false match_expr @@
expr
}
in
ok @@ restore_mutable_variable return_expr free_vars env
else
ok @@ O.E_matching {matchee;cases=O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr',tv)}}
| I.Match_tuple ((lst,expr), tv) ->
let%bind expr = compile_expression expr in
ok @@ O.Match_tuple ((lst,expr), tv)
ok @@ O.E_matching {matchee; cases=O.Match_tuple ((lst,expr), tv)}
| I.Match_variant (lst,tv) ->
let%bind lst = bind_map_list (
fun ((c,n),expr) ->
let%bind expr = compile_expression expr in
ok @@ ((c,n),expr)
) lst
in
ok @@ O.Match_variant (lst,tv)
let env = Var.fresh () in
let aux fv ((c,n),expr) =
let%bind expr = compile_expression expr in
let%bind ((_,free_vars), case_clause) = repair_mutable_variable_in_matching expr [n] env in
let case_clause'= expr in
let case_clause = add_to_end case_clause (O.e_variable env) in
ok (free_vars::fv,((c,n), case_clause, case_clause')) in
let%bind (fv,cases) = bind_fold_map_list aux [] lst in
let free_vars = List.sort_uniq Var.compare @@ List.concat fv in
if (List.length free_vars == 0) then (
let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in
ok @@ O.E_matching{matchee; cases=O.Match_variant (cases,tv)}
) else (
let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in
let match_expr = O.e_matching matchee @@ O.Match_variant (cases,tv) in
let return_expr = fun expr ->
O.E_let_in {let_binder=(env,None); mut=false; inline=false; rhs=(store_mutable_variable free_vars);
let_result=O.e_let_in (env,None) false false match_expr @@
expr
}
in
ok @@ restore_mutable_variable return_expr free_vars env
)
and compile_while I.{condition;body} =
let env_rec = Var.fresh () in
let binder = Var.fresh () in
let%bind cond = compile_expression condition in
let ctrl =
(O.e_variable binder)
in
let%bind for_body = compile_expression body in
let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops for_body [] binder in
let for_body = add_to_end for_body ctrl in
let aux name expr=
O.e_let_in (name,None) false false (O.e_accessor (O.e_accessor (O.e_variable binder) "0") (Var.to_name name)) expr
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 continue_expr = O.e_constant C_FOLD_CONTINUE [for_body] in
let stop_expr = O.e_constant C_FOLD_STOP [O.e_variable binder] in
let aux_func =
O.e_lambda binder None None @@
restore @@
O.e_cond cond continue_expr stop_expr in
let loop = O.e_constant C_FOLD_WHILE [aux_func; O.e_variable env_rec] in
let let_binder = (env_rec,None) in
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 false false loop @@
O.e_let_in let_binder false false (O.e_accessor (O.e_variable env_rec) "0") @@
expr
}
in
ok @@ restore_mutable_variable return_expr captured_name_list env_rec
and compile_for I.{binder;start;final;increment;body} =
let env_rec = Var.fresh () in
(*Make the cond and the step *)
let cond = I.e_annotation (I.e_constant C_LE [I.e_variable binder ; final]) I.t_bool in
let%bind cond = compile_expression cond in
let%bind step = compile_expression increment in
let continue_expr = O.e_constant C_FOLD_CONTINUE [(O.e_variable env_rec)] in
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 (env_rec, None) false false (O.e_update (O.e_variable env_rec) "1" @@ O.e_variable binder)@@
continue_expr
in
(* Modify the body loop*)
let%bind body = compile_expression body in
let%bind ((_,captured_name_list),for_body) = repair_mutable_variable_in_loops body [binder] env_rec in
let for_body = add_to_end for_body ctrl in
let aux name expr=
O.e_let_in (name,None) false false (O.e_accessor (O.e_accessor (O.e_variable env_rec) "0") (Var.to_name name)) expr
in
(* restores the initial value of the free_var*)
let restore = fun expr -> List.fold_right aux captured_name_list expr in
(*Prep the lambda for the fold*)
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 @@
O.e_let_in (binder,Some O.t_int) false false (O.e_accessor (O.e_variable env_rec) "1") @@
O.e_cond cond (restore for_body) (stop_expr) in
(* Make the fold_while en precharge the vakye *)
let loop = O.e_constant C_FOLD_WHILE [aux_func; O.e_variable env_rec] in
let init_rec = O.e_pair (store_mutable_variable captured_name_list) @@ O.e_variable binder in
let%bind start = compile_expression start in
let let_binder = (env_rec,None) in
let return_expr = fun expr ->
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 loop @@
O.e_let_in let_binder false false (O.e_accessor (O.e_variable env_rec) "0") @@
expr
}
in
ok @@ restore_mutable_variable return_expr captured_name_list env_rec
and compile_for_each I.{binder;collection;collection_type; body} =
let args = Var.fresh () in
let%bind element_names = ok @@ match snd binder with
| Some v -> [fst binder;v]
| None -> [fst binder]
in
let env = Var.fresh () in
let%bind body = compile_expression body 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_accessor (O.e_variable args) "0") in
let init_record = store_mutable_variable free_vars in
let%bind collect = compile_expression collection in
let aux name expr=
O.e_let_in (name,None) false false (O.e_accessor (O.e_accessor (O.e_variable args) "0") (Var.to_name name)) expr
in
let restore = fun expr -> List.fold_right aux free_vars expr in
let restore = match collection_type with
| Map -> (match snd binder with
| Some v -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_accessor (O.e_accessor (O.e_variable args) "1") "0")
(O.e_let_in (v, None) false false (O.e_accessor (O.e_accessor (O.e_variable args) "1") "1") expr))
| None -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_accessor (O.e_accessor (O.e_variable args) "1") "0") expr)
)
| _ -> fun expr -> restore (O.e_let_in (fst binder, None) false false (O.e_accessor (O.e_variable args) "1") expr)
in
let lambda = O.e_lambda args None None (restore for_body) in
let%bind op_name = match collection_type with
| Map -> ok @@ O.C_MAP_FOLD | Set -> ok @@ O.C_SET_FOLD | List -> ok @@ O.C_LIST_FOLD
in
let fold = fun expr ->
O.E_let_in {let_binder=(env,None);mut=false; inline=false;rhs=(O.e_constant op_name [lambda; collect ; init_record]);
let_result=expr;}
in
ok @@ restore_mutable_variable fold free_vars env
let compile_declaration : I.declaration Location.wrap -> _ =
fun {wrap_content=declaration;location} ->
let return decl = ok @@ Location.wrap ~loc:location decl in

356
src/passes/5-self_ast_sugar/helpers.ml Normal file
View File

@ -0,0 +1,356 @@
open Ast_sugar
open Trace
open Stage_common.Helpers
type 'a folder = 'a -> expression -> 'a result
let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e ->
let self = fold_expression f in
let%bind init' = f init e in
match e.expression_content with
| E_literal _ | E_variable _ | E_skip -> ok init'
| E_list lst | E_set lst | E_constant {arguments=lst} -> (
let%bind res = bind_fold_list self init' lst in
ok res
)
| E_map lst | E_big_map lst -> (
let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
ok res
)
| E_look_up ab ->
let%bind res = bind_fold_pair self init' ab in
ok res
| E_application {lamb;args} -> (
let ab = (lamb,args) in
let%bind res = bind_fold_pair self init' ab in
ok res
)
| E_lambda { binder = _ ; input_type = _ ; output_type = _ ; result = e }
| E_ascription {anno_expr=e; _} | E_constructor {element=e} -> (
let%bind res = self init' e in
ok res
)
| E_matching {matchee=e; cases} -> (
let%bind res = self init' e in
let%bind res = fold_cases f res cases in
ok res
)
| E_record m -> (
let aux init'' _ expr =
let%bind res = fold_expression self init'' expr in
ok res
in
let%bind res = bind_fold_lmap aux (ok init') m in
ok res
)
| E_record_update {record;update} -> (
let%bind res = self init' record in
let%bind res = fold_expression self res update in
ok res
)
| E_record_accessor {expr} -> (
let%bind res = self init' expr in
ok res
)
| E_let_in { let_binder = _ ; rhs ; let_result } -> (
let%bind res = self init' rhs in
let%bind res = self res let_result in
ok res
)
| E_recursive { lambda={result=e;_}; _} ->
let%bind res = self init' e in
ok res
| E_sequence {expr1;expr2} ->
let ab = (expr1,expr2) in
let%bind res = bind_fold_pair self init' ab in
ok res
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
match m with
| Match_bool { match_true ; match_false } -> (
let%bind res = fold_expression f init match_true in
let%bind res = fold_expression f res match_false in
ok res
)
| Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
let%bind res = fold_expression f init match_nil in
let%bind res = fold_expression f res cons in
ok res
)
| Match_option { match_none ; match_some = (_ , some, _) } -> (
let%bind res = fold_expression f init match_none in
let%bind res = fold_expression f res some in
ok res
)
| Match_tuple ((_ , e), _) -> (
let%bind res = fold_expression f init e in
ok res
)
| Match_variant (lst, _) -> (
let aux init' ((_ , _) , e) =
let%bind res' = fold_expression f init' e in
ok res' in
let%bind res = bind_fold_list aux init lst in
ok res
)
type exp_mapper = expression -> expression result
type ty_exp_mapper = type_expression -> type_expression result
type abs_mapper =
| Expression of exp_mapper
| Type_expression of ty_exp_mapper
let rec map_expression : exp_mapper -> expression -> expression result = fun f e ->
let self = map_expression f in
let%bind e' = f e in
let return expression_content = ok { e' with expression_content } in
match e'.expression_content with
| E_list lst -> (
let%bind lst' = bind_map_list self lst in
return @@ E_list lst'
)
| E_set lst -> (
let%bind lst' = bind_map_list self lst in
return @@ E_set lst'
)
| E_map lst -> (
let%bind lst' = bind_map_list (bind_map_pair self) lst in
return @@ E_map lst'
)
| E_big_map lst -> (
let%bind lst' = bind_map_list (bind_map_pair self) lst in
return @@ E_big_map lst'
)
| E_look_up ab -> (
let%bind ab' = bind_map_pair self ab in
return @@ E_look_up ab'
)
| E_ascription ascr -> (
let%bind e' = self ascr.anno_expr in
return @@ E_ascription {ascr with anno_expr=e'}
)
| E_matching {matchee=e;cases} -> (
let%bind e' = self e in
let%bind cases' = map_cases f cases in
return @@ E_matching {matchee=e';cases=cases'}
)
| E_record_accessor acc -> (
let%bind e' = self acc.expr in
return @@ E_record_accessor {acc with expr = e'}
)
| E_record m -> (
let%bind m' = bind_map_lmap self m in
return @@ E_record m'
)
| E_record_update {record; path; update} -> (
let%bind record = self record in
let%bind update = self update in
return @@ E_record_update {record;path;update}
)
| E_constructor c -> (
let%bind e' = self c.element in
return @@ E_constructor {c with element = e'}
)
| E_application {lamb;args} -> (
let ab = (lamb,args) in
let%bind (lamb,args) = bind_map_pair self ab in
return @@ E_application {lamb;args}
)
| E_let_in { let_binder ; mut; rhs ; let_result; inline } -> (
let%bind rhs = self rhs in
let%bind let_result = self let_result in
return @@ E_let_in { let_binder ; mut; rhs ; let_result; inline }
)
| E_lambda { binder ; input_type ; output_type ; result } -> (
let%bind result = self result in
return @@ E_lambda { binder ; input_type ; output_type ; result }
)
| E_recursive { fun_name; fun_type; lambda} ->
let%bind result = self lambda.result in
let lambda = {lambda with result} in
return @@ E_recursive { fun_name; fun_type; lambda}
| E_constant c -> (
let%bind args = bind_map_list self c.arguments in
return @@ E_constant {c with arguments=args}
)
| E_sequence {expr1;expr2} -> (
let%bind (expr1,expr2) = bind_map_pair self (expr1,expr2) in
return @@ E_sequence {expr1;expr2}
)
| E_literal _ | E_variable _ | E_skip as e' -> return e'
and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
let self = map_type_expression f in
let%bind te' = f te in
let return type_content = ok { te' with type_content } in
match te'.type_content with
| T_sum temap ->
let%bind temap' = bind_map_cmap self temap in
return @@ (T_sum temap')
| T_record temap ->
let%bind temap' = bind_map_lmap self temap in
return @@ (T_record temap')
| T_arrow {type1 ; type2} ->
let%bind type1' = self type1 in
let%bind type2' = self type2 in
return @@ (T_arrow {type1=type1' ; type2=type2'})
| T_operator _
| T_variable _ | T_constant _ -> ok te'
and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
match m with
| Match_bool { match_true ; match_false } -> (
let%bind match_true = map_expression f match_true in
let%bind match_false = map_expression f match_false in
ok @@ Match_bool { match_true ; match_false }
)
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
let%bind match_nil = map_expression f match_nil in
let%bind cons = map_expression f cons in
ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, ()) }
)
| Match_option { match_none ; match_some = (name , some, _) } -> (
let%bind match_none = map_expression f match_none in
let%bind some = map_expression f some in
ok @@ Match_option { match_none ; match_some = (name , some, ()) }
)
| Match_tuple ((names , e), _) -> (
let%bind e' = map_expression f e in
ok @@ Match_tuple ((names , e'), [])
)
| Match_variant (lst, _) -> (
let aux ((a , b) , e) =
let%bind e' = map_expression f e in
ok ((a , b) , e')
in
let%bind lst' = bind_map_list aux lst in
ok @@ Match_variant (lst', ())
)
and map_program : abs_mapper -> program -> program result = fun m p ->
let aux = fun (x : declaration) ->
match x,m with
| (Declaration_constant (t , o , i, e), Expression m') -> (
let%bind e' = map_expression m' e in
ok (Declaration_constant (t , o , i, e'))
)
| (Declaration_type (tv,te), Type_expression m') -> (
let%bind te' = map_type_expression m' te in
ok (Declaration_type (tv, te'))
)
| decl,_ -> ok decl
(* | Declaration_type of (type_variable * type_expression) *)
in
bind_map_list (bind_map_location aux) p
type 'a fold_mapper = 'a -> expression -> (bool * 'a * expression) result
let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expression) result = fun f a e ->
let self = fold_map_expression f in
let%bind (continue, init',e') = f a e in
if (not continue) then ok(init',e')
else
let return expression_content = { e' with expression_content } in
match e'.expression_content with
| E_list lst -> (
let%bind (res, lst') = bind_fold_map_list self init' lst in
ok (res, return @@ E_list lst')
)
| E_set lst -> (
let%bind (res, lst') = bind_fold_map_list self init' lst in
ok (res, return @@ E_set lst')
)
| E_map lst -> (
let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
ok (res, return @@ E_map lst')
)
| E_big_map lst -> (
let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
ok (res, return @@ E_big_map lst')
)
| E_look_up ab -> (
let%bind (res, ab') = bind_fold_map_pair self init' ab in
ok (res, return @@ E_look_up ab')
)
| E_ascription ascr -> (
let%bind (res,e') = self init' ascr.anno_expr in
ok (res, return @@ E_ascription {ascr with anno_expr=e'})
)
| E_matching {matchee=e;cases} -> (
let%bind (res, e') = self init' e in
let%bind (res,cases') = fold_map_cases f res cases in
ok (res, return @@ E_matching {matchee=e';cases=cases'})
)
| E_record_accessor acc -> (
let%bind (res, e') = self init' acc.expr in
ok (res, return @@ E_record_accessor {acc with expr = e'})
)
| E_record m -> (
let%bind (res, lst') = bind_fold_map_list (fun res (k,e) -> let%bind (res,e) = self res e in ok (res,(k,e))) init' (LMap.to_kv_list m) in
let m' = LMap.of_list lst' in
ok (res, return @@ E_record m')
)
| E_record_update {record; path; update} -> (
let%bind (res, record) = self init' record in
let%bind (res, update) = self res update in
ok (res, return @@ E_record_update {record;path;update})
)
| E_constructor c -> (
let%bind (res,e') = self init' c.element in
ok (res, return @@ E_constructor {c with element = e'})
)
| E_application {lamb;args} -> (
let ab = (lamb,args) in
let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in
ok (res, return @@ E_application {lamb=a;args=b})
)
| E_let_in { let_binder ; mut; rhs ; let_result; inline } -> (
let%bind (res,rhs) = self init' rhs in
let%bind (res,let_result) = self res let_result in
ok (res, return @@ E_let_in { let_binder ; mut; rhs ; let_result ; inline })
)
| E_lambda { binder ; input_type ; output_type ; result } -> (
let%bind (res,result) = self init' result in
ok ( res, return @@ E_lambda { binder ; input_type ; output_type ; result })
)
| E_recursive { fun_name; fun_type; lambda} ->
let%bind (res, result) = self init' lambda.result in
let lambda = {lambda with result} in
ok ( res, return @@ E_recursive { fun_name; fun_type; lambda})
| E_constant c -> (
let%bind (res,args) = bind_fold_map_list self init' c.arguments in
ok (res, return @@ E_constant {c with arguments=args})
)
| E_sequence {expr1;expr2} -> (
let%bind (res,(expr1,expr2)) = bind_fold_map_pair self init' (expr1,expr2) in
ok (res, return @@ E_sequence {expr1;expr2})
)
| E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e')
and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
match m with
| Match_bool { match_true ; match_false } -> (
let%bind (init, match_true) = fold_map_expression f init match_true in
let%bind (init, match_false) = fold_map_expression f init match_false in
ok @@ (init, Match_bool { match_true ; match_false })
)
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
let%bind (init, match_nil) = fold_map_expression f init match_nil in
let%bind (init, cons) = fold_map_expression f init cons in
ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, ()) })
)
| Match_option { match_none ; match_some = (name , some, _) } -> (
let%bind (init, match_none) = fold_map_expression f init match_none in
let%bind (init, some) = fold_map_expression f init some in
ok @@ (init, Match_option { match_none ; match_some = (name , some, ()) })
)
| Match_tuple ((names , e), _) -> (
let%bind (init, e') = fold_map_expression f init e in
ok @@ (init, Match_tuple ((names , e'), []))
)
| Match_variant (lst, _) -> (
let aux init ((a , b) , e) =
let%bind (init,e') = fold_map_expression f init e in
ok (init, ((a , b) , e'))
in
let%bind (init,lst') = bind_fold_map_list aux init lst in
ok @@ (init, Match_variant (lst', ()))
)

25
src/passes/5-self_ast_sugar/self_ast_sugar.ml Normal file
View File

@ -0,0 +1,25 @@
open Trace
let all_expression_mapper = [
]
let all_type_expression_mapper = [
]
let all_exp = List.map (fun el -> Helpers.Expression el) all_expression_mapper
let all_ty = List.map (fun el -> Helpers.Type_expression el) all_type_expression_mapper
let all_program =
let all_p = List.map Helpers.map_program all_exp in
let all_p2 = List.map Helpers.map_program all_ty in
bind_chain (List.append all_p all_p2)
let all_expression =
let all_p = List.map Helpers.map_expression all_expression_mapper in
bind_chain all_p
let map_expression = Helpers.map_expression
let fold_expression = Helpers.fold_expression
let fold_map_expression = Helpers.fold_map_expression

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

@ -277,7 +277,7 @@ let rec uncompile_expression : O.expression -> I.expression result =
let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in
let%bind rhs = uncompile_expression rhs in
let%bind let_result = uncompile_expression let_result in
return @@ I.E_let_in {let_binder=(binder,ty_opt);inline;rhs;let_result}
return @@ I.E_let_in {let_binder=(binder,ty_opt);mut=false;inline;rhs;let_result}
| O.E_constructor {constructor;element} ->
let%bind element = uncompile_expression element in
return @@ I.E_constructor {constructor;element}

21
src/stages/1-ast_imperative/PP.ml
View File

@ -66,6 +66,27 @@ and expression_content ppf (ec : expression_content) =
fprintf ppf "%a;\n%a" expression expr1 expression expr2
| E_skip ->
fprintf ppf "skip"
| E_for {binder; start; final; increment; body} ->
fprintf ppf "for %a from %a to %a by %a do %a"
expression_variable binder
expression start
expression final
expression increment
expression body
| E_for_each {binder; collection; body; _} ->
fprintf ppf "for each %a in %a do %a"
option_map binder
expression collection
expression body
| E_while {condition; body} ->
fprintf ppf "while %a do %a"
expression condition
expression body
and option_map ppf (k,v_opt) =
match v_opt with
| None -> fprintf ppf "%a" expression_variable k
| Some v -> fprintf ppf "%a -> %a" expression_variable k expression_variable v
and option_type_name ppf
((n, ty_opt) : expression_variable * type_expression option) =

5
src/stages/1-ast_imperative/combinators.ml
View File

@ -130,6 +130,11 @@ let e_binop ?loc name a b = make_expr ?loc @@ E_constant {cons_name = name ; ar
let e_constant ?loc name lst = make_expr ?loc @@ E_constant {cons_name=name ; arguments = lst}
let e_look_up ?loc x y = make_expr ?loc @@ E_look_up (x , y)
let e_sequence ?loc expr1 expr2 = make_expr ?loc @@ E_sequence {expr1; expr2}
let e_while ?loc condition body = make_expr ?loc @@ E_while {condition; body}
let e_for ?loc binder start final increment body = make_expr ?loc @@ E_for {binder;start;final;increment;body}
let e_for_each ?loc binder collection collection_type body = make_expr ?loc @@ E_for_each {binder;collection;collection_type;body}
let e_cond ?loc expr match_true match_false = e_matching expr ?loc (Match_bool {match_true; match_false})
(*
let e_assign ?loc a b c = location_wrap ?loc @@ E_assign (Var.of_name a , b , c) (* TODO handlethat*)

3
src/stages/1-ast_imperative/combinators.mli
View File

@ -115,6 +115,9 @@ val e_assign_with_let : ?loc:Location.t -> string -> string list -> expression -
(*
val get_e_accessor : expression' -> ( expression * access_path ) result
*)
val e_while : ?loc:Location.t -> expression -> expression -> expression
val e_for : ?loc:Location.t -> expression_variable -> expression -> expression -> expression -> expression -> expression
val e_for_each : ?loc:Location.t -> expression_variable * expression_variable option -> expression -> collect_type -> expression -> expression
val assert_e_accessor : expression_content -> unit result

4
src/stages/1-ast_imperative/misc.ml
View File

@ -184,7 +184,9 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
| (E_application _, _) | (E_let_in _, _)
| (E_recursive _,_) | (E_record_accessor _, _)
| (E_look_up _, _) | (E_matching _, _)
| (E_sequence _, _) | (E_skip, _) -> simple_fail "comparing not a value"
| (E_sequence _, _) | (E_skip, _)
| (E_for _, _) | (E_for_each _, _)
| (E_while _, _) -> simple_fail "comparing not a value"
let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)

29
src/stages/1-ast_imperative/types.ml
View File

@ -54,6 +54,10 @@ and expression_content =
| E_list of expression list
| E_set of expression list
| E_look_up of (expression * expression)
(* Imperative *)
| E_for of for_
| E_for_each of for_each
| E_while of while_loop
and constant =
{ cons_name: constant' (* this is at the end because it is huge *)
@ -101,6 +105,31 @@ and sequence = {
expr2: expression ;
}
and for_ = {
binder : expression_variable;
start : expression;
final : expression;
increment : expression;
body : expression;
}
and for_each = {
binder : expression_variable * expression_variable option;
collection : expression;
collection_type : collect_type;
body : expression;
}
and collect_type =
| Map
| Set
| List
and while_loop = {
condition : expression;
body : expression;
}
and environment_element_definition =
| ED_binder
| ED_declaration of (expression * free_variables)

11
src/stages/2-ast_sugar/PP.ml
View File

@ -56,10 +56,15 @@ and expression_content ppf (ec : expression_content) =
| E_matching {matchee; cases; _} ->
fprintf ppf "match %a with %a" expression matchee (matching expression)
cases
| E_let_in { let_binder ; rhs ; let_result; inline } ->
fprintf ppf "let %a = %a%a in %a" option_type_name let_binder expression rhs option_inline inline expression let_result
| E_let_in { let_binder ; rhs ; let_result; inline; mut} ->
fprintf ppf "let %a%a = %a%a in %a"
option_type_name let_binder
option_mut mut
expression rhs
option_inline inline
expression let_result
| E_sequence {expr1;expr2} ->
fprintf ppf "%a;\n%a" expression expr1 expression expr2
fprintf ppf "{ %a; %a }" expression expr1 expression expr2
| E_ascription {anno_expr; type_annotation} ->
fprintf ppf "%a : %a" expression anno_expr type_expression type_annotation
| E_skip ->

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

@ -122,8 +122,8 @@ let e_accessor ?loc a b = make_expr ?loc @@ E_record_accessor {expr = a; label=
let e_accessor_list ?loc a b = List.fold_left (fun a b -> e_accessor ?loc a b) a b
let e_variable ?loc v = make_expr ?loc @@ E_variable v
let e_skip ?loc () = make_expr ?loc @@ E_skip
let e_let_in ?loc (binder, ascr) inline rhs let_result =
make_expr ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline }
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_annotation ?loc anno_expr ty = make_expr ?loc @@ E_ascription {anno_expr; type_annotation = ty}
let e_application ?loc a b = make_expr ?loc @@ E_application {lamb=a ; args=b}
let e_binop ?loc name a b = make_expr ?loc @@ E_constant {cons_name = name ; arguments = [a ; b]}

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

@ -86,7 +86,7 @@ val e_variable : ?loc:Location.t -> expression_variable -> expression
val e_skip : ?loc:Location.t -> unit -> expression
val e_sequence : ?loc:Location.t -> expression -> expression -> expression
val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> bool -> expression -> expression -> expression
val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression
val e_application : ?loc:Location.t -> expression -> expression -> expression
val e_binop : ?loc:Location.t -> constant' -> expression -> expression -> expression

12
src/stages/2-ast_sugar/types.ml
View File

@ -76,11 +76,13 @@ and recursive = {
lambda : lambda;
}
and let_in =
{ let_binder: expression_variable * type_expression option
; rhs: expression
; let_result: expression
; inline: bool }
and let_in = {
let_binder: expression_variable * type_expression option ;
rhs: expression ;
let_result: expression ;
inline: bool ;
mut: bool;
}
and constructor = {constructor: constructor'; element: expression}

2
src/test/contracts/loop.ligo
View File

@ -54,9 +54,9 @@ function for_collection_if_and_local_var (var nee : unit) : int is
block {
var acc : int := 0;
const theone : int = 1;
const thetwo : int = 2;
var myset : set (int) := set [1; 2; 3];
for x in set myset block {
const thetwo : int = 2;
if x = theone then acc := acc + x
else if x = thetwo then acc := acc + thetwo
else acc := acc + 10