From 8eaf1a90ec155084efa7ca2cf660dd5fce3724be Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Wed, 20 Mar 2019 09:11:19 +0100 Subject: [PATCH] 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. --- AST.ml | 135 +++++++++++++++++++++++++++------------- AST.mli | 61 ++++++++++++------ LexToken.mli | 1 + LexToken.mll | 5 ++ ParToken.mly | 1 + Parser.mly | 170 ++++++++++++++++++++++++++++++--------------------- 6 files changed, 243 insertions(+), 130 deletions(-) diff --git a/AST.ml b/AST.ml index 14d51fe7b..443f127d4 100644 --- a/AST.ml +++ b/AST.ml @@ -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 "("; diff --git a/AST.mli b/AST.mli index b9c483c13..81ac55d66 100644 --- a/AST.mli +++ b/AST.mli @@ -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 = diff --git a/LexToken.mli b/LexToken.mli index 7dcfe1337..1e31dcc97 100644 --- a/LexToken.mli +++ b/LexToken.mli @@ -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" *) diff --git a/LexToken.mll b/LexToken.mll index 3d7c9beee..be5c9bce0 100644 --- a/LexToken.mll +++ b/LexToken.mll @@ -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 _ diff --git a/ParToken.mly b/ParToken.mly index c4b1769e8..acba7ff97 100644 --- a/ParToken.mly +++ b/ParToken.mly @@ -61,6 +61,7 @@ %token End (* "end" *) %token Then (* "then" *) %token Else (* "else" *) +%token Map (* "map" *) %token Patch (* "patch" *) %token Procedure (* "procedure" *) %token Record (* "record" *) diff --git a/Parser.mly b/Parser.mly index fd3d6cc05..806bd05bd 100644 --- a/Parser.mly +++ b/Parser.mly @@ -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: