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

@@ -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
@@ -325,7 +326,28 @@ and single_instr =
 | ProcCall    of fun_call
 | Fail        of fail_instr reg
 | Skip        of kwd_skip
-| Patch    of record_patch reg
+| 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
@@ -938,7 +967,8 @@ and print_single_instr = function
 | 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
+| 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 "(";

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
@@ -309,7 +310,28 @@ and single_instr =
 | ProcCall    of fun_call
 | Fail        of fail_instr reg
 | Skip        of kwd_skip
-| Patch    of record_patch reg
+| 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 =

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"     *)

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     _

ParToken.mly

@@ -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"     *)

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):
@@ -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
+  Begin series(instruction) {
-    instruction after_instr
+   let first, (others, terminator, close) = $2 in
-  {
-   let instrs, terminator, close = $3 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,6 +426,9 @@ 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 }
@@ -427,7 +442,43 @@ single_instr:
 | proc_call    {    ProcCall $1 }
 | fail_instr   {        Fail $1 }
 | Skip         {        Skip $1 }
-| record_patch {    Patch $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,40 +790,17 @@ record_expr:
 | record_projection { RecordProj $1 }
 
 record_injection:
-  Record
+  Record series(field_assignment) {
-    field_assignment after_field
+    let first, (others, terminator, close) = $2 in
-  {
-   let fields, terminator, close = $3 in
     let region = cover $1 close
     and value = {
       opening = $1;
-     fields  = $2, fields;
+      fields  = first, others;
       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)
-  }
-
 field_assignment:
   field_name EQUAL expr {
     let region = cover $1.region (expr_to_region $3)