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

Merge branch 'rinderknecht-dev' into 'dev'

Browse Source 
Removed sub-blocks from PascaLIGO.

See merge request ligolang/ligo!142
This commit is contained in:
John David Pressman 2019-10-17 17:28:05 +00:00
commit 60600a90fd
5 changed files with 80 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/passes/1-parser/pascaligo/AST.ml
View File

@ -284,10 +284,6 @@ and var_decl = {
}
and instruction =
Single of single_instr
| Block of block reg
and single_instr =
Cond of conditional reg
| CaseInstr of instruction case reg
| Assign of assignment reg
@ -355,7 +351,11 @@ and conditional = {
and if_clause =
ClauseInstr of instruction
| ClauseBlock of (statements * semi option) braces reg
| ClauseBlock of clause_block
and clause_block =
LongBlock of block reg
| ShortBlock of (statements * semi option) braces reg
and set_membership = {
set : expr;
@ -661,7 +661,7 @@ and comp_expr_to_region = function
| Neq {region; _} -> region
and arith_expr_to_region = function
| Add {region; _}
Add {region; _}
| Sub {region; _}
| Mult {region; _}
| Div {region; _}
@ -675,7 +675,7 @@ and string_expr_to_region = function
Cat {region; _}
| String {region; _} -> region
and annot_expr_to_region ({region; _}) = region
and annot_expr_to_region {region; _} = region
and list_expr_to_region = function
Cons {region; _}
@ -694,24 +694,27 @@ let path_to_region = function
| Path {region; _} -> region
let instr_to_region = function
Single Cond {region; _}
| Single CaseInstr {region; _}
| Single Assign {region; _}
| Single Loop While {region; _}
| Single Loop For ForInt {region; _}
| Single Loop For ForCollect {region; _}
| Single ProcCall {region; _}
| Single Skip region
| Single RecordPatch {region; _}
| Single MapPatch {region; _}
| Single SetPatch {region; _}
| Single MapRemove {region; _}
| Single SetRemove {region; _}
| Block {region; _} -> region
Cond {region; _}
| CaseInstr {region; _}
| Assign {region; _}
| Loop While {region; _}
| Loop For ForInt {region; _}
| Loop For ForCollect {region; _}
| ProcCall {region; _}
| Skip region
| RecordPatch {region; _}
| MapPatch {region; _}
| SetPatch {region; _}
| MapRemove {region; _}
| SetRemove {region; _} -> region
let clause_block_to_region = function
LongBlock {region; _}
| ShortBlock {region; _} -> region
let if_clause_to_region = function
ClauseInstr instr -> instr_to_region instr
| ClauseBlock {region; _} -> region
| ClauseBlock clause_block -> clause_block_to_region clause_block
let pattern_to_region = function
PCons {region; _}

10
src/passes/1-parser/pascaligo/AST.mli
View File

@ -275,10 +275,6 @@ and var_decl = {
}
and instruction =
Single of single_instr
| Block of block reg
and single_instr =
Cond of conditional reg
| CaseInstr of instruction case reg
| Assign of assignment reg
@ -346,7 +342,11 @@ and conditional = {
and if_clause =
ClauseInstr of instruction
| ClauseBlock of (statements * semi option) braces reg
| ClauseBlock of clause_block
and clause_block =
LongBlock of block reg
| ShortBlock of (statements * semi option) braces reg
and set_membership = {
set : expr;

15
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -377,10 +377,6 @@ var_decl:
| open_var_decl { $1 }
instruction:
single_instr { Single $1 }
| block { Block $1 }
single_instr:
conditional { Cond $1 }
| case_instr { CaseInstr $1 }
| assignment { Assign $1 }
@ -512,16 +508,19 @@ conditional:
in {region; value} }
if_clause:
instruction {
ClauseInstr $1
}
instruction { ClauseInstr $1 }
| clause_block { ClauseBlock $1 }
clause_block:
block {
LongBlock $1 }
| LBRACE sep_or_term_list(statement,SEMI) RBRACE {
let region = cover $1 $3 in
let value = {
lbrace = $1;
inside = $2;
rbrace = $3} in
ClauseBlock {value; region} }
ShortBlock {value; region} }
case_instr:
case(instruction) { $1 instr_to_region }

31
src/passes/1-parser/pascaligo/ParserLog.ml
View File

@ -244,10 +244,6 @@ and print_statement buffer = function
| Data data -> print_data_decl buffer data
and print_instruction buffer = function
Single instr -> print_single_instr buffer instr
| Block block -> print_block buffer block
and print_single_instr buffer = function
Cond {value; _} -> print_conditional buffer value
| CaseInstr {value; _} -> print_case_instr buffer value
| Assign assign -> print_assignment buffer assign
@ -273,7 +269,12 @@ and print_conditional buffer node =
and print_if_clause buffer = function
ClauseInstr instr -> print_instruction buffer instr
| ClauseBlock {value; _} ->
| ClauseBlock block -> print_clause_block buffer block
and print_clause_block buffer = function
LongBlock block ->
print_block buffer block
| ShortBlock {value; _} ->
let {lbrace; inside; rbrace} = value in
let statements, terminator = inside in
print_token buffer lbrace "{";
@ -885,14 +886,6 @@ and pp_statement buffer ~pad:(_,pc as pad) = function
pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data_decl
and pp_instruction buffer ~pad:(_,pc as pad) = function
Single single_instr ->
pp_node buffer ~pad "Single";
pp_single_instr buffer ~pad:(mk_pad 1 0 pc) single_instr
| Block {value; _} ->
pp_node buffer ~pad "Block";
pp_statements buffer ~pad value.statements
and pp_single_instr buffer ~pad:(_,pc as pad) = function
Cond {value; _} ->
pp_node buffer ~pad "Cond";
pp_conditional buffer ~pad value
@ -945,9 +938,17 @@ and pp_if_clause buffer ~pad:(_,pc as pad) = function
ClauseInstr instr ->
pp_node buffer ~pad "ClauseInstr";
pp_instruction buffer ~pad:(mk_pad 1 0 pc) instr
| ClauseBlock {value; _} ->
| ClauseBlock block ->
pp_node buffer ~pad "ClauseBlock";
let statements, _ = value.inside in
pp_clause_block buffer ~pad:(mk_pad 1 0 pc) block
and pp_clause_block buffer ~pad = function
LongBlock {value; _} ->
pp_node buffer ~pad "LongBlock";
pp_statements buffer ~pad value.statements
| ShortBlock {value; _} ->
pp_node buffer ~pad "ShortBlock";
let statements = fst value.inside in
pp_statements buffer ~pad statements
and pp_case :

53
src/passes/2-simplify/pascaligo.ml
View File

@ -147,16 +147,6 @@ module Errors = struct
] in
error ~data title message
let unsupported_sub_blocks b =
let title () = "block instructions" in
let message () =
Format.asprintf "Sub-blocks are not supported yet" in
let data = [
("block_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ b.Region.region)
] in
error ~data title message
(* Logging *)
let simplifying_instruction t =
@ -555,11 +545,8 @@ and simpl_fun_declaration :
fun ~loc x ->
let open! Raw in
let {name;param;ret_type;local_decls;block;return} : fun_decl = x in
(match npseq_to_list param.value.inside with
| [] ->
fail @@
corner_case ~loc:__LOC__ "parameter-less function should not exist"
| [a] -> (
(match param.value.inside with
a, [] -> (
let%bind input = simpl_param a in
let name = name.value in
let (binder , input_type) = input in
@ -580,6 +567,7 @@ and simpl_fun_declaration :
ok ((name , type_annotation) , expression)
)
| lst -> (
let lst = npseq_to_list lst in
let arguments_name = "arguments" in
let%bind params = bind_map_list simpl_param lst in
let (binder , input_type) =
@ -640,7 +628,7 @@ and simpl_statement : Raw.statement -> (_ -> expression result) result =
| Instr i -> simpl_instruction i
| Data d -> simpl_data_declaration d
and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) result =
and simpl_single_instruction : Raw.instruction -> (_ -> expression result) result =
fun t ->
match t with
| ProcCall x -> (
@ -672,11 +660,23 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
let (c , loc) = r_split c in
let%bind expr = simpl_expression c.test in
let%bind match_true = match c.ifso with
| ClauseInstr i -> simpl_instruction_block i
| ClauseBlock b -> simpl_statements @@ fst b.value.inside in
ClauseInstr i ->
simpl_single_instruction i
| ClauseBlock b ->
match b with
LongBlock {value; _} ->
simpl_block value
| ShortBlock {value; _} ->
simpl_statements @@ fst value.inside in
let%bind match_false = match c.ifnot with
| ClauseInstr i -> simpl_instruction_block i
| ClauseBlock b -> simpl_statements @@ fst b.value.inside in
ClauseInstr i ->
simpl_single_instruction i
| ClauseBlock b ->
match b with
LongBlock {value; _} ->
simpl_block value
| ShortBlock {value; _} ->
simpl_statements @@ fst value.inside in
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})
@ -708,7 +708,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
let%bind expr = simpl_expression c.expr in
let%bind cases =
let aux (x : Raw.instruction Raw.case_clause Raw.reg) =
let%bind i = simpl_instruction_block x.value.rhs in
let%bind i = simpl_instruction x.value.rhs in
let%bind i = i None in
ok (x.value.pattern, i) in
bind_list
@ -914,18 +914,9 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
bind_map_list aux lst in
ok @@ Match_variant constrs
and simpl_instruction_block : Raw.instruction -> (_ -> expression result) result =
fun t ->
match t with
| Single s -> simpl_single_instruction s
| Block b -> simpl_block b.value
and simpl_instruction : Raw.instruction -> (_ -> expression result) result =
fun t ->
trace (simplifying_instruction t) @@
match t with
| Single s -> simpl_single_instruction s
| Block b -> fail @@ unsupported_sub_blocks b
trace (simplifying_instruction t) @@ simpl_single_instruction t
and simpl_statements : Raw.statements -> (_ -> expression result) result =
fun ss ->