Maps can be defined by extension in declarations.

"map" has become a keyword to introduce definition of maps by extension in declarations ("map" ... "end"). This entails that a grammar rule had to be created to handle the type expressions "map (..., ...)". Concordantly, I added map patches, modelled after record patches.

I created a node in the AST for map expressions (currently only
map look-ups).

I refactored the parser with parametric rules.
This commit is contained in:
Christian Rinderknecht 2019-03-20 09:11:19 +01:00
parent 4c9a743411
commit 8eaf1a90ec
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
6 changed files with 243 additions and 130 deletions

135
AST.ml
View File

@ -52,6 +52,7 @@ type kwd_function = Region.t
type kwd_if = Region.t
type kwd_in = Region.t
type kwd_is = Region.t
type kwd_map = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
type kwd_of = Region.t
@ -318,14 +319,35 @@ and instruction =
| Block of block reg
and single_instr =
Cond of conditional reg
| Case of case_instr reg
| Assign of assignment reg
| Loop of loop
| ProcCall of fun_call
| Fail of fail_instr reg
| Skip of kwd_skip
| Patch of record_patch reg
Cond of conditional reg
| Case of case_instr reg
| Assign of assignment reg
| Loop of loop
| ProcCall of fun_call
| Fail of fail_instr reg
| Skip of kwd_skip
| RecordPatch of record_patch reg
| MapPatch of map_patch reg
and map_patch = {
kwd_patch : kwd_patch;
map_name : variable;
kwd_with : kwd_with;
delta : map_injection reg
}
and map_injection = {
opening : kwd_map;
bindings : (binding reg, semi) nsepseq;
terminator : semi option;
close : kwd_end
}
and binding = {
source : expr;
arrow : arrow;
image : expr
}
and record_patch = {
kwd_patch : kwd_patch;
@ -414,14 +436,26 @@ and expr =
| SetExpr of set_expr
| ConstrExpr of constr_expr
| RecordExpr of record_expr
| MapExpr of map_expr
| Var of Lexer.lexeme reg
| FunCall of fun_call
| Bytes of (Lexer.lexeme * MBytes.t) reg
| Unit of c_Unit
| Tuple of tuple
| MapLookUp of map_lookup reg
| ParExpr of expr par reg
and map_expr =
MapLookUp of map_lookup reg
and map_lookup = {
map_path : map_path;
index : expr brackets reg
}
and map_path =
Map of map_name
| MapPath of record_projection reg
and logic_expr =
BoolExpr of bool_expr
| CompExpr of comp_expr
@ -534,15 +568,6 @@ and fun_call = (fun_name * arguments) reg
and arguments = tuple
and map_lookup = {
map_path : map_path;
index : expr brackets reg
}
and map_path =
Map of map_name
| MapPath of record_projection reg
(* Patterns *)
and pattern =
@ -584,14 +609,17 @@ let rec expr_to_region = function
| SetExpr e -> set_expr_to_region e
| ConstrExpr e -> constr_expr_to_region e
| RecordExpr e -> record_expr_to_region e
| MapExpr e -> map_expr_to_region e
| Var {region; _}
| FunCall {region; _}
| Bytes {region; _}
| Unit region
| Tuple {region; _}
| MapLookUp {region; _}
| ParExpr {region; _} -> region
and map_expr_to_region = function
MapLookUp {region; _} -> region
and logic_expr_to_region = function
BoolExpr e -> bool_expr_to_region e
| CompExpr e -> comp_expr_to_region e
@ -652,7 +680,8 @@ let instr_to_region = function
| Single ProcCall {region; _}
| Single Skip region
| Single Fail {region; _}
| Single Patch {region; _}
| Single RecordPatch {region; _}
| Single MapPatch {region; _}
| Block {region; _} -> region
let pattern_to_region = function
@ -931,14 +960,15 @@ and print_instruction = function
| Block block -> print_block block
and print_single_instr = function
Cond {value; _} -> print_conditional value
| Case {value; _} -> print_case_instr value
| Assign assign -> print_assignment assign
| Loop loop -> print_loop loop
| ProcCall fun_call -> print_fun_call fun_call
| Fail {value; _} -> print_fail value
| Skip kwd_skip -> print_token kwd_skip "skip"
| Patch {value; _} -> print_patch value
Cond {value; _} -> print_conditional value
| Case {value; _} -> print_case_instr value
| Assign assign -> print_assignment assign
| Loop loop -> print_loop loop
| ProcCall fun_call -> print_fun_call fun_call
| Fail {value; _} -> print_fail value
| Skip kwd_skip -> print_token kwd_skip "skip"
| RecordPatch {value; _} -> print_record_patch value
| MapPatch {value; _} -> print_map_patch value
and print_fail {kwd_fail; fail_expr} =
print_token kwd_fail "fail";
@ -1041,14 +1071,27 @@ and print_expr = function
| SetExpr e -> print_set_expr e
| ConstrExpr e -> print_constr_expr e
| RecordExpr e -> print_record_expr e
| MapExpr e -> print_map_expr e
| Var var -> print_var var
| FunCall e -> print_fun_call e
| Bytes b -> print_bytes b
| Unit region -> print_token region "Unit"
| Tuple e -> print_tuple e
| MapLookUp e -> print_map_lookup e
| ParExpr e -> print_par_expr e
and print_map_expr = function
MapLookUp {value; _} ->
let {map_path; index} = value in
let {lbracket; inside; rbracket} = index.value in
print_map_path map_path;
print_token lbracket "[";
print_expr inside;
print_token rbracket "]"
and print_map_path = function
Map map_name -> print_var map_name
| MapPath path -> print_record_projection path
and print_logic_expr = function
BoolExpr e -> print_bool_expr e
| CompExpr e -> print_comp_expr e
@ -1138,13 +1181,33 @@ and print_record_projection {value; _} =
and print_field_path sequence =
print_nsepseq "." print_var sequence
and print_patch (node: record_patch) =
and print_record_patch node =
let {kwd_patch; record_name; kwd_with; delta} = node in
print_token kwd_patch "patch";
print_var record_name;
print_token kwd_with "with";
print_record_injection delta
and print_map_patch node =
let {kwd_patch; map_name; kwd_with; delta} = node in
print_token kwd_patch "patch";
print_var map_name;
print_token kwd_with "with";
print_map_injection delta
and print_map_injection {value; _} =
let {opening; bindings; terminator; close} = value in
print_token opening "record";
print_nsepseq ";" print_binding bindings;
print_terminator terminator;
print_token close "end"
and print_binding {value; _} =
let {source; arrow; image} = value in
print_expr source;
print_token arrow "->";
print_expr image
and print_tuple {value; _} =
let {lpar; inside; rpar} = value in
print_token lpar "(";
@ -1207,18 +1270,6 @@ and print_some_app {value; _} =
print_token c_Some "Some";
print_tuple arguments
and print_map_lookup {value; _} =
let {map_path; index} = value in
let {lbracket; inside; rbracket} = index.value in
print_map_path map_path;
print_token lbracket "[";
print_expr inside;
print_token rbracket "]"
and print_map_path = function
Map map_name -> print_var map_name
| MapPath path -> print_record_projection path
and print_par_expr {value; _} =
let {lpar; inside; rpar} = value in
print_token lpar "(";

61
AST.mli
View File

@ -36,6 +36,7 @@ type kwd_function = Region.t
type kwd_if = Region.t
type kwd_in = Region.t
type kwd_is = Region.t
type kwd_map = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
type kwd_of = Region.t
@ -302,14 +303,35 @@ and instruction =
| Block of block reg
and single_instr =
Cond of conditional reg
| Case of case_instr reg
| Assign of assignment reg
| Loop of loop
| ProcCall of fun_call
| Fail of fail_instr reg
| Skip of kwd_skip
| Patch of record_patch reg
Cond of conditional reg
| Case of case_instr reg
| Assign of assignment reg
| Loop of loop
| ProcCall of fun_call
| Fail of fail_instr reg
| Skip of kwd_skip
| RecordPatch of record_patch reg
| MapPatch of map_patch reg
and map_patch = {
kwd_patch : kwd_patch;
map_name : variable;
kwd_with : kwd_with;
delta : map_injection reg
}
and map_injection = {
opening : kwd_map;
bindings : (binding reg, semi) nsepseq;
terminator : semi option;
close : kwd_end
}
and binding = {
source : expr;
arrow : arrow;
image : expr
}
and record_patch = {
kwd_patch : kwd_patch;
@ -398,14 +420,26 @@ and expr =
| SetExpr of set_expr
| ConstrExpr of constr_expr
| RecordExpr of record_expr
| MapExpr of map_expr
| Var of Lexer.lexeme reg
| FunCall of fun_call
| Bytes of (Lexer.lexeme * MBytes.t) reg
| Unit of c_Unit
| Tuple of tuple
| MapLookUp of map_lookup reg
| ParExpr of expr par reg
and map_expr =
MapLookUp of map_lookup reg
and map_lookup = {
map_path : map_path;
index : expr brackets reg
}
and map_path =
Map of map_name
| MapPath of record_projection reg
and logic_expr =
BoolExpr of bool_expr
| CompExpr of comp_expr
@ -518,15 +552,6 @@ and fun_call = (fun_name * arguments) reg
and arguments = tuple
and map_lookup = {
map_path : map_path;
index : expr brackets reg
}
and map_path =
Map of map_name
| MapPath of record_projection reg
(* Patterns *)
and pattern =

View File

@ -84,6 +84,7 @@ type t =
| End of Region.t (* "end" *)
| Then of Region.t (* "then" *)
| Else of Region.t (* "else" *)
| Map of Region.t (* "map" *)
| Patch of Region.t (* "patch" *)
| Procedure of Region.t (* "procedure" *)
| Record of Region.t (* "record" *)

View File

@ -83,6 +83,7 @@ type t =
| End of Region.t
| Then of Region.t
| Else of Region.t
| Map of Region.t
| Patch of Region.t
| Procedure of Region.t
| Record of Region.t
@ -202,6 +203,7 @@ let proj_token = function
| End region -> region, "End"
| Then region -> region, "Then"
| Else region -> region, "Else"
| Map region -> region, "Map"
| Patch region -> region, "Patch"
| Procedure region -> region, "Procedure"
| Record region -> region, "Record"
@ -286,6 +288,7 @@ let to_lexeme = function
| End _ -> "end"
| Then _ -> "then"
| Else _ -> "else"
| Map _ -> "map"
| Patch _ -> "patch"
| Procedure _ -> "procedure"
| Record _ -> "record"
@ -338,6 +341,7 @@ let keywords = [
(fun reg -> End reg);
(fun reg -> Then reg);
(fun reg -> Else reg);
(fun reg -> Map reg);
(fun reg -> Patch reg);
(fun reg -> Procedure reg);
(fun reg -> Record reg);
@ -562,6 +566,7 @@ let is_kwd = function
| End _
| Then _
| Else _
| Map _
| Patch _
| Procedure _
| Record _

View File

@ -61,6 +61,7 @@
%token <Region.t> End (* "end" *)
%token <Region.t> Then (* "then" *)
%token <Region.t> Else (* "else" *)
%token <Region.t> Map (* "map" *)
%token <Region.t> Patch (* "patch" *)
%token <Region.t> Procedure (* "procedure" *)
%token <Region.t> Record (* "record" *)

View File

@ -21,6 +21,34 @@ open AST
(* RULES *)
(* The rule [series(Item)] parses a list of [Item] separated by
semi-colons and optionally terminated by a semi-colon, then the
keyword [End]. *)
series(Item):
Item after_item(Item) { $1,$2 }
after_item(Item):
SEMI item_or_end(Item) {
match $2 with
`Some (item, items, term, close) ->
($1, item)::items, term, close
| `End close ->
[], Some $1, close
}
| End {
[], None, $1
}
item_or_end(Item):
End {
`End $1
}
| series(Item) {
let item, (items, term, close) = $1
in `Some (item, items, term, close)
}
(* Compound constructs *)
par(X):
@ -130,8 +158,8 @@ type_decl:
in {region; value}}
type_expr:
cartesian { Prod $1 }
| sum_type { Sum $1 }
cartesian { Prod $1 }
| sum_type { Sum $1 }
| record_type { Record $1 }
cartesian:
@ -148,6 +176,11 @@ core_type:
let region = cover $1.region $2.region
in TypeApp {region; value = $1,$2}
}
| Map type_tuple {
let region = cover $1 $2.region in
let value = {value="map"; region=$1}
in TypeApp {region; value = value, $2}
}
| par(type_expr) {
ParType $1
}
@ -310,40 +343,17 @@ entry_param_decl:
}
block:
Begin
instruction after_instr
{
let instrs, terminator, close = $3 in
Begin series(instruction) {
let first, (others, terminator, close) = $2 in
let region = cover $1 close
and value = {
opening = $1;
instr = $2, instrs;
instr = first, others;
terminator;
close}
in {region; value}
}
after_instr:
SEMI instr_or_end {
match $2 with
`Some (instr, instrs, term, close) ->
($1, instr)::instrs, term, close
| `End close ->
[], Some $1, close
}
| End {
[], None, $1
}
instr_or_end:
End {
`End $1
}
| instruction after_instr {
let instrs, term, close = $2 in
`Some ($1, instrs, term, close)
}
local_decl:
lambda_decl { LocalLam $1 }
| const_decl { LocalConst $1 }
@ -397,6 +407,8 @@ var_decl:
opt_type = $4};
rpar = Region.ghost}
in ConstrExpr (NoneExpr {region; value}) in
(* | `EMap inj ->*)
let value = {
kwd_var = $1;
name = $2;
@ -414,20 +426,59 @@ extended_expr:
| LBRACKET RBRACKET { {region = cover $1 $2;
value = `EList ($1,$2)} }
| C_None { {region = $1; value = `ENone $1} }
(*
| map_injection { {region = $1.region; value = `EMap $1} }
*)
instruction:
single_instr { Single $1 }
| block { Block $1 }
single_instr:
conditional { Cond $1 }
| case_instr { Case $1 }
| assignment { Assign $1 }
| loop { Loop $1 }
| proc_call { ProcCall $1 }
| fail_instr { Fail $1 }
| Skip { Skip $1 }
| record_patch { Patch $1 }
conditional { Cond $1 }
| case_instr { Case $1 }
| assignment { Assign $1 }
| loop { Loop $1 }
| proc_call { ProcCall $1 }
| fail_instr { Fail $1 }
| Skip { Skip $1 }
| record_patch { RecordPatch $1 }
| map_patch { MapPatch $1 }
map_patch:
Map map_name With map_injection {
let region = cover $1 $4.region in
let value = {
kwd_patch = $1;
map_name = $2;
kwd_with = $3;
delta = $4}
in {region; value}
}
map_injection:
Map series(binding) {
let first, (others, terminator, close) = $2 in
let region = cover $1 close
and value = {
opening = $1;
bindings = first, others;
terminator;
close}
in {region; value}
}
binding:
expr ARROW expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {
source = $1;
arrow = $2;
image = $3}
in {region; value}
}
record_patch:
Patch record_name With record_injection {
@ -440,7 +491,6 @@ record_patch:
in {region; value}
}
fail_instr:
Fail expr {
let region = cover $1 (expr_to_region $2)
@ -705,7 +755,7 @@ core_expr:
| empty_set { SetExpr (EmptySet $1) }
| none_expr { ConstrExpr (NoneExpr $1) }
| fun_call { FunCall $1 }
| map_selection { MapLookUp $1 }
| map_expr { MapExpr $1 }
| record_expr { RecordExpr $1 }
| Constr arguments {
let region = cover $1.region $2.region in
@ -716,6 +766,9 @@ core_expr:
ConstrExpr (SomeApp {region; value = $1,$2})
}
map_expr:
map_selection { MapLookUp $1 }
map_selection:
map_name brackets(expr) {
let region = cover $1.region $2.region in
@ -737,38 +790,15 @@ record_expr:
| record_projection { RecordProj $1 }
record_injection:
Record
field_assignment after_field
{
let fields, terminator, close = $3 in
let region = cover $1 close
and value = {
opening = $1;
fields = $2, fields;
terminator;
close}
in {region; value}
}
after_field:
SEMI field_or_end {
match $2 with
`Some (field, fields, term, close) ->
($1, field)::fields, term, close
| `End close ->
[], Some $1, close
}
| End {
[], None, $1
}
field_or_end:
End {
`End $1
}
| field_assignment after_field {
let fields, term, close = $2 in
`Some ($1, fields, term, close)
Record series(field_assignment) {
let first, (others, terminator, close) = $2 in
let region = cover $1 close
and value = {
opening = $1;
fields = first, others;
terminator;
close}
in {region; value}
}
field_assignment: