Add missing regions

This commit is contained in:
Georges Dupéron 2019-03-14 19:02:41 +01:00
parent 76d4e1bb87
commit 90e894f9f4

40
AST2.ml
View File

@ -87,18 +87,19 @@ module O = struct
| CNone of type_expr | CNone of type_expr
and instr = and instr =
Assignment of { name: var_name; value: expr } Assignment of { name: var_name; value: expr; orig: asttodo }
| While of { condition: expr; body: instr list } | While of { condition: expr; body: instr list; orig: asttodo }
| ForCollection of { list: expr; key: var_name; value: var_name option; body: instr list } | ForCollection of { list: expr; key: var_name; value: var_name option; body: instr list; orig: asttodo }
| If of { condition: expr; ifso: instr list; ifnot: instr list } | If of { condition: expr; ifso: instr list; ifnot: instr list; orig: asttodo }
| Match of { expr: expr; cases: (pattern * instr list) list } | Match of { expr: expr; cases: (pattern * instr list) list; orig: asttodo }
| ProcedureCall of expr (* expr returns unit, drop the result. *) | ProcedureCall of { expr: expr; orig: asttodo } (* expr returns unit, drop the result. Similar to OCaml's ";". *)
| Fail of { expr: expr } | Fail of { expr: expr; orig: asttodo }
type ast = { type ast = {
types : type_decl list; types : type_decl list;
storage_decl : typed_var; storage_decl : typed_var;
declarations : decl list; declarations : decl list;
orig : I.t
} }
end end
@ -404,20 +405,20 @@ and s_instruction : I.instruction -> O.instr list = function
and s_conditional I.{kwd_if;test;kwd_then;ifso;kwd_else;ifnot} : O.instr = and s_conditional I.{kwd_if;test;kwd_then;ifso;kwd_else;ifnot} : O.instr =
let () = ignore (kwd_if,kwd_then,kwd_else) in let () = ignore (kwd_if,kwd_then,kwd_else) in
If { condition = s_expr test; ifso = s_instruction ifso; ifnot = s_instruction ifnot } If { condition = s_expr test; ifso = s_instruction ifso; ifnot = s_instruction ifnot; orig = `TODO }
and s_match_instr I.{kwd_match;expr;kwd_with;lead_vbar;cases;kwd_end} : O.instr = and s_match_instr I.{kwd_match;expr;kwd_with;lead_vbar;cases;kwd_end} : O.instr =
let {value=cases;region} = cases in let {value=cases;region} = cases in
let () = ignore (kwd_match,kwd_with,lead_vbar,kwd_end,region) in let () = ignore (kwd_match,kwd_with,lead_vbar,kwd_end,region) in
Match { expr = s_expr expr; cases = map s_case (s_nsepseq cases) } Match { expr = s_expr expr; cases = map s_case (s_nsepseq cases); orig = `TODO }
and s_ass_instr {value=(variable,ass,expr); region} : O.instr = and s_ass_instr {value=(variable,ass,expr); region} : O.instr =
let () = ignore (ass,region) in let () = ignore (ass,region) in
Assignment { name = s_name variable; value = s_expr expr } Assignment { name = s_name variable; value = s_expr expr; orig = `TODO }
and s_while_loop {value=(kwd_while, expr, block); region} : O.instr list = and s_while_loop {value=(kwd_while, expr, block); region} : O.instr list =
let () = ignore (kwd_while,region) in let () = ignore (kwd_while,region) in
[While {condition = s_expr expr; body = s_block block}] [While {condition = s_expr expr; body = s_block block; orig = `TODO}]
and s_for_loop : I.for_loop -> O.instr list = function and s_for_loop : I.for_loop -> O.instr list = function
ForInt for_int -> s_for_int for_int ForInt for_int -> s_for_int for_int
@ -431,15 +432,17 @@ and s_for_int ({value={kwd_for;ass;down;kwd_to;bound;step;block}; region} : I.fo
| None -> O.Lt, O.Add in | None -> O.Lt, O.Add in
let step = s_step step let step = s_step step
in [ in [
Assignment { name; value = s_expr expr }; Assignment { name; value = s_expr expr; orig = `TODO };
(* TODO: lift the declaration of the variable, to avoid creating a nested scope here. *) (* TODO: lift the declaration of the variable, to avoid creating a nested scope here. *)
While { While {
condition = App { operator = condition; condition = App { operator = condition;
arguments = [Var name; s_expr bound] }; arguments = [Var name; s_expr bound]};
body = append (s_block block) body = append (s_block block)
[O.Assignment { name; [O.Assignment { name;
value = App { operator; value = App { operator;
arguments = [Var name; step]}}] arguments = [Var name; step]};
orig = `TODO }];
orig = `TODO
} }
] ]
@ -450,7 +453,8 @@ and s_for_collect ({value={kwd_for;var;bind_to;kwd_in;expr;block}; _} : I.for_co
list = s_expr expr; list = s_expr expr;
key = s_name var; key = s_name var;
value = s_bind_to bind_to; value = s_bind_to bind_to;
body = s_block block body = s_block block;
orig = `TODO
} }
] ]
@ -490,7 +494,7 @@ and s_arguments {value=(lpar, sequence, rpar); region} : O.expr list =
and s_fail ((kwd_fail, expr) : (I.kwd_fail * I.expr)) : O.instr = and s_fail ((kwd_fail, expr) : (I.kwd_fail * I.expr)) : O.instr =
let () = ignore (kwd_fail) in let () = ignore (kwd_fail) in
Fail { expr = s_expr expr } Fail { expr = s_expr expr; orig = `TODO }
@ -500,7 +504,7 @@ and s_single_instr : I.single_instr -> O.instr list = function
| Match {value; _} -> [s_match_instr value] | Match {value; _} -> [s_match_instr value]
| Ass instr -> [s_ass_instr instr] | Ass instr -> [s_ass_instr instr]
| Loop loop -> s_loop loop | Loop loop -> s_loop loop
| ProcCall fun_call -> [ProcedureCall (s_fun_call fun_call)] | ProcCall fun_call -> [ProcedureCall { expr = s_fun_call fun_call; orig = `TODO }]
| Null kwd_null -> let () = ignore (kwd_null) in | Null kwd_null -> let () = ignore (kwd_null) in
[] []
| Fail {value; _} -> [s_fail value] | Fail {value; _} -> [s_fail value]
@ -609,7 +613,7 @@ let s_ast (ast : I.ast) : O.ast =
let () = match operations_decl with let () = match operations_decl with
Some _ -> failwith "Operations declaration is not allowed anymore TODO" Some _ -> failwith "Operations declaration is not allowed anymore TODO"
| None -> () | None -> ()
in {types; storage_decl; declarations} in {types; storage_decl; declarations; orig = ast}