From c0e6843240f6a9918516194a96418b3bd84846ab Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 14 Mar 2019 09:59:26 +0100 Subject: [PATCH] I added record creation (injection), field selection (projection) and functional update (copy). The only creative piece of concrete syntax is that of the expression for functional updates: copy foo with record field = value end where "copy", "with", "record" and "end" are keywords. --- AST.ml | 85 ++++++++++++++++++++++-- AST.mli | 37 ++++++++++- LexToken.mli | 1 + LexToken.mll | 7 +- ParToken.mly | 1 + Parser.mly | 183 ++++++++++++++++++++++++++++++++------------------- Tests/a.li | 19 ++++-- 7 files changed, 252 insertions(+), 81 deletions(-) diff --git a/AST.ml b/AST.ml index c7a1f1d57..0a4cbd4d6 100644 --- a/AST.ml +++ b/AST.ml @@ -41,6 +41,7 @@ let sepseq_to_region to_region = function type kwd_begin = Region.t type kwd_const = Region.t +type kwd_copy = Region.t type kwd_down = Region.t type kwd_else = Region.t type kwd_end = Region.t @@ -221,7 +222,7 @@ and record_type = { and field_decls = (field_decl reg, semi) nsepseq and field_decl = { - var : variable; + field_name : field_name; colon : colon; field_type : type_expr } @@ -311,7 +312,7 @@ and var_decl = { terminator : semi option } -and instructions = (instruction, semi) nsepseq reg +and instructions = (instruction, semi) nsepseq and instruction = Single of single_instr @@ -405,6 +406,7 @@ and expr = | ListExpr of list_expr | SetExpr of set_expr | ConstrExpr of constr_expr +| RecordExpr of record_expr | Var of Lexer.lexeme reg | FunCall of fun_call | Bytes of (Lexer.lexeme * MBytes.t) reg @@ -470,6 +472,37 @@ and constr_expr = | NoneExpr of none_expr reg | ConstrApp of (constr * arguments) reg +and record_expr = + RecordInj of record_injection reg +| RecordProj of record_projection reg +| RecordCopy of record_copy reg + +and record_injection = { + opening : kwd_record; + fields : (field_ass reg, semi) nsepseq; + terminator : semi option; + close : kwd_end +} + +and field_ass = { + field_name : field_name; + equal : equal; + field_expr : expr +} + +and record_projection = { + record_name : variable; + selector : dot; + field_name : field_name +} + +and record_copy = { + kwd_copy : kwd_copy; + record_name : variable; + kwd_with : kwd_with; + delta : record_injection reg +} + and tuple = (expr, comma) nsepseq par reg and empty_list = typed_empty_list par @@ -548,6 +581,7 @@ let rec expr_to_region = function | ListExpr e -> list_expr_to_region e | SetExpr e -> set_expr_to_region e | ConstrExpr e -> constr_expr_to_region e +| RecordExpr e -> record_expr_to_region e | Var {region; _} | FunCall {region; _} | Bytes {region; _} @@ -602,8 +636,13 @@ and constr_expr_to_region = function | ConstrApp {region; _} | SomeApp {region; _} -> region +and record_expr_to_region = function + RecordInj {region; _} +| RecordProj {region; _} +| RecordCopy {region; _} -> region + let instr_to_region = function - Single Cond {region;_} + Single Cond {region; _} | Single Match {region; _} | Single Ass {region; _} | Single Loop While {region; _} @@ -775,8 +814,8 @@ and print_field_decls sequence = print_nsepseq ";" print_field_decl sequence and print_field_decl {value; _} = - let {var; colon; field_type} = value in - print_var var; + let {field_name; colon; field_type} = value in + print_var field_name; print_token colon ":"; print_type_expr field_type @@ -879,8 +918,8 @@ and print_var_decl {value; _} = print_expr init; print_terminator terminator -and print_instructions {value; _} = - print_nsepseq ";" print_instruction value +and print_instructions sequence = + print_nsepseq ";" print_instruction sequence and print_instruction = function Single instr -> print_single_instr instr @@ -995,6 +1034,7 @@ and print_expr = function | ListExpr e -> print_list_expr e | SetExpr e -> print_set_expr e | ConstrExpr e -> print_constr_expr e +| RecordExpr e -> print_record_expr e | Var var -> print_var var | FunCall e -> print_fun_call e | Bytes b -> print_bytes b @@ -1066,6 +1106,37 @@ and print_constr_expr = function | NoneExpr e -> print_none_expr e | ConstrApp e -> print_constr_app e +and print_record_expr = function + RecordInj e -> print_record_injection e +| RecordProj e -> print_record_projection e +| RecordCopy e -> print_record_copy e + +and print_record_injection {value; _} = + let {opening; fields; terminator; close} = value in + print_token opening "record"; + print_nsepseq ";" print_field_ass fields; + print_terminator terminator; + print_token close "end" + +and print_field_ass {value; _} = + let {field_name; equal; field_expr} = value in + print_var field_name; + print_token equal "="; + print_expr field_expr + +and print_record_projection {value; _} = + let {record_name; selector; field_name} = value in + print_var record_name; + print_token selector "."; + print_var field_name + +and print_record_copy {value; _} = + let {kwd_copy; record_name; kwd_with; delta} = value in + print_token kwd_copy "copy"; + print_var record_name; + print_token kwd_with "with"; + print_record_injection delta + and print_tuple {value; _} = let {lpar; inside; rpar} = value in print_token lpar "("; diff --git a/AST.mli b/AST.mli index 224b5b10a..586a1902c 100644 --- a/AST.mli +++ b/AST.mli @@ -25,6 +25,7 @@ val sepseq_to_region : ('a -> Region.t) -> ('a,'sep) sepseq -> Region.t type kwd_begin = Region.t type kwd_const = Region.t +type kwd_copy = Region.t type kwd_down = Region.t type kwd_else = Region.t type kwd_end = Region.t @@ -205,7 +206,7 @@ and record_type = { and field_decls = (field_decl reg, semi) nsepseq and field_decl = { - var : variable; + field_name : field_name; colon : colon; field_type : type_expr } @@ -295,7 +296,7 @@ and var_decl = { terminator : semi option } -and instructions = (instruction, semi) nsepseq reg +and instructions = (instruction, semi) nsepseq and instruction = Single of single_instr @@ -389,6 +390,7 @@ and expr = | ListExpr of list_expr | SetExpr of set_expr | ConstrExpr of constr_expr +| RecordExpr of record_expr | Var of Lexer.lexeme reg | FunCall of fun_call | Bytes of (Lexer.lexeme * MBytes.t) reg @@ -454,6 +456,37 @@ and constr_expr = | NoneExpr of none_expr reg | ConstrApp of (constr * arguments) reg +and record_expr = + RecordInj of record_injection reg +| RecordProj of record_projection reg +| RecordCopy of record_copy reg + +and record_injection = { + opening : kwd_record; + fields : (field_ass reg, semi) nsepseq; + terminator : semi option; + close : kwd_end +} + +and field_ass = { + field_name : field_name; + equal : equal; + field_expr : expr +} + +and record_projection = { + record_name : variable; + selector : dot; + field_name : field_name +} + +and record_copy = { + kwd_copy : kwd_copy; + record_name : variable; + kwd_with : kwd_with; + delta : record_injection reg +} + and tuple = (expr, comma) nsepseq par reg and empty_list = typed_empty_list par diff --git a/LexToken.mli b/LexToken.mli index 15462de05..efbcad545 100644 --- a/LexToken.mli +++ b/LexToken.mli @@ -69,6 +69,7 @@ type t = | Begin of Region.t (* "begin" *) | Const of Region.t (* "const" *) +| Copy of Region.t (* "copy" *) | Down of Region.t (* "down" *) | Fail of Region.t (* "fail" *) | If of Region.t (* "if" *) diff --git a/LexToken.mll b/LexToken.mll index 3ad835f34..5a3bbd5ff 100644 --- a/LexToken.mll +++ b/LexToken.mll @@ -68,6 +68,7 @@ type t = | Begin of Region.t | Const of Region.t +| Copy of Region.t | Down of Region.t | Fail of Region.t | If of Region.t @@ -187,6 +188,7 @@ let proj_token = function | Begin region -> region, "Begin" | Const region -> region, "Const" +| Copy region -> region, "Copy" | Down region -> region, "Down" | Fail region -> region, "Fail" | If region -> region, "If" @@ -271,6 +273,7 @@ let to_lexeme = function | Begin _ -> "begin" | Const _ -> "const" +| Copy _ -> "copy" | Down _ -> "down" | Fail _ -> "fail" | If _ -> "if" @@ -323,6 +326,7 @@ let to_region token = proj_token token |> fst let keywords = [ (fun reg -> Begin reg); (fun reg -> Const reg); + (fun reg -> Copy reg); (fun reg -> Down reg); (fun reg -> Fail reg); (fun reg -> If reg); @@ -545,8 +549,9 @@ let is_ident = function | _ -> false let is_kwd = function -| Begin _ + Begin _ | Const _ +| Copy _ | Down _ | Fail _ | If _ diff --git a/ParToken.mly b/ParToken.mly index 18cd7e3ca..d8436e0dd 100644 --- a/ParToken.mly +++ b/ParToken.mly @@ -46,6 +46,7 @@ %token Begin (* "begin" *) %token Const (* "const" *) +%token Copy (* "copy" *) %token Down (* "down" *) %token Fail (* "fail" *) %token If (* "if" *) diff --git a/Parser.mly b/Parser.mly index 57b9ef5da..264f712e1 100644 --- a/Parser.mly +++ b/Parser.mly @@ -93,11 +93,12 @@ sepseq(X,Sep): (* Inlines *) -%inline var : Ident { $1 } -%inline type_name : Ident { $1 } -%inline fun_name : Ident { $1 } -%inline field_name : Ident { $1 } -%inline map_name : Ident { $1 } +%inline var : Ident { $1 } +%inline type_name : Ident { $1 } +%inline fun_name : Ident { $1 } +%inline field_name : Ident { $1 } +%inline record_name : Ident { $1 } +%inline map_name : Ident { $1 } (* Main *) @@ -117,8 +118,8 @@ storage_decl: Storage var COLON type_expr option(SEMI) { let stop = match $5 with - None -> type_expr_to_region $4 - | Some region -> region in + Some region -> region + | None -> type_expr_to_region $4 in let region = cover $1 stop in let value = { kwd_storage = $1; @@ -133,8 +134,8 @@ operations_decl: Operations var COLON type_expr option(SEMI) { let stop = match $5 with - None -> type_expr_to_region $4 - | Some region -> region in + Some region -> region + | None -> type_expr_to_region $4 in let region = cover $1 stop in let value = { kwd_operations = $1; @@ -151,8 +152,8 @@ type_decl: Type type_name Is type_expr option(SEMI) { let stop = match $5 with - None -> type_expr_to_region $4 - | Some region -> region in + Some region -> region + | None -> type_expr_to_region $4 in let region = cover $1 stop in let value = { kwd_type = $1; @@ -191,16 +192,13 @@ type_tuple: sum_type: nsepseq(variant,VBAR) { let region = nsepseq_to_region (fun x -> x.region) $1 - in {region; value=$1} + in {region; value = $1} } variant: Constr Of cartesian { let region = cover $1.region $3.region - and value = { - constr = $1; - kwd_of = $2; - product = $3} + and value = {constr = $1; kwd_of = $2; product = $3} in {region; value} } @@ -210,10 +208,7 @@ record_type: End { let region = cover $1 $3 - and value = { - kwd_record = $1; - fields = $2; - kwd_end = $3} + and value = {kwd_record = $1; fields = $2; kwd_end = $3} in {region; value} } @@ -221,10 +216,7 @@ field_decl: field_name COLON type_expr { let stop = type_expr_to_region $3 in let region = cover $1.region stop - and value = { - var = $1; - colon = $2; - field_type = $3} + and value = {field_name = $1; colon = $2; field_type = $3} in {region; value} } @@ -242,8 +234,8 @@ fun_decl: With expr option(SEMI) { let stop = match $11 with - None -> expr_to_region $10 - | Some region -> region in + Some region -> region + | None -> expr_to_region $10 in let region = cover $1 stop in let value = { kwd_function = $1; @@ -267,8 +259,8 @@ proc_decl: { let stop = match $7 with - None -> $6.region - | Some region -> region in + Some region -> region + | None -> $6.region in let region = cover $1 stop in let value = { kwd_procedure = $1; @@ -288,8 +280,8 @@ entry_decl: { let stop = match $7 with - None -> $6.region - | Some region -> region in + Some region -> region + | None -> $6.region in let region = cover $1 stop in let value = { kwd_entrypoint = $1; @@ -332,12 +324,10 @@ block: instruction after_instr { let instrs, terminator, close = $3 in - let region = cover $1 close in - let value = { - opening = $1; - instr = (let value = $2, instrs in - let region = nsepseq_to_region instr_to_region value - in {value; region}); + let region = cover $1 close + and value = { + opening = $1; + instr = $2, instrs; terminator; close} in {region; value} @@ -372,8 +362,8 @@ const_decl: Const var COLON type_expr EQUAL expr option(SEMI) { let stop = match $7 with - None -> expr_to_region $6 - | Some region -> region in + Some region -> region + | None -> expr_to_region $6 in let region = cover $1 stop in let value = { kwd_const = $1; @@ -390,8 +380,8 @@ var_decl: Var var COLON type_expr ASS expr option(SEMI) { let stop = match $7 with - None -> expr_to_region $6 - | Some region -> region in + Some region -> region + | None -> expr_to_region $6 in let region = cover $1 stop in let value = { kwd_var = $1; @@ -420,9 +410,7 @@ single_instr: fail_instr: Fail expr { let region = cover $1 (expr_to_region $2) - and value = { - kwd_fail = $1; - fail_expr = $2} + and value = {kwd_fail = $1; fail_expr = $2} in {region; value}} proc_call: @@ -457,26 +445,20 @@ match_instr: cases: nsepseq(case,VBAR) { let region = nsepseq_to_region (fun x -> x.region) $1 - in {region; value=$1} + in {region; value = $1} } case: pattern ARROW instruction { let region = cover (pattern_to_region $1) (instr_to_region $3) - and value = { - pattern = $1; - arrow = $2; - instr = $3} + and value = {pattern = $1; arrow = $2; instr = $3} in {region; value} } ass: var ASS expr { let region = cover $1.region (expr_to_region $3) - and value = { - var = $1; - ass = $2; - expr = $3} + and value = {var = $1; ass = $2; expr = $3} in {region; value} } @@ -512,15 +494,13 @@ for_loop: | For var option(arrow_clause) In expr block { let region = cover $1 $6.region in - let value = - { - kwd_for = $1; - var = $2; - bind_to = $3; - kwd_in = $4; - expr = $5; - block = $6; - } + let value = { + kwd_for = $1; + var = $2; + bind_to = $3; + kwd_in = $4; + expr = $5; + block = $6} in For (ForCollect {region; value}) } @@ -701,14 +681,83 @@ core_expr: } | map_name DOT brackets(expr) { let region = cover $1.region $3.region in - let value = - { - map_name = $1; - selector = $2; - index = $3; - } + let value = { + map_name = $1; + selector = $2; + index = $3} in MapLookUp {region; value} } +| record_expr { RecordExpr $1 } + +record_expr: + record_injection { RecordInj $1 } +| record_projection { RecordProj $1 } +| record_copy { RecordCopy $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) + } + +field_assignment: + field_name EQUAL expr { + let region = cover $1.region (expr_to_region $3) + and value = { + field_name = $1; + equal = $2; + field_expr = $3} + in {region; value} + } + +record_projection: + record_name DOT field_name { + let region = cover $1.region $3.region in + let value = { + record_name = $1; + selector = $2; + field_name = $3} + in {region; value} + } + +record_copy: + Copy record_name With record_injection { + let region = cover $1 $4.region in + let value = { + kwd_copy = $1; + record_name = $2; + kwd_with = $3; + delta = $4} + in {region; value} + } fun_call: fun_name arguments { diff --git a/Tests/a.li b/Tests/a.li index 9ab4b3399..f6e042032 100644 --- a/Tests/a.li +++ b/Tests/a.li @@ -4,22 +4,33 @@ type v is record foo: key; bar: mutez; baz: address end type w is K of (U of int) (*v * u*) storage s : w // Line comment -operations o : u; - type i is int; +operations o : u; +const pi : int = 314159 + +const x : v = + record + foo = 4; + bar = 5; + baz = 0x3244 + end (* Block comment *) entrypoint g (const l : list (int)) is - function f (const x : int) : int is + + var y : v := copy x with record bar = 7 end; + + function f (const x : int) : int is var y : int := 5 - x const z : int = 6 begin y := x + y end with y * 2 + begin match l with - [] -> null + [] -> null | h#t -> q (h+2) end; begin