Further reducing the distance from Ligodity AST to Pascaligo AST.

This commit is contained in:
Christian Rinderknecht 2019-05-13 12:28:10 +02:00 committed by Georges Dupéron
parent dcbfbf781d
commit 0796567aee
10 changed files with 172 additions and 215 deletions

View File

@ -6,6 +6,7 @@
tezos-utils tezos-utils
parser_pascaligo parser_pascaligo
parser_camligo parser_camligo
parser_ligodity
) )
(preprocess (preprocess
(pps simple-utils.ppx_let_generalized) (pps simple-utils.ppx_let_generalized)

View File

@ -76,6 +76,10 @@ type colon = Region.t (* ":" *)
type wild = Region.t (* "_" *) type wild = Region.t (* "_" *)
(* Virtual tokens *)
type eof = Region.t
(* Literals *) (* Literals *)
type variable = string reg type variable = string reg
@ -98,9 +102,9 @@ type the_unit = lpar * rpar
(* Brackets compounds *) (* Brackets compounds *)
type 'a brackets = { type 'a brackets = {
lbracket : lbracket; lbracket : lbracket;
inside : 'a; inside : 'a;
rbracket : rbracket rbracket : rbracket
} }
(* The Abstract Syntax Tree *) (* The Abstract Syntax Tree *)
@ -112,8 +116,6 @@ type t = {
and ast = t and ast = t
and eof = Region.t
and declaration = and declaration =
Let of (kwd_let * let_bindings) reg Let of (kwd_let * let_bindings) reg
| LetEntry of (kwd_let_entry * let_binding) reg | LetEntry of (kwd_let_entry * let_binding) reg
@ -130,7 +132,7 @@ and let_binding = {
let_rhs : expr let_rhs : expr
} }
(* Recursive types *) (* Type declarations *)
and type_decl = { and type_decl = {
kwd_type : kwd_type; kwd_type : kwd_type;
@ -165,24 +167,9 @@ and field_decl = {
and type_tuple = (type_expr, comma) Utils.nsepseq par and type_tuple = (type_expr, comma) Utils.nsepseq par
and 'a injection = {
opening : opening;
elements : ('a, semi) Utils.sepseq;
terminator : semi option;
closing : closing
}
and opening =
Begin of kwd_begin
| LBrace of lbrace
and closing =
End of kwd_end
| RBrace of rbrace
and pattern = and pattern =
PTuple of (pattern, comma) Utils.nsepseq reg PTuple of (pattern, comma) Utils.nsepseq reg
| PList of (pattern, semi) Utils.sepseq brackets reg | PList of list_pattern
| PVar of variable | PVar of variable
| PUnit of the_unit reg | PUnit of the_unit reg
| PInt of (string * Z.t) reg | PInt of (string * Z.t) reg
@ -190,12 +177,15 @@ and pattern =
| PFalse of kwd_false | PFalse of kwd_false
| PString of string reg | PString of string reg
| PWild of wild | PWild of wild
| PCons of (pattern * cons * pattern) reg
| PPar of pattern par reg | PPar of pattern par reg
| PConstr of (constr * pattern option) reg | PConstr of (constr * pattern option) reg
| PRecord of record_pattern | PRecord of record_pattern
| PTyped of typed_pattern reg | PTyped of typed_pattern reg
and list_pattern =
Sugar of pattern injection reg
| PCons of (pattern * cons * pattern) reg
and typed_pattern = { and typed_pattern = {
pattern : pattern; pattern : pattern;
colon : colon; colon : colon;
@ -211,28 +201,45 @@ and field_pattern = {
} }
and expr = and expr =
LetIn of let_in reg ELetIn of let_in reg
| Fun of fun_expr | EFun of fun_expr
| If of conditional | ECond of conditional
| ETuple of (expr, comma) Utils.nsepseq reg | ETuple of (expr, comma) Utils.nsepseq reg
| Match of match_expr reg | EMatch of match_expr reg
| Seq of sequence | ESeq of sequence
| ERecord of record_expr | ERecord of record_expr
| Append of (expr * append * expr) reg
| Cons of (expr * cons * expr) reg
| ELogic of logic_expr | ELogic of logic_expr
| EArith of arith_expr | EArith of arith_expr
| EString of string_expr | EString of string_expr
| ECall of (expr * expr) reg
| Call of (expr * expr) reg
| Path of path reg | Path of path reg
| Unit of the_unit reg | EUnit of the_unit reg
| Par of expr par reg | EPar of expr par reg
| EList of (expr, semi) Utils.sepseq brackets reg | EList of list_expr
| EConstr of constr | EConstr of constr
and 'a injection = {
opening : opening;
elements : ('a, semi) Utils.sepseq;
terminator : semi option;
closing : closing
}
and opening =
Begin of kwd_begin
| LBrace of lbrace
| LBracket of lbracket
and closing =
End of kwd_end
| RBrace of rbrace
| RBracket of rbracket
and list_expr =
Cons of cons bin_op reg
| List of expr injection reg
| Append of (expr * append * expr) reg
and string_expr = and string_expr =
Cat of cat bin_op reg Cat of cat bin_op reg
| String of string reg | String of string reg
@ -314,10 +321,14 @@ and conditional =
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
let region_of_list_pattern = function
Sugar {region; _} | PCons {region; _} -> region
let region_of_pattern = function let region_of_pattern = function
PList {region;_} | PTuple {region;_} | PVar {region;_} PList p -> region_of_list_pattern p
| PTuple {region;_} | PVar {region;_}
| PUnit {region;_} | PInt {region;_} | PTrue region | PFalse region | PUnit {region;_} | PInt {region;_} | PTrue region | PFalse region
| PString {region;_} | PWild region | PCons {region;_} | PString {region;_} | PWild region
| PConstr {region; _} | PPar {region;_} | PRecord {region; _} | PConstr {region; _} | PPar {region;_} | PRecord {region; _}
| PTyped {region; _} -> region | PTyped {region; _} -> region
@ -344,39 +355,21 @@ let region_of_arith_expr = function
let region_of_string_expr = function let region_of_string_expr = function
String {region;_} | Cat {region;_} -> region String {region;_} | Cat {region;_} -> region
let region_of_list_expr = function
Cons {region; _} | List {region; _} | Append {region; _} -> region
let region_of_expr = function let region_of_expr = function
ELogic e -> region_of_logic_expr e ELogic e -> region_of_logic_expr e
| EArith e -> region_of_arith_expr e | EArith e -> region_of_arith_expr e
| EString e -> region_of_string_expr e | EString e -> region_of_string_expr e
| LetIn {region;_} | Fun {region;_} | EList e -> region_of_list_expr e
| If IfThen {region;_} | If IfThenElse {region; _} | ELetIn {region;_} | EFun {region;_}
| ETuple {region;_} | Match {region;_} | Cons {region;_} | ECond IfThen {region;_} | ECond IfThenElse {region; _}
| Call {region;_} | Path {region;_} | ETuple {region;_} | EMatch {region;_}
| Unit {region;_} | Par {region;_} | EList {region;_} | ECall {region;_} | Path {region;_}
| Seq {region; _} | ERecord {region; _} | EUnit {region;_} | EPar {region;_}
| Append {region; _} | EConstr {region; _} -> region | ESeq {region; _} | ERecord {region; _}
| EConstr {region; _} -> region
(* Predicates *)
let rec is_var = function
Par {value={inside=e;_};_} -> is_var e
| Path _ -> true
| _ -> false
let rec is_call = function
Par {value={inside=e;_};_} -> is_call e
| Call _ -> true
| _ -> false
let rec is_fun = function
Par {value={inside=e;_};_} -> is_fun e
| Fun _ -> true
| _ -> false
let rec rm_par = function
Par {value={inside=e;_};_} -> rm_par e
| e -> e
(* Rewriting let-expressions and fun-expressions, with some optimisations *) (* Rewriting let-expressions and fun-expressions, with some optimisations *)
@ -397,7 +390,7 @@ let norm_fun region kwd_fun pattern eq expr =
let bindings = {pattern; eq; let bindings = {pattern; eq;
lhs_type=None; let_rhs = Path path}, [] in lhs_type=None; let_rhs = Path path}, [] in
let let_in = ghost_let, bindings, ghost_in, expr in let let_in = ghost_let, bindings, ghost_in, expr in
let expr = LetIn {value=let_in; region=Region.ghost} let expr = ELetIn {value=let_in; region=Region.ghost}
in kwd_fun, fresh, ghost_arrow, expr in kwd_fun, fresh, ghost_arrow, expr
in Region.{region; value} in Region.{region; value}
@ -407,7 +400,7 @@ let norm ?reg (pattern, patterns) sep expr =
None -> Region.ghost, ghost_fun None -> Region.ghost, ghost_fun
| Some p -> p in | Some p -> p in
let apply pattern (sep, expr) = let apply pattern (sep, expr) =
ghost_eq, Fun (norm_fun Region.ghost ghost_fun pattern sep expr) in ghost_eq, EFun (norm_fun Region.ghost ghost_fun pattern sep expr) in
let sep, expr = List.fold_right apply patterns (sep, expr) let sep, expr = List.fold_right apply patterns (sep, expr)
in norm_fun reg fun_reg pattern sep expr in norm_fun reg fun_reg pattern sep expr
@ -425,10 +418,10 @@ type unparsed = [
sign or "->". *) sign or "->". *)
let rec unparse' = function let rec unparse' = function
Fun {value=_,var,arrow,expr; _} -> EFun {value=_,var,arrow,expr; _} ->
if var.region#is_ghost then if var.region#is_ghost then
match expr with match expr with
LetIn {value = _,({pattern;eq;_},[]),_,expr; _} -> ELetIn {value = _,({pattern;eq;_},[]),_,expr; _} ->
if eq#is_ghost then if eq#is_ghost then
let patterns, sep, e = unparse' expr let patterns, sep, e = unparse' expr
in Utils.nseq_cons pattern patterns, sep, e in Utils.nseq_cons pattern patterns, sep, e
@ -441,7 +434,7 @@ let rec unparse' = function
| _ -> assert false | _ -> assert false
let unparse = function let unparse = function
Fun {value=kwd_fun,_,_,_; _} as e -> EFun {value=kwd_fun,_,_,_; _} as e ->
let binding = unparse' e in let binding = unparse' e in
if kwd_fun#is_ghost then `Let binding else `Fun (kwd_fun, binding) if kwd_fun#is_ghost then `Let binding else `Fun (kwd_fun, binding)
| e -> `Idem e | e -> `Idem e
@ -460,7 +453,6 @@ let print_sepseq sep print = function
let print_csv print = print_nsepseq "," print let print_csv print = print_nsepseq "," print
let print_bsv print = print_nsepseq "|" print let print_bsv print = print_nsepseq "|" print
let print_ssv print = print_sepseq ";" print
let print_token (reg: Region.t) conc = let print_token (reg: Region.t) conc =
Printf.printf "%s: %s\n" (reg#compact `Byte) conc Printf.printf "%s: %s\n" (reg#compact `Byte) conc
@ -570,12 +562,14 @@ and print_injection :
print_closing closing print_closing closing
and print_opening = function and print_opening = function
Begin region -> print_token region "begin" Begin region -> print_token region "begin"
| LBrace region -> print_token region "{" | LBrace region -> print_token region "{"
| LBracket region -> print_token region "["
and print_closing = function and print_closing = function
End region -> print_token region "end" End region -> print_token region "end"
| RBrace region -> print_token region "}" | RBrace region -> print_token region "}"
| RBracket region -> print_token region "]"
and print_terminator = function and print_terminator = function
Some semi -> print_token semi ";" Some semi -> print_token semi ";"
@ -608,10 +602,7 @@ and print_let_binding undo {pattern; lhs_type; eq; let_rhs} =
and print_pattern = function and print_pattern = function
PTuple {value=patterns;_} -> print_csv print_pattern patterns PTuple {value=patterns;_} -> print_csv print_pattern patterns
| PList {value={lbracket; inside=patterns; rbracket}; _} -> | PList p -> print_list_pattern p
print_token lbracket "[";
print_ssv print_pattern patterns;
print_token rbracket "]"
| PVar {region; value} -> | PVar {region; value} ->
Printf.printf "%s: PVar %s\n" (region#compact `Byte) value Printf.printf "%s: PVar %s\n" (region#compact `Byte) value
| PUnit {value=lpar,rpar; _} -> | PUnit {value=lpar,rpar; _} ->
@ -622,14 +613,19 @@ and print_pattern = function
| PFalse kwd_false -> print_token kwd_false "false" | PFalse kwd_false -> print_token kwd_false "false"
| PString s -> print_str s | PString s -> print_str s
| PWild wild -> print_token wild "_" | PWild wild -> print_token wild "_"
| PCons {value=p1,c,p2; _} ->
print_pattern p1; print_token c "::"; print_pattern p2
| PPar {value={lpar;inside=p;rpar}; _} -> | PPar {value={lpar;inside=p;rpar}; _} ->
print_token lpar "("; print_pattern p; print_token rpar ")" print_token lpar "("; print_pattern p; print_token rpar ")"
| PConstr p -> print_constr_pattern p | PConstr p -> print_constr_pattern p
| PRecord r -> print_record_pattern r | PRecord r -> print_record_pattern r
| PTyped t -> print_typed_pattern t | PTyped t -> print_typed_pattern t
and print_list_pattern = function
Sugar p -> print_injection print_pattern p
| PCons p -> print_raw p
and print_raw {value=p1,c,p2; _} =
print_pattern p1; print_token c "::"; print_pattern p2
and print_typed_pattern {value; _} = and print_typed_pattern {value; _} =
let {pattern; colon; type_expr} = value in let {pattern; colon; type_expr} = value in
print_pattern pattern; print_pattern pattern;
@ -652,11 +648,11 @@ and print_constr_pattern {value=constr, p_opt; _} =
| Some pattern -> print_pattern pattern | Some pattern -> print_pattern pattern
and print_expr undo = function and print_expr undo = function
LetIn {value;_} -> print_let_in undo value ELetIn {value;_} -> print_let_in undo value
| If cond -> print_conditional undo cond | ECond cond -> print_conditional undo cond
| ETuple {value;_} -> print_csv (print_expr undo) value | ETuple {value;_} -> print_csv (print_expr undo) value
| Match {value;_} -> print_match_expr undo value | EMatch {value;_} -> print_match_expr undo value
| Fun {value=(kwd_fun,_,_,_) as f; _} as e -> | EFun {value=(kwd_fun,_,_,_) as f; _} as e ->
if undo then if undo then
let patterns, arrow, expr = unparse' e in let patterns, arrow, expr = unparse' e in
print_token kwd_fun "fun"; print_token kwd_fun "fun";
@ -665,26 +661,32 @@ and print_expr undo = function
print_expr undo expr print_expr undo expr
else print_fun_expr undo f else print_fun_expr undo f
| Cons {value=e1,cons,e2; _} ->
print_expr undo e1; print_token cons "::"; print_expr undo e2
| ELogic e -> print_logic_expr undo e | ELogic e -> print_logic_expr undo e
| EArith e -> print_arith_expr undo e | EArith e -> print_arith_expr undo e
| EString e -> print_string_expr undo e | EString e -> print_string_expr undo e
| Call {value=e1,e2; _} -> print_expr undo e1; print_expr undo e2 | ECall {value=e1,e2; _} -> print_expr undo e1; print_expr undo e2
| Path p -> print_path p | Path p -> print_path p
| Unit {value=lpar,rpar; _} -> | EUnit {value=lpar,rpar; _} ->
print_token lpar "("; print_token rpar ")" print_token lpar "("; print_token rpar ")"
| Par {value={lpar;inside=e;rpar}; _} -> | EPar {value={lpar;inside=e;rpar}; _} ->
print_token lpar "("; print_expr undo e; print_token rpar ")" print_token lpar "("; print_expr undo e; print_token rpar ")"
| EList {value={lbracket; inside=ssv; rbracket}; _} -> | EList e -> print_list_expr undo e
print_token lbracket "["; print_ssv (print_expr undo) ssv; print_token rbracket "]" | ESeq seq -> print_sequence undo seq
| Seq seq -> print_sequence undo seq
| ERecord e -> print_record_expr undo e | ERecord e -> print_record_expr undo e
| Append {value=e1,append,e2; _} ->
print_expr undo e1; print_token append "@"; print_expr undo e2
| EConstr constr -> print_uident constr | EConstr constr -> print_uident constr
and print_list_expr undo = function
Cons {value={arg1;op;arg2}; _} ->
print_expr undo arg1;
print_token op "::";
print_expr undo arg2
| List e -> print_injection (print_expr undo) e
| Append {value=e1,append,e2; _} ->
print_expr undo e1;
print_token append "@";
print_expr undo e2
and print_arith_expr undo = function and print_arith_expr undo = function
Add {value={arg1;op;arg2}; _} -> Add {value={arg1;op;arg2}; _} ->
print_expr undo arg1; print_token op "+"; print_expr undo arg2 print_expr undo arg1; print_token op "+"; print_expr undo arg2

View File

@ -185,16 +185,18 @@ and 'a injection = {
} }
and opening = and opening =
Begin of kwd_begin Begin of kwd_begin
| LBrace of lbrace | LBrace of lbrace
| LBracket of lbracket
and closing = and closing =
End of kwd_end End of kwd_end
| RBrace of rbrace | RBrace of rbrace
| RBracket of rbracket
and pattern = and pattern =
PTuple of (pattern, comma) Utils.nsepseq reg (* p1, p2, ... *) PTuple of (pattern, comma) Utils.nsepseq reg (* p1, p2, ... *)
| PList of (pattern, semi) Utils.sepseq brackets reg (* [p1; p2; ...] *) | PList of list_pattern
| PVar of variable (* x *) | PVar of variable (* x *)
| PUnit of the_unit reg (* () *) | PUnit of the_unit reg (* () *)
| PInt of (string * Z.t) reg (* 7 *) | PInt of (string * Z.t) reg (* 7 *)
@ -202,12 +204,15 @@ and pattern =
| PFalse of kwd_false (* false *) | PFalse of kwd_false (* false *)
| PString of string reg (* "foo" *) | PString of string reg (* "foo" *)
| PWild of wild (* _ *) | PWild of wild (* _ *)
| PCons of (pattern * cons * pattern) reg (* p1 :: p2 *)
| PPar of pattern par reg (* (p) *) | PPar of pattern par reg (* (p) *)
| PConstr of (constr * pattern option) reg (* A B(3,"") *) | PConstr of (constr * pattern option) reg (* A B(3,"") *)
| PRecord of record_pattern (* {a=...; ...} *) | PRecord of record_pattern (* {a=...; ...} *)
| PTyped of typed_pattern reg (* (x : int) *) | PTyped of typed_pattern reg (* (x : int) *)
and list_pattern =
Sugar of pattern injection reg (* [p1; p2; ...] *)
| PCons of (pattern * cons * pattern) reg (* p1 :: p2 *)
and typed_pattern = { and typed_pattern = {
pattern : pattern; pattern : pattern;
colon : colon; colon : colon;
@ -223,35 +228,34 @@ and field_pattern = {
} }
and expr = and expr =
LetIn of let_in reg (* let p1 = e1 and p2 = e2 and ... in e *) ELetIn of let_in reg (* let p1 = e1 and p2 = e2 and ... in e *)
| Fun of fun_expr (* fun x -> e *) | EFun of fun_expr (* fun x -> e *)
| If of conditional (* if e1 then e2 else e3 *) | ECond of conditional (* if e1 then e2 else e3 *)
| ETuple of (expr, comma) Utils.nsepseq reg (* e1, e2, ... *) | ETuple of (expr, comma) Utils.nsepseq reg (* e1, e2, ... *)
| Match of match_expr reg (* p1 -> e1 | p2 -> e2 | ... *) | EMatch of match_expr reg (* p1 -> e1 | p2 -> e2 | ... *)
| Seq of sequence (* begin e1; e2; ... ; en end *) | ESeq of sequence (* begin e1; e2; ... ; en end *)
| ERecord of record_expr (* {f1=e1; ... } *) | ERecord of record_expr (* {f1=e1; ... } *)
| Append of (expr * append * expr) reg (* e1 @ e2 *)
| Cons of (expr * cons * expr) reg (* e1 :: e2 *)
| ELogic of logic_expr | ELogic of logic_expr
| EArith of arith_expr | EArith of arith_expr
| EString of string_expr | EString of string_expr
| ECall of (expr * expr) reg (* f e *)
| Call of (expr * expr) reg (* f e *)
| Path of path reg (* x x.y.z *) | Path of path reg (* x x.y.z *)
| Unit of the_unit reg (* () *) | EUnit of the_unit reg (* () *)
| Par of expr par reg (* (e) *) | EPar of expr par reg (* (e) *)
| EList of (expr, semi) Utils.sepseq brackets reg (* [e1; e2; ...] *) | EList of list_expr
| EConstr of constr | EConstr of constr
(*| Extern of extern*)
and list_expr =
Cons of cat bin_op reg (* e1 :: e3 *)
| List of expr injection reg (* [e1; e2; ...] *)
| Append of (expr * append * expr) reg (* e1 @ e2 *)
and string_expr = and string_expr =
Cat of cat bin_op reg (* e1 ^ e2 *) Cat of cat bin_op reg (* e1 ^ e2 *)
| String of string reg (* "foo" *) | String of string reg (* "foo" *)
and arith_expr = and arith_expr =
Add of plus bin_op reg (* e1 + e2 *) Add of plus bin_op reg (* e1 + e2 *)
| Sub of minus bin_op reg (* e1 - e2 *) | Sub of minus bin_op reg (* e1 - e2 *)
@ -333,27 +337,6 @@ and conditional =
IfThen of (kwd_if * expr * kwd_then * expr) reg IfThen of (kwd_if * expr * kwd_then * expr) reg
| IfThenElse of (kwd_if * expr * kwd_then * expr * kwd_else * expr) reg | IfThenElse of (kwd_if * expr * kwd_then * expr * kwd_else * expr) reg
(*
and extern =
Cast of cast_expr
| Print of print_expr
| Scanf of scanf_expr
| PolyEq of (variable * variable) (* polymorphic equality *)
and cast_expr =
StringOfInt of variable (* string_of_int x *)
| StringOfBool of variable (* string_of_bool x *)
and print_expr =
PrintString of variable (* print_string x *)
| PrintInt of variable (* print_int x *)
and scanf_expr =
ScanfString of variable (* scanf_string x *)
| ScanfInt of variable (* scanf_int x *)
| ScanfBool of variable (* scanf_bool x *)
*)
(* Normalising nodes of the AST so the interpreter is more uniform and (* Normalising nodes of the AST so the interpreter is more uniform and
no source regions are lost in order to enable all manner of no source regions are lost in order to enable all manner of
source-to-source transformations from the rewritten AST and the source-to-source transformations from the rewritten AST and the
@ -490,36 +473,3 @@ val print_tokens : ?undo:bool -> ast -> unit
val region_of_pattern : pattern -> Region.t val region_of_pattern : pattern -> Region.t
val region_of_expr : expr -> Region.t val region_of_expr : expr -> Region.t
(* Removing all outermost parentheses from a given expression *)
val rm_par : expr -> expr
(* Predicates on expressions *)
val is_var : expr -> bool
val is_call : expr -> bool
val is_fun : expr -> bool
(* Variables *)
(*
module Vars : Set.S with type elt = string
module FreeVars : Set.S with type elt = variable
(* The value of the call [vars t] is a pair of sets: the first is the
set of variables whose definitions are in the scope at the end of
the program corresponding to the AST [t], the second is the set of
free variables in that same AST.
Computing free variables is useful because we do not want to
escape a variable that is a predefined variable in OCaml, when we
translate the program to OCaml: this way, we make sure that an
unbound variable is caught before the translation (where it would
be wrongly captured by the OCaml compiler).
Dually, computing bound variables is useful when compiling to
OCaml.
*)
val vars : t -> Vars.t * FreeVars.t
*)

View File

@ -239,8 +239,8 @@ rule scan = parse
| "(" { Token.LPAR } | "(" { Token.LPAR }
| ")" { Token.RPAR } | ")" { Token.RPAR }
| "[" { Token.LBRACK } | "[" { Token.LBRACKET }
| "]" { Token.RBRACK } | "]" { Token.RBRACKET }
| "{" { Token.LBRACE } | "{" { Token.LBRACE }
| "}" { Token.RBRACE } | "}" { Token.RBRACE }

View File

@ -10,8 +10,8 @@
%token LPAR %token LPAR
%token RPAR %token RPAR
%token LBRACK %token LBRACKET
%token RBRACK %token RBRACKET
%token LBRACE %token LBRACE
%token RBRACE %token RBRACE

View File

@ -68,7 +68,7 @@ sep_or_term_list(item,sep):
par(X): sym(LPAR) X sym(RPAR) { {lpar=$1; inside=$2; rpar=$3} } par(X): sym(LPAR) X sym(RPAR) { {lpar=$1; inside=$2; rpar=$3} }
brackets(X): sym(LBRACK) X sym(RBRACK) { brackets(X): sym(LBRACKET) X sym(RBRACKET) {
{lbracket=$1; inside=$2; rbracket=$3} } {lbracket=$1; inside=$2; rbracket=$3} }
(* Sequences (* Sequences
@ -125,12 +125,16 @@ tuple(item):
(* Possibly empty semicolon-separated values between brackets *) (* Possibly empty semicolon-separated values between brackets *)
list_of(item): list_of(item):
reg(brackets(sepseq(item,sym(SEMI)))) { $1 } sym(LBRACKET) sepseq(item,sym(SEMI)) sym(RBRACKET) {
{opening = LBracket $1;
elements = $2;
terminator = None;
closing = RBracket $3} }
(* Main *) (* Main *)
program: program:
nseq(declaration) eof { {decl=$1; eof=$2} } nseq(declaration) eof { {decl=$1; eof=$2} }
declaration: declaration:
reg(kwd(Let) let_bindings {$1,$2}) { Let $1 } reg(kwd(Let) let_bindings {$1,$2}) { Let $1 }
@ -226,7 +230,7 @@ let_bindings:
let_binding: let_binding:
ident nseq(sub_irrefutable) option(type_annotation) sym(EQ) expr { ident nseq(sub_irrefutable) option(type_annotation) sym(EQ) expr {
let let_rhs = Fun (norm $2 $4 $5) in let let_rhs = EFun (norm $2 $4 $5) in
{pattern = PVar $1; lhs_type=$3; eq = Region.ghost; let_rhs} {pattern = PVar $1; lhs_type=$3; eq = Region.ghost; let_rhs}
} }
| irrefutable option(type_annotation) sym(EQ) expr { | irrefutable option(type_annotation) sym(EQ) expr {
@ -258,7 +262,7 @@ typed_pattern:
{pattern=$1; colon=$2; type_expr=$3} } {pattern=$1; colon=$2; type_expr=$3} }
pattern: pattern:
reg(sub_pattern sym(CONS) tail {$1,$2,$3}) { PCons $1 } reg(sub_pattern sym(CONS) tail {$1,$2,$3}) { PList (PCons $1) }
| reg(tuple(sub_pattern)) { PTuple $1 } | reg(tuple(sub_pattern)) { PTuple $1 }
| core_pattern { $1 } | core_pattern { $1 }
@ -275,7 +279,7 @@ core_pattern:
| kwd(False) { PFalse $1 } | kwd(False) { PFalse $1 }
| string { PString $1 } | string { PString $1 }
| reg(par(ptuple)) { PPar $1 } | reg(par(ptuple)) { PPar $1 }
| list_of(tail) { PList $1 } | reg(list_of(tail)) { PList (Sugar $1) }
| reg(constr_pattern) { PConstr $1 } | reg(constr_pattern) { PConstr $1 }
| reg(record_pattern) { PRecord $1 } | reg(record_pattern) { PRecord $1 }
@ -304,14 +308,14 @@ unit:
reg(sym(LPAR) sym(RPAR) {$1,$2}) { $1 } reg(sym(LPAR) sym(RPAR) {$1,$2}) { $1 }
tail: tail:
reg(sub_pattern sym(CONS) tail {$1,$2,$3}) { PCons $1 } reg(sub_pattern sym(CONS) tail {$1,$2,$3}) { PList (PCons $1) }
| sub_pattern { $1 } | sub_pattern { $1 }
(* Expressions *) (* Expressions *)
expr: expr:
base_cond__open(expr) { $1 } base_cond__open(expr) { $1 }
| match_expr(base_cond) { Match $1 } | match_expr(base_cond) { EMatch $1 }
base_cond__open(x): base_cond__open(x):
base_expr(x) base_expr(x)
@ -328,7 +332,7 @@ base_expr(right_expr):
conditional(right_expr): conditional(right_expr):
if_then_else(right_expr) if_then_else(right_expr)
| if_then(right_expr) { If $1 } | if_then(right_expr) { ECond $1 }
if_then(right_expr): if_then(right_expr):
reg(kwd(If) expr kwd(Then) right_expr {$1,$2,$3,$4}) { IfThen $1 } reg(kwd(If) expr kwd(Then) right_expr {$1,$2,$3,$4}) { IfThen $1 }
@ -339,14 +343,14 @@ if_then_else(right_expr):
base_if_then_else__open(x): base_if_then_else__open(x):
base_expr(x) { $1 } base_expr(x) { $1 }
| if_then_else(x) { If $1 } | if_then_else(x) { ECond $1 }
base_if_then_else: base_if_then_else:
base_if_then_else__open(base_if_then_else) { $1 } base_if_then_else__open(base_if_then_else) { $1 }
closed_if: closed_if:
base_if_then_else__open(closed_if) { $1 } base_if_then_else__open(closed_if) { $1 }
| match_expr(base_if_then_else) { Match $1 } | match_expr(base_if_then_else) { EMatch $1 }
match_expr(right_expr): match_expr(right_expr):
reg(kwd(Match) expr kwd(With) reg(kwd(Match) expr kwd(With)
@ -361,7 +365,7 @@ match_nat(right_expr):
let cast_name = Name {region=ghost; value="assert_pos"} in let cast_name = Name {region=ghost; value="assert_pos"} in
let cast_path = {module_proj=None; value_proj=cast_name,[]} in let cast_path = {module_proj=None; value_proj=cast_name,[]} in
let cast_fun = Path {region=ghost; value=cast_path} in let cast_fun = Path {region=ghost; value=cast_path} in
let cast = Call {region=ghost; value=cast_fun,$2} let cast = ECall {region=ghost; value=cast_fun,$2}
in $1, cast, $3, ($4, Utils.nsepseq_rev $5) } in $1, cast, $3, ($4, Utils.nsepseq_rev $5) }
cases(right_expr): cases(right_expr):
@ -374,13 +378,12 @@ case(right_expr):
let_expr(right_expr): let_expr(right_expr):
reg(kwd(Let) let_bindings kwd(In) right_expr {$1,$2,$3,$4}) { reg(kwd(Let) let_bindings kwd(In) right_expr {$1,$2,$3,$4}) {
LetIn $1 ELetIn $1 }
}
fun_expr(right_expr): fun_expr(right_expr):
reg(kwd(Fun) nseq(irrefutable) sym(ARROW) right_expr {$1,$2,$3,$4}) { reg(kwd(Fun) nseq(irrefutable) sym(ARROW) right_expr {$1,$2,$3,$4}) {
let Region.{region; value = kwd_fun, patterns, arrow, expr} = $1 let Region.{region; value = kwd_fun, patterns, arrow, expr} = $1
in Fun (norm ~reg:(region, kwd_fun) patterns arrow expr) } in EFun (norm ~reg:(region, kwd_fun) patterns arrow expr) }
disj_expr_level: disj_expr_level:
reg(disj_expr) { ELogic (BoolExpr (Or $1)) } reg(disj_expr) { ELogic (BoolExpr (Or $1)) }
@ -431,9 +434,9 @@ ne_expr:
bin_op(comp_expr_level, sym(NE), cat_expr_level) { $1 } bin_op(comp_expr_level, sym(NE), cat_expr_level) { $1 }
cat_expr_level: cat_expr_level:
reg(cat_expr) { EString (Cat $1) } reg(cat_expr) { EString (Cat $1) }
| reg(append_expr) { Append $1 } | reg(append_expr) { EList (Append $1) }
| cons_expr_level { $1 } | cons_expr_level { $1 }
cat_expr: cat_expr:
bin_op(cons_expr_level, sym(CAT), cat_expr_level) { $1 } bin_op(cons_expr_level, sym(CAT), cat_expr_level) { $1 }
@ -442,11 +445,11 @@ append_expr:
cons_expr_level sym(APPEND) cat_expr_level { $1,$2,$3 } cons_expr_level sym(APPEND) cat_expr_level { $1,$2,$3 }
cons_expr_level: cons_expr_level:
reg(cons_expr) { Cons $1 } reg(cons_expr) { EList (Cons $1) }
| add_expr_level { $1 } | add_expr_level { $1 }
cons_expr: cons_expr:
add_expr_level sym(CONS) cons_expr_level { $1,$2,$3 } bin_op(add_expr_level, sym(CONS), cons_expr_level) { $1 }
add_expr_level: add_expr_level:
reg(plus_expr) { EArith (Add $1) } reg(plus_expr) { EArith (Add $1) }
@ -486,7 +489,7 @@ not_expr:
un_op(kwd(Not), core_expr) { $1 } un_op(kwd(Not), core_expr) { $1 }
call_expr_level: call_expr_level:
reg(call_expr) { Call $1 } reg(call_expr) { ECall $1 }
| core_expr { $1 } | core_expr { $1 }
call_expr: call_expr:
@ -498,13 +501,13 @@ core_expr:
| reg(Nat) { EArith (Nat $1) } | reg(Nat) { EArith (Nat $1) }
| reg(path) { Path $1 } | reg(path) { Path $1 }
| string { EString (String $1) } | string { EString (String $1) }
| unit { Unit $1 } | unit { EUnit $1 }
| kwd(False) { ELogic (BoolExpr (False $1)) } | kwd(False) { ELogic (BoolExpr (False $1)) }
| kwd(True) { ELogic (BoolExpr ( True $1)) } | kwd(True) { ELogic (BoolExpr ( True $1)) }
| list_of(expr) { EList $1 } | reg(list_of(expr)) { EList (List $1) }
| reg(par(expr)) { Par $1 } | reg(par(expr)) { EPar $1 }
| constr { EConstr $1 } | constr { EConstr $1 }
| reg(sequence) { Seq $1 } | reg(sequence) { ESeq $1 }
| reg(record_expr) { ERecord $1 } | reg(record_expr) { ERecord $1 }
path: path:

View File

@ -13,8 +13,8 @@ type t =
| TIMES | TIMES
| LPAR | LPAR
| RPAR | RPAR
| LBRACK | LBRACKET
| RBRACK | RBRACKET
| LBRACE | LBRACE
| RBRACE | RBRACE
| COMMA | COMMA
@ -91,8 +91,8 @@ let to_string = function
| TIMES -> "*" | TIMES -> "*"
| LPAR -> "(" | LPAR -> "("
| RPAR -> ")" | RPAR -> ")"
| LBRACK -> "[" | LBRACKET -> "["
| RBRACK -> "]" | RBRACKET -> "]"
| LBRACE -> "{" | LBRACE -> "{"
| RBRACE -> "}" | RBRACE -> "}"
| COMMA -> "," | COMMA -> ","

View File

@ -19,8 +19,8 @@ type t =
| LPAR (* "(" *) | LPAR (* "(" *)
| RPAR (* ")" *) | RPAR (* ")" *)
| LBRACK (* "[" *) | LBRACKET (* "[" *)
| RBRACK (* "]" *) | RBRACKET (* "]" *)
| LBRACE (* "{" *) | LBRACE (* "{" *)
| RBRACE (* "}" *) | RBRACE (* "}" *)

View File

@ -199,7 +199,7 @@ and type_expr =
and cartesian = (type_expr, times) nsepseq reg and cartesian = (type_expr, times) nsepseq reg
and variant = { and variant = { (* TODO: Constant constructors *)
constr : constr; constr : constr;
kwd_of : kwd_of; kwd_of : kwd_of;
product : cartesian product : cartesian

View File

@ -1,2 +1,3 @@
module Pascaligo = Pascaligo module Pascaligo = Pascaligo
module Camligo = Camligo module Camligo = Camligo
module Ligodity = Ligodity