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.
This commit is contained in:
Christian Rinderknecht 2019-03-14 09:59:26 +01:00
parent 1f4f541a5b
commit c0e6843240
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
7 changed files with 252 additions and 81 deletions

85
AST.ml
View File

@ -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 "(";

37
AST.mli
View File

@ -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

View File

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

View File

@ -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 _

View File

@ -46,6 +46,7 @@
%token <Region.t> Begin (* "begin" *)
%token <Region.t> Const (* "const" *)
%token <Region.t> Copy (* "copy" *)
%token <Region.t> Down (* "down" *)
%token <Region.t> Fail (* "fail" *)
%token <Region.t> If (* "if" *)

View File

@ -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 {

View File

@ -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