balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Storage and operations are now explicitly named.

Browse Source 
Refactoring of AST to enable the detection of incomplete pattern
matchings by the OCaml compiler. Some record fields renamed for
better readability.
This commit is contained in:
Christian Rinderknecht 2019-03-10 19:41:27 +01:00
parent 7dcad4779e
commit 8746802571
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
8 changed files with 427 additions and 358 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

411
AST.ml
View File

@ -154,14 +154,28 @@ type t = {
and ast = t
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
const_type : type_expr;
equal : equal;
init : expr;
terminator : semi option
}
and storage_decl = {
kwd_storage : kwd_storage;
name : variable;
colon : colon;
store_type : type_expr;
terminator : semi option
}
and operations_decl = {
kwd_operations : kwd_operations;
name : variable;
colon : colon;
op_type : type_expr;
terminator : semi option
}
@ -259,21 +273,11 @@ and local_decl =
| LocalConst of const_decl reg
| LocalVar of var_decl reg
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
vtype : type_expr;
equal : equal;
init : expr;
terminator : semi option
}
and var_decl = {
kwd_var : kwd_var;
name : variable;
colon : colon;
vtype : type_expr;
var_type : type_expr;
ass : ass;
init : expr;
terminator : semi option
@ -436,12 +440,12 @@ and list_pattern =
open! Region
let type_expr_to_region = function
Prod node -> node.region
| Sum node -> node.region
| Record node -> node.region
| TypeApp node -> node.region
| ParType node -> node.region
| TAlias node -> node.region
Prod {region; _}
| Sum {region; _}
| Record {region; _}
| TypeApp {region; _}
| ParType {region; _}
| TAlias {region; _} -> region
let expr_to_region = function
Or {region; _}
@ -562,29 +566,53 @@ let print_int {region; value = lexeme, abstract} =
(* Main printing function *)
let rec print_tokens ast =
List.iter print_type_decl ast.types;
print_storage_decl ast.storage;
print_operations_decl ast.operations;
List.iter print_lambda_decl ast.lambdas;
print_block ast.block;
print_token ast.eof "EOF"
let {types; constants; storage; operations;
lambdas; block; eof} = ast in
List.iter print_type_decl types;
List.iter print_const_decl constants;
print_storage_decl storage;
print_operations_decl operations;
List.iter print_lambda_decl lambdas;
print_block block;
print_token eof "EOF"
and print_storage_decl {value=node; _} =
print_token node.kwd_storage "storage";
print_type_expr node.store_type;
print_terminator node.terminator
and print_const_decl {value; _} =
let {kwd_const; name; colon; const_type;
equal; init; terminator} = value in
print_token kwd_const "const";
print_var name;
print_token colon ":";
print_type_expr const_type;
print_token equal "=";
print_expr init;
print_terminator terminator
and print_operations_decl {value=node; _} =
print_token node.kwd_operations "operations";
print_type_expr node.op_type;
print_terminator node.terminator
and print_storage_decl {value; _} =
let {kwd_storage; name; colon;
store_type; terminator} = value in
print_token kwd_storage "storage";
print_var name;
print_token colon ":";
print_type_expr store_type;
print_terminator terminator
and print_type_decl {value=node; _} =
print_token node.kwd_type "type";
print_var node.name;
print_token node.kwd_is "is";
print_type_expr node.type_expr;
print_terminator node.terminator
and print_operations_decl {value; _} =
let {kwd_operations; name; colon;
op_type; terminator} = value in
print_token kwd_operations "operations";
print_var name;
print_token colon ":";
print_type_expr op_type;
print_terminator terminator
and print_type_decl {value; _} =
let {kwd_type; name; kwd_is;
type_expr; terminator} = value in
print_token kwd_type "type";
print_var name;
print_token kwd_is "is";
print_type_expr type_expr;
print_terminator terminator
and print_type_expr = function
Prod cartesian -> print_cartesian cartesian
@ -594,31 +622,31 @@ and print_type_expr = function
| ParType par_type -> print_par_type par_type
| TAlias type_alias -> print_var type_alias
and print_cartesian {value=sequence; _} =
print_nsepseq "*" print_type_expr sequence
and print_cartesian {value; _} =
print_nsepseq "*" print_type_expr value
and print_variant {value=node; _} =
let constr, kwd_of, cartesian = node in
and print_variant {value; _} =
let constr, kwd_of, cartesian = value in
print_constr constr;
print_token kwd_of "of";
print_cartesian cartesian
and print_sum_type {value=sequence; _} =
print_nsepseq "|" print_variant sequence
and print_sum_type {value; _} =
print_nsepseq "|" print_variant value
and print_record_type {value=node; _} =
let kwd_record, field_decls, kwd_end = node in
and print_record_type {value; _} =
let kwd_record, field_decls, kwd_end = value in
print_token kwd_record "record";
print_field_decls field_decls;
print_token kwd_end "end"
and print_type_app {value=node; _} =
let type_name, type_tuple = node in
and print_type_app {value; _} =
let type_name, type_tuple = value in
print_var type_name;
print_type_tuple type_tuple
and print_par_type {value=node; _} =
let lpar, type_expr, rpar = node in
and print_par_type {value; _} =
let lpar, type_expr, rpar = value in
print_token lpar "(";
print_type_expr type_expr;
print_token rpar ")"
@ -626,14 +654,14 @@ and print_par_type {value=node; _} =
and print_field_decls sequence =
print_nsepseq ";" print_field_decl sequence
and print_field_decl {value=node; _} =
let var, colon, type_expr = node in
and print_field_decl {value; _} =
let var, colon, type_expr = value in
print_var var;
print_token colon ":";
print_type_expr type_expr
and print_type_tuple {value=node; _} =
let lpar, sequence, rpar = node in
and print_type_tuple {value; _} =
let lpar, sequence, rpar = value in
print_token lpar "(";
print_nsepseq "," print_var sequence;
print_token rpar ")"
@ -643,39 +671,46 @@ and print_lambda_decl = function
| ProcDecl proc_decl -> print_proc_decl proc_decl
| EntryDecl entry_decl -> print_entry_decl entry_decl
and print_fun_decl {value=node; _} =
print_token node.kwd_function "function";
print_var node.name;
print_parameters node.param;
print_token node.colon ":";
print_type_expr node.ret_type;
print_token node.kwd_is "is";
print_local_decls node.local_decls;
print_block node.block;
print_token node.kwd_with "with";
print_expr node.return;
print_terminator node.terminator
and print_fun_decl {value; _} =
let {kwd_function; name; param; colon;
ret_type; kwd_is; local_decls;
block; kwd_with; return; terminator} = value in
print_token kwd_function "function";
print_var name;
print_parameters param;
print_token colon ":";
print_type_expr ret_type;
print_token kwd_is "is";
print_local_decls local_decls;
print_block block;
print_token kwd_with "with";
print_expr return;
print_terminator terminator
and print_proc_decl {value=node; _} =
print_token node.kwd_procedure "procedure";
print_var node.name;
print_parameters node.param;
print_token node.kwd_is "is";
print_local_decls node.local_decls;
print_block node.block;
print_terminator node.terminator
and print_proc_decl {value; _} =
let {kwd_procedure; name; param; kwd_is;
local_decls; block; terminator} = value in
print_token kwd_procedure "procedure";
print_var name;
print_parameters param;
print_token kwd_is "is";
print_local_decls local_decls;
print_block block;
print_terminator terminator
and print_entry_decl {value=node; _} =
print_token node.kwd_entrypoint "entrypoint";
print_var node.name;
print_parameters node.param;
print_token node.kwd_is "is";
print_local_decls node.local_decls;
print_block node.block;
print_terminator node.terminator
and print_entry_decl {value; _} =
let {kwd_entrypoint; name; param; kwd_is;
local_decls; block; terminator} = value in
print_token kwd_entrypoint "entrypoint";
print_var name;
print_parameters param;
print_token kwd_is "is";
print_local_decls local_decls;
print_block block;
print_terminator terminator
and print_parameters {value=node; _} =
let lpar, sequence, rpar = node in
and print_parameters {value; _} =
let lpar, sequence, rpar = value in
print_token lpar "(";
print_nsepseq ";" print_param_decl sequence;
print_token rpar ")"
@ -684,25 +719,26 @@ and print_param_decl = function
ParamConst param_const -> print_param_const param_const
| ParamVar param_var -> print_param_var param_var
and print_param_const {value=node; _} =
let kwd_const, variable, colon, type_expr = node in
and print_param_const {value; _} =
let kwd_const, variable, colon, type_expr = value in
print_token kwd_const "const";
print_var variable;
print_token colon ":";
print_type_expr type_expr
and print_param_var {value=node; _} =
let kwd_var, variable, colon, type_expr = node in
and print_param_var {value; _} =
let kwd_var, variable, colon, type_expr = value in
print_token kwd_var "var";
print_var variable;
print_token colon ":";
print_type_expr type_expr
and print_block {value=node; _} =
print_token node.opening "begin";
print_instructions node.instr;
print_terminator node.terminator;
print_token node.close "end"
and print_block {value; _} =
let {opening; instr; terminator; close} = value in
print_token opening "begin";
print_instructions instr;
print_terminator terminator;
print_token close "end"
and print_local_decls sequence =
List.iter print_local_decl sequence
@ -712,26 +748,19 @@ and print_local_decl = function
| LocalConst decl -> print_const_decl decl
| LocalVar decl -> print_var_decl decl
and print_const_decl {value=node; _} =
print_token node.kwd_const "const";
print_var node.name;
print_token node.colon ":";
print_type_expr node.vtype;
print_token node.equal "=";
print_expr node.init;
print_terminator node.terminator
and print_var_decl {value; _} =
let {kwd_var; name; colon; var_type;
ass; init; terminator} = value in
print_token kwd_var "var";
print_var name;
print_token colon ":";
print_type_expr var_type;
print_token ass ":=";
print_expr init;
print_terminator terminator
and print_var_decl {value=node; _} =
print_token node.kwd_var "var";
print_var node.name;
print_token node.colon ":";
print_type_expr node.vtype;
print_token node.ass ":=";
print_expr node.init;
print_terminator node.terminator
and print_instructions {value=sequence; _} =
print_nsepseq ";" print_instruction sequence
and print_instructions {value; _} =
print_nsepseq ";" print_instruction value
and print_instruction = function
Single instr -> print_single_instr instr
@ -751,31 +780,40 @@ and print_fail (kwd_fail, expr) =
print_expr expr
and print_conditional node =
print_token node.kwd_if "if";
print_expr node.test;
print_token node.kwd_then "then";
print_instruction node.ifso;
print_token node.kwd_else "else";
print_instruction node.ifnot
let {kwd_if; test; kwd_then; ifso;
kwd_else; ifnot} = node in
print_token kwd_if "if";
print_expr test;
print_token kwd_then "then";
print_instruction ifso;
print_token kwd_else "else";
print_instruction ifnot
and print_match_instr node =
print_token node.kwd_match "match";
print_expr node.expr;
print_token node.kwd_with "with";
print_cases node.cases;
print_token node.kwd_end "end"
let {kwd_match; expr; kwd_with;
lead_vbar; cases; kwd_end} = node in
print_token kwd_match "match";
print_expr expr;
print_token kwd_with "with";
print_token_opt lead_vbar "|";
print_cases cases;
print_token kwd_end "end"
and print_cases {value=sequence; _} =
print_nsepseq "|" print_case sequence
and print_token_opt = function
None -> fun _ -> ()
| Some region -> print_token region
and print_case {value=node; _} =
let pattern, arrow, instruction = node in
and print_cases {value; _} =
print_nsepseq "|" print_case value
and print_case {value; _} =
let pattern, arrow, instruction = value in
print_pattern pattern;
print_token arrow "->";
print_instruction instruction
and print_ass_instr {value=node; _} =
let variable, ass, expr = node in
and print_ass_instr {value; _} =
let variable, ass, expr = value in
print_var variable;
print_token ass ":=";
print_expr expr
@ -784,8 +822,8 @@ and print_loop = function
While while_loop -> print_while_loop while_loop
| For for_loop -> print_for_loop for_loop
and print_while_loop {value=node; _} =
let kwd_while, expr, block = node in
and print_while_loop {value; _} =
let kwd_while, expr, block = value in
print_token kwd_while "while";
print_expr expr;
print_block block
@ -794,14 +832,16 @@ and print_for_loop = function
ForInt for_int -> print_for_int for_int
| ForCollect for_collect -> print_for_collect for_collect
and print_for_int ({value=node; _} : for_int reg) =
print_token node.kwd_for "for";
print_ass_instr node.ass;
print_down node.down;
print_token node.kwd_to "to";
print_expr node.bound;
print_step node.step;
print_block node.block
and print_for_int ({value; _} : for_int reg) =
let {kwd_for; ass; down; kwd_to;
bound; step; block} = value in
print_token kwd_for "for";
print_ass_instr ass;
print_down down;
print_token kwd_to "to";
print_expr bound;
print_step step;
print_block block
and print_down = function
Some kwd_down -> print_token kwd_down "down"
@ -813,13 +853,15 @@ and print_step = function
print_expr expr
| None -> ()
and print_for_collect ({value=node; _} : for_collect reg) =
print_token node.kwd_for "for";
print_var node.var;
print_bind_to node.bind_to;
print_token node.kwd_in "in";
print_expr node.expr;
print_block node.block
and print_for_collect ({value; _} : for_collect reg) =
let {kwd_for; var; bind_to;
kwd_in; expr; block} = value in
print_token kwd_for "for";
print_var var;
print_bind_to bind_to;
print_token kwd_in "in";
print_expr expr;
print_block block
and print_bind_to = function
Some (arrow, variable) ->
@ -847,7 +889,7 @@ and print_expr = function
| Cat {value = expr1, cat, expr2; _} ->
print_expr expr1; print_token cat "^"; print_expr expr2
| Cons {value = expr1, cons, expr2; _} ->
print_expr expr1; print_token cons "<:"; print_expr expr2
print_expr expr1; print_token cons "#"; print_expr expr2
| Add {value = expr1, add, expr2; _} ->
print_expr expr1; print_token add "+"; print_expr expr2
| Sub {value = expr1, sub, expr2; _} ->
@ -881,20 +923,21 @@ and print_expr = function
| MapLookUp lookup -> print_map_lookup lookup
| ParExpr pexpr -> print_par_expr pexpr
and print_tuple {value=node; _} =
let lpar, sequence, rpar = node in
and print_tuple {value; _} =
let lpar, sequence, rpar = value in
print_token lpar "(";
print_nsepseq "," print_expr sequence;
print_token rpar ")"
and print_list {value=node; _} =
let lbra, sequence, rbra = node in
and print_list {value; _} =
let lbra, sequence, rbra = value in
print_token lbra "[";
print_nsepseq "," print_expr sequence;
print_token rbra "]"
and print_empty_list {value=node; _} =
let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in
and print_empty_list {value; _} =
let lpar, (lbracket, rbracket, colon, type_expr),
rpar = value in
print_token lpar "(";
print_token lbracket "[";
print_token rbracket "]";
@ -902,14 +945,15 @@ and print_empty_list {value=node; _} =
print_type_expr type_expr;
print_token rpar ")"
and print_set {value=node; _} =
let lbrace, sequence, rbrace = node in
and print_set {value; _} =
let lbrace, sequence, rbrace = value in
print_token lbrace "{";
print_nsepseq "," print_expr sequence;
print_token rbrace "}"
and print_empty_set {value=node; _} =
let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in
and print_empty_set {value; _} =
let lpar, (lbrace, rbrace, colon, type_expr),
rpar = value in
print_token lpar "(";
print_token lbrace "{";
print_token rbrace "}";
@ -917,45 +961,46 @@ and print_empty_set {value=node; _} =
print_type_expr type_expr;
print_token rpar ")"
and print_none_expr {value=node; _} =
let lpar, (c_None, colon, type_expr), rpar = node in
and print_none_expr {value; _} =
let lpar, (c_None, colon, type_expr), rpar = value in
print_token lpar "(";
print_token c_None "None";
print_token colon ":";
print_type_expr type_expr;
print_token rpar ")"
and print_fun_call {value=node; _} =
let fun_name, arguments = node in
and print_fun_call {value; _} =
let fun_name, arguments = value in
print_var fun_name;
print_tuple arguments
and print_constr_app {value=node; _} =
let constr, arguments = node in
and print_constr_app {value; _} =
let constr, arguments = value in
print_constr constr;
print_tuple arguments
and print_some_app {value=node; _} =
let c_Some, arguments = node in
and print_some_app {value; _} =
let c_Some, arguments = value in
print_token c_Some "Some";
print_tuple arguments
and print_map_lookup {value=node; _} =
let {value = lbracket, expr, rbracket; _} = node.index in
print_var node.map_name;
print_token node.selector ".";
and print_map_lookup {value; _} =
let {map_name; selector; index} = value in
let {value = lbracket, expr, rbracket; _} = index in
print_var map_name;
print_token selector ".";
print_token lbracket "[";
print_expr expr;
print_token rbracket "]"
and print_par_expr {value=node; _} =
let lpar, expr, rpar = node in
and print_par_expr {value; _} =
let lpar, expr, rpar = value in
print_token lpar "(";
print_expr expr;
print_token rpar ")"
and print_pattern {value=sequence; _} =
print_nsepseq "<:" print_core_pattern sequence
and print_pattern {value; _} =
print_nsepseq "#" print_core_pattern value
and print_core_pattern = function
PVar var -> print_var var
@ -971,13 +1016,13 @@ and print_core_pattern = function
| PList pattern -> print_list_pattern pattern
| PTuple ptuple -> print_ptuple ptuple
and print_psome {value=node; _} =
let c_Some, patterns = node in
and print_psome {value; _} =
let c_Some, patterns = value in
print_token c_Some "Some";
print_patterns patterns
and print_patterns {value=node; _} =
let lpar, core_pattern, rpar = node in
and print_patterns {value; _} =
let lpar, core_pattern, rpar = value in
print_token lpar "(";
print_core_pattern core_pattern;
print_token rpar ")"
@ -986,22 +1031,22 @@ and print_list_pattern = function
Sugar sugar -> print_sugar sugar
| Raw raw -> print_raw raw
and print_sugar {value=node; _} =
let lbracket, sequence, rbracket = node in
and print_sugar {value; _} =
let lbracket, sequence, rbracket = value in
print_token lbracket "[";
print_sepseq "," print_core_pattern sequence;
print_token rbracket "]"
and print_raw {value=node; _} =
let lpar, (core_pattern, cons, pattern), rpar = node in
and print_raw {value; _} =
let lpar, (core_pattern, cons, pattern), rpar = value in
print_token lpar "(";
print_core_pattern core_pattern;
print_token cons "<:";
print_token cons "#";
print_pattern pattern;
print_token rpar ")"
and print_ptuple {value=node; _} =
let lpar, sequence, rpar = node in
and print_ptuple {value; _} =
let lpar, sequence, rpar = value in
print_token lpar "(";
print_nsepseq "," print_core_pattern sequence;
print_token rpar ")"

26
AST.mli
View File

@ -138,14 +138,28 @@ type t = {
and ast = t
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
const_type : type_expr;
equal : equal;
init : expr;
terminator : semi option
}
and storage_decl = {
kwd_storage : kwd_storage;
name : variable;
colon : colon;
store_type : type_expr;
terminator : semi option
}
and operations_decl = {
kwd_operations : kwd_operations;
name : variable;
colon : colon;
op_type : type_expr;
terminator : semi option
}
@ -243,21 +257,11 @@ and local_decl =
| LocalConst of const_decl reg
| LocalVar of var_decl reg
and const_decl = {
kwd_const : kwd_const;
name : variable;
colon : colon;
vtype : type_expr;
equal : equal;
init : expr;
terminator : semi option
}
and var_decl = {
kwd_var : kwd_var;
name : variable;
colon : colon;
vtype : type_expr;
var_type : type_expr;
ass : ass;
init : expr;
terminator : semi option

240
AST2.ml
View File

@ -2,59 +2,74 @@
exception TODO of string
module I = AST
open Region
module SMap = Map.Make(String)
module In = AST
module O = struct
module SMap = Utils.String.Map
module Out =
struct
type type_name = string
type var_name = string
type variable = string
type ast = {
types : type_decl list;
storage : typed_var;
operations : typed_var;
declarations : decl list;
prev : I.ast;
prev : In.t;
}
and typed_var = { name:var_name; ty:type_expr }
and type_decl = { name:string; ty:type_expr }
and decl = { name:var_name; ty:type_expr; value: expr }
and typed_var = {name: variable; ty: type_expr}
and type_decl = {name: variable; ty: type_expr}
and decl = {name: variable; ty: type_expr; value: expr}
and type_expr =
Prod of type_expr list
| Sum of (type_name * type_expr) list
| Record of (type_name * type_expr) list
| TypeApp of type_name * type_expr list
| Function of { args: type_expr list; ret: type_expr }
| Function of {args: type_expr list; ret: type_expr}
| Ref of type_expr
| Unit
| Int
| TODO
and expr =
App of { operator: operator; arguments: expr list }
| Variable of var_name
App of {operator: operator; arguments: expr list}
| Variable of variable
| Constant of constant
| Lambda of {
parameters: type_expr SMap.t;
declarations: decl list;
instructions: instr list;
result: expr;
| Lambda of lambda
and lambda = {
parameters : type_expr SMap.t;
declarations : decl list;
instructions : instr list;
result : expr
}
and operator = Add | Sub | Lt | Gt | Function of string
and constant =
Unit
| Int of int
| Int of Z.t
and instr =
| Assignment of { name: var_name; value: expr }
Assignment of { name: variable; value: expr }
| While of { condition: expr; body: instr list }
| ForCollection of { list: expr; key: var_name; value: var_name option; body: instr list }
| ForCollection of { list: expr; key: variable;
value: variable option;
body: instr list }
| If of { condition: expr; ifso: instr list; ifnot: instr list }
| Match of { expr: expr; cases: (pattern * instr list) list }
| DropUnit of expr (* expr returns unit, drop the result. *)
| Fail of { expr: expr }
| Null
and pattern =
PVar of var_name
PVar of variable
| PWild
| PInt of Z.t
| PBytes of MBytes.t
@ -65,20 +80,20 @@ module O = struct
| PNone
| PSome of pattern
| Cons of pattern * pattern
| Null
| PTuple of pattern list
end
end
(* open Sanity: *)
let (|>) v f = f v (* pipe f to v *)
let (@@) f v = f v (* apply f on v *)
let (@.) f g x = f (g x) (* compose *)
let map f l = List.rev (List.rev_map f l)
(* TODO: check that List.to_seq, List.append and SMap.of_seq are not broken
let map f l = List.(rev_map f l |> rev)
(* TODO: check that List.to_seq, SMap.of_seq are not broken
(i.e. check that they are tail-recursive) *)
let append_map f l = map f l |> List.flatten
let append l1 l2 = List.append l1 l2
let list_to_map l = l |> List.to_seq |> SMap.of_seq
let append l = List.(rev l |> rev_append)
let list_to_map l = l |> List.to_seq |> SMap.of_seq (* Why lazy ? *)
let fold_map f a l =
let f (acc, l) elem =
let acc', elem' = f acc elem
@ -96,40 +111,39 @@ let s_sepseq : ('a,'sep) Utils.sepseq -> 'a list =
None -> []
| Some nsepseq -> s_nsepseq nsepseq
let s_name {value=name; region} : O.var_name =
let () = ignore (region) in
name
let s_name ({value=name; region}: string reg) =
ignore region; name
let rec s_cartesian {value=sequence; region} : O.type_expr =
let () = ignore (region) in
let rec s_cartesian {value=sequence; region} : Out.type_expr =
let () = ignore region in
Prod (map s_type_expr (s_nsepseq sequence))
and s_sum_type {value=sequence; region} : O.type_expr =
let () = ignore (region) in
and s_sum_type {value=sequence; region} : Out.type_expr =
let () = ignore region in
let _todo = sequence in
(* Sum (map s_type_expr (s_nsepseq sequence)) *)
TODO
and s_record_type {value=(kwd_record, field_decls, kwd_end); region} : O.type_expr =
and s_record_type {value=(kwd_record, field_decls, kwd_end); region} : Out.type_expr =
let () = ignore (kwd_record,region,kwd_end) in
let _todo = (* s_field_decls *) field_decls in
TODO
and s_type_app {value=node; region} : O.type_expr =
let () = ignore (region) in
and s_type_app {value=node; region} : Out.type_expr =
let () = ignore region in
let _todo = node in
TODO
(* let type_name, type_tuple = node in *)
(* s_var type_name; *)
(* s_type_tuple type_tuple *)
and s_par_type {value=node; region} : O.type_expr =
let () = ignore (region) in
and s_par_type {value=node; region} : Out.type_expr =
let () = ignore region in
let _todo = node in
TODO
and s_var {region; value=lexeme} : O.type_expr =
let () = ignore (region) in
and s_var {region; value=lexeme} : Out.type_expr =
let () = ignore region in
let _todo = lexeme in
TODO
@ -138,7 +152,7 @@ and s_var {region; value=lexeme} : O.type_expr =
s_type_expr type_expr;
s_token rpar ")"*)
and s_type_expr : I.type_expr -> O.type_expr = function
and s_type_expr : In.type_expr -> Out.type_expr = function
Prod cartesian -> s_cartesian cartesian
| Sum sum_type -> s_sum_type sum_type
| Record record_type -> s_record_type record_type
@ -147,93 +161,97 @@ and s_type_expr : I.type_expr -> O.type_expr = function
| TAlias type_alias -> s_var type_alias
let s_type_decl I.{value={kwd_type;name;kwd_is;type_expr;terminator}; region} : O.type_decl =
let s_type_decl In.{value={kwd_type;name;kwd_is;type_expr;terminator}; region} : Out.type_decl =
let () = ignore (kwd_type,kwd_is,terminator,region) in
O.{ name = s_name name; ty = s_type_expr type_expr }
Out.{ name = s_name name; ty = s_type_expr type_expr }
let s_storage_decl I.{value={kwd_storage; store_type; terminator}; region} : O.typed_var =
let s_storage_decl In.{value={kwd_storage; store_type; terminator}; region} : Out.typed_var =
let () = ignore (kwd_storage,terminator,region) in
O.{ name = "storage"; ty = s_type_expr store_type }
Out.{ name = "storage"; ty = s_type_expr store_type }
let s_operations_decl I.{value={kwd_operations;op_type;terminator}; region} : O.typed_var =
let s_operations_decl In.{value={kwd_operations;op_type;terminator}; region} : Out.typed_var =
let () = ignore (kwd_operations,terminator,region) in
O.{ name = "operations"; ty = s_type_expr op_type }
Out.{ name = "operations"; ty = s_type_expr op_type }
let s_expr : I.expr -> O.expr = function
let s_expr : In.expr -> Out.expr = function
| _ -> raise (TODO "simplify expressions")
let s_case : I.case -> O.pattern * (O.instr list) = function
let s_case : In.case -> Out.pattern * (Out.instr list) = function
| _ -> raise (TODO "simplify pattern matching cases")
let s_const_decl I.{value={kwd_const;name;colon;vtype;equal;init;terminator}; region} : O.decl =
let s_const_decl In.{value; region} : Out.decl =
let In.{kwd_const; name; colon;
const_type; equal; init; terminator} = value in
let () = ignore (kwd_const,colon,equal,terminator,region) in
O.{ name = s_name name; ty = s_type_expr vtype; value = s_expr init }
Out.{name = s_name name;
ty = s_type_expr const_type;
value = s_expr init}
let s_param_const {value=(kwd_const,variable,colon,type_expr); region} : string * O.type_expr =
let s_param_const {value=(kwd_const,variable,colon,type_expr); region} : string * Out.type_expr =
let () = ignore (kwd_const,colon,region) in
s_name variable, s_type_expr type_expr
let s_param_var {value=(kwd_var,variable,colon,type_expr); region} : string * O.type_expr =
let s_param_var {value=(kwd_var,variable,colon,type_expr); region} : string * Out.type_expr =
let () = ignore (kwd_var,colon,region) in
s_name variable, s_type_expr type_expr
let s_param_decl : I.param_decl -> string * O.type_expr = function
let s_param_decl : In.param_decl -> string * Out.type_expr = function
ParamConst p -> s_param_const p
| ParamVar p -> s_param_var p
let s_parameters ({value=(lpar,param_decl,rpar);region} : I.parameters) : (string * O.type_expr) list =
let s_parameters ({value=(lpar,param_decl,rpar);region} : In.parameters) : (string * Out.type_expr) list =
let () = ignore (lpar,rpar,region) in
let l = (s_nsepseq param_decl) in
map s_param_decl l
let rec s_var_decl I.{value={kwd_var;name;colon;vtype;ass;init;terminator}; region} : O.decl =
let () = ignore (kwd_var,colon,ass,terminator,region) in
O.{
name = s_name name;
ty = s_type_expr vtype;
value = s_expr init
}
let rec s_var_decl {value; region} : Out.decl =
let In.{kwd_var; name; colon;
var_type; ass; init; terminator} = value in
let () = ignore (kwd_var, colon, ass, terminator, region) in
Out.{name = s_name name;
ty = s_type_expr var_type;
value = s_expr init}
and s_local_decl : I.local_decl -> O.decl = function
and s_local_decl : In.local_decl -> Out.decl = function
LocalLam decl -> s_lambda_decl decl
| LocalConst decl -> s_const_decl decl
| LocalVar decl -> s_var_decl decl
and s_instructions ({value=sequence; region} : I.instructions) : O.instr list =
let () = ignore (region) in
and s_instructions ({value=sequence; region} : In.instructions) : Out.instr list =
let () = ignore region in
append_map s_instruction (s_nsepseq sequence)
and s_instruction : I.instruction -> O.instr list = function
and s_instruction : In.instruction -> Out.instr list = function
Single instr -> s_single_instr instr
| Block block -> (s_block block)
and s_conditional I.{kwd_if;test;kwd_then;ifso;kwd_else;ifnot} : O.instr =
and s_conditional In.{kwd_if;test;kwd_then;ifso;kwd_else;ifnot} : Out.instr =
let () = ignore (kwd_if,kwd_then,kwd_else) in
If { condition = s_expr test; ifso = s_instruction ifso; ifnot = s_instruction ifnot }
and s_match_instr I.{kwd_match;expr;kwd_with;lead_vbar;cases;kwd_end} : O.instr =
and s_match_instr In.{kwd_match;expr;kwd_with;lead_vbar;cases;kwd_end} : Out.instr =
let {value=cases;region} = cases in
let () = ignore (kwd_match,kwd_with,lead_vbar,kwd_end,region) in
Match { expr = s_expr expr; cases = map s_case (s_nsepseq cases) }
and s_ass_instr {value=(variable,ass,expr); region} : O.instr =
and s_ass_instr {value=(variable,ass,expr); region} : Out.instr =
let () = ignore (ass,region) in
Assignment { name = s_name variable; value = s_expr expr }
and s_while_loop {value=(kwd_while, expr, block); region} : O.instr list =
and s_while_loop {value=(kwd_while, expr, block); region} : Out.instr list =
let () = ignore (kwd_while,region) in
[While {condition = s_expr expr; body = s_block block}]
and s_for_loop : I.for_loop -> O.instr list = function
and s_for_loop : In.for_loop -> Out.instr list = function
ForInt for_int -> s_for_int for_int
| ForCollect for_collect -> s_for_collect for_collect
and s_for_int ({value={kwd_for;ass;down;kwd_to;bound;step;block}; region} : I.for_int reg) : O.instr list =
and s_for_int ({value={kwd_for;ass;down;kwd_to;bound;step;block}; region} : In.for_int reg) : Out.instr list =
let {value=(variable,ass_kwd,expr);region = ass_region} = ass in
let () = ignore (kwd_for,ass_region,ass_kwd,kwd_to,region) in
let name = s_name variable in
let condition, operator = match down with Some kwd_down -> ignore kwd_down; O.Gt, O.Sub
| None -> O.Lt, O.Add in
let condition, operator = match down with Some kwd_down -> ignore kwd_down; Out.Gt, Out.Sub
| None -> Out.Lt, Out.Add in
let step = s_step step
in [
Assignment { name; value = s_expr expr };
@ -241,17 +259,17 @@ and s_for_int ({value={kwd_for;ass;down;kwd_to;bound;step;block}; region} : I.fo
While {
condition = App { operator = condition;
arguments = [Variable name; s_expr bound] };
body = append (s_block block)
[O.Assignment { name;
body = List.append (s_block block)
[Out.Assignment { name;
value = App { operator;
arguments = [Variable name; step]}}]
}
]
and s_for_collect ({value={kwd_for;var;bind_to;kwd_in;expr;block}; _} : I.for_collect reg) : O.instr list =
and s_for_collect ({value={kwd_for;var;bind_to;kwd_in;expr;block}; _} : In.for_collect reg) : Out.instr list =
let () = ignore (kwd_for,kwd_in) in
[
O.ForCollection {
Out.ForCollection {
list = s_expr expr;
key = s_name var;
value = s_bind_to bind_to;
@ -259,34 +277,31 @@ and s_for_collect ({value={kwd_for;var;bind_to;kwd_in;expr;block}; _} : I.for_co
}
]
and s_step : (I.kwd_step * I.expr) option -> O.expr = function
and s_step : (In.kwd_step * In.expr) option -> Out.expr = function
Some (kwd_step, expr) -> let () = ignore (kwd_step) in s_expr expr
| None -> Constant (Int 1)
| None -> Constant (Int Z.one)
and s_bind_to : (I.arrow * I.variable) option -> O.var_name option = function
Some (arrow, variable) -> let () = ignore (arrow) in Some (s_name variable)
| None -> None
and s_bind_to : (In.arrow * In.variable) option -> Out.variable option = function
Some (arrow, variable) ->
let () = ignore arrow in Some (s_name variable)
| None -> None
and s_loop : I.loop -> O.instr list = function
and s_loop : In.loop -> Out.instr list = function
While while_loop -> s_while_loop while_loop
| For for_loop -> s_for_loop for_loop
and s_fun_call {value=(fun_name, arguments); region} : O.expr =
let () = ignore (region) in
and s_fun_call {value=(fun_name, arguments); region} : Out.expr =
let () = ignore region in
App { operator = Function (s_name fun_name); arguments = s_arguments arguments }
and s_arguments {value=(lpar, sequence, rpar); region} =
let () = ignore (lpar,rpar,region) in
let () = ignore (lpar, rpar, region) in
map s_expr (s_nsepseq sequence);
and s_fail ((kwd_fail, expr) : (I.kwd_fail * I.expr)) : O.instr =
let () = ignore (kwd_fail) in
Fail { expr = s_expr expr }
and s_fail ((kwd_fail, expr) : (In.kwd_fail * In.expr)) : Out.instr =
ignore kwd_fail; Fail {expr = s_expr expr}
and s_single_instr : I.single_instr -> O.instr list = function
and s_single_instr : In.single_instr -> Out.instr list = function
Cond {value; _} -> [s_conditional value]
| Match {value; _} -> [s_match_instr value]
| Ass instr -> [s_ass_instr instr]
@ -296,13 +311,13 @@ and s_single_instr : I.single_instr -> O.instr list = function
[]
| Fail {value; _} -> [s_fail value]
and s_block I.{value={opening;instr;terminator;close}; _} : O.instr list =
and s_block In.{value={opening;instr;terminator;close}; _} : Out.instr list =
let () = ignore (opening,terminator,close) in
s_instructions instr
and s_fun_decl I.{value={kwd_function;name;param;colon;ret_type;kwd_is;local_decls;block;kwd_with;return;terminator}; region} : O.decl =
and s_fun_decl In.{value={kwd_function;name;param;colon;ret_type;kwd_is;local_decls;block;kwd_with;return;terminator}; region} : Out.decl =
let () = ignore (kwd_function,colon,kwd_is,kwd_with,terminator,region) in
O.{
Out.{
name = s_name name;
ty = Function { args = map snd (s_parameters param); ret = s_type_expr ret_type };
value = Lambda {
@ -313,39 +328,40 @@ and s_fun_decl I.{value={kwd_function;name;param;colon;ret_type;kwd_is;local_dec
}
}
and s_proc_decl I.{value={kwd_procedure;name;param;kwd_is;local_decls;block;terminator}; region} =
and s_proc_decl In.{value={kwd_procedure;name;param;kwd_is;local_decls;block;terminator}; region} =
let () = ignore (kwd_procedure,kwd_is,terminator,region) in
O.{
Out.{
name = s_name name;
ty = Function { args = map snd (s_parameters param); ret = Unit };
value = Lambda {
parameters = s_parameters param |> list_to_map;
declarations = map s_local_decl local_decls;
instructions = s_block block;
result = O.Constant O.Unit
result = Out.Constant Out.Unit
}
}
and s_lambda_decl : I.lambda_decl -> O.decl = function
and s_lambda_decl : In.lambda_decl -> Out.decl = function
FunDecl fun_decl -> s_fun_decl fun_decl
| ProcDecl proc_decl -> s_proc_decl proc_decl
| EntryDecl entry_decl -> failwith "TODO"
let s_main_block (block: I.block reg) : O.decl =
O.{
let s_main_block (block: In.block reg) : Out.decl =
Out.{
name = "main";
ty = Function { args = []; ret = Unit };
value = Lambda {
parameters = SMap.empty;
declarations = [];
instructions = s_block block;
result = O.Constant O.Unit
result = Out.Constant Out.Unit
}
}
let s_ast (ast : I.ast) : O.ast =
let I.{types;constants;storage;operations;lambdas;block;eof} = ast in
let s_ast (ast : In.ast) : Out.ast =
let In.{types;constants;storage;operations;lambdas;block;eof} = ast in
let () = ignore (eof) in
O.{
Out.{
types = map s_type_decl types;
storage = s_storage_decl storage;
operations = s_operations_decl operations;

2
LexToken.mli
View File

@ -44,7 +44,7 @@ type t =
| RBRACE of Region.t (* "}" *)
| LBRACKET of Region.t (* "[" *)
| RBRACKET of Region.t (* "]" *)
| CONS of Region.t (* "<:" *)
| CONS of Region.t (* "#" *)
| VBAR of Region.t (* "|" *)
| ARROW of Region.t (* "->" *)
| ASS of Region.t (* ":=" *)

2
Lexer.mll
View File

@ -443,7 +443,7 @@ let esc = "\\n" | "\\\"" | "\\\\" | "\\b"
| "\\r" | "\\t" | "\\x" byte
let symbol = ';' | ','
| '(' | ')' | '{' | '}' | '[' | ']'
| "#" | '|' | "->" | ":=" | '=' | ':'
| '#' | '|' | "->" | ":=" | '=' | ':'
| "||" | "&&" | '<' | "<=" | '>' | ">=" | "=/="
| '+' | '-' | '*' | '.' | '_' | '^'

2
ParToken.mly
View File

@ -21,7 +21,7 @@
%token <Region.t> RBRACE (* "}" *)
%token <Region.t> LBRACKET (* "[" *)
%token <Region.t> RBRACKET (* "]" *)
%token <Region.t> CONS (* "<:" *)
%token <Region.t> CONS (* "#" *)
%token <Region.t> VBAR (* "|" *)
%token <Region.t> ARROW (* "->" *)
%token <Region.t> ASS (* ":=" *)

28
Parser.mly
View File

@ -108,30 +108,34 @@ program:
}
storage_decl:
Storage type_expr option(SEMI) {
Storage var COLON type_expr option(SEMI) {
let stop =
match $3 with
None -> type_expr_to_region $2
match $5 with
None -> type_expr_to_region $4
| Some region -> region in
let region = cover $1 stop in
let value = {
kwd_storage = $1;
store_type = $2;
terminator = $3}
name = $2;
colon = $3;
store_type = $4;
terminator = $5}
in {region; value}
}
operations_decl:
Operations type_expr option(SEMI) {
Operations var COLON type_expr option(SEMI) {
let stop =
match $3 with
None -> type_expr_to_region $2
match $5 with
None -> type_expr_to_region $4
| Some region -> region in
let region = cover $1 stop in
let value = {
kwd_operations = $1;
op_type = $2;
terminator = $3}
name = $2;
colon = $3;
op_type = $4;
terminator = $5}
in {region; value}
}
@ -347,7 +351,7 @@ const_decl:
kwd_const = $1;
name = $2;
colon = $3;
vtype = $4;
const_type = $4;
equal = $5;
init = $6;
terminator = $7}
@ -365,7 +369,7 @@ var_decl:
kwd_var = $1;
name = $2;
colon = $3;
vtype = $4;
var_type = $4;
ass = $5;
init = $6;
terminator = $7}

4
Tests/a.li
View File

@ -3,8 +3,8 @@ type u is t
type v is record foo: key; bar: mutez; baz: address end
type w is K of (U of int) (*v * u*)
storage w // Line comment
operations u
storage s : w // Line comment
operations o : u;
(* Block comment *)