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

Removed keyword "null", replaced by two keywords "do"

Browse Source 
and "nothing".

Until now only products of type names were allowed: I extended
them to allow type expressions.

Removed the destructive update of a map binding "a[b] := c".

Record projection has been extended to allow for qualified
names: "a.b.c" and "a.b.c[d]".

Changed the LIGO extension from ".li" to ".ligo".

Fixed the name of the language to be "LIGO" (instead of "Ligo").
This commit is contained in:
Christian Rinderknecht 2019-03-18 17:47:11 +01:00
parent bbb5966132
commit 623683839f
No known key found for this signature in database
GPG Key ID: 9446816CFD267040
14 changed files with 290 additions and 279 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

211
AST.ml
View File

@ -1,4 +1,4 @@
(* Abstract Syntax Tree (AST) for Ligo *)
(* Abstract Syntax Tree (AST) for LIGO *)
(* To disable warning about multiply-defined record labels. *)
@ -37,7 +37,7 @@ let sepseq_to_region to_region = function
None -> Region.ghost
| Some seq -> nsepseq_to_region to_region seq
(* Keywords of Ligo *)
(* Keywords of LIGO *)
type kwd_begin = Region.t
type kwd_const = Region.t
@ -55,7 +55,6 @@ type kwd_is = Region.t
type kwd_match = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
type kwd_null = Region.t
type kwd_of = Region.t
type kwd_procedure = Region.t
type kwd_record = Region.t
@ -89,7 +88,7 @@ type rbracket = Region.t
type cons = Region.t
type vbar = Region.t
type arrow = Region.t
type ass = Region.t
type assign = Region.t
type equal = Region.t
type colon = Region.t
type bool_or = Region.t
@ -208,7 +207,7 @@ and field_decl = {
field_type : type_expr
}
and type_tuple = (type_name, comma) nsepseq par reg
and type_tuple = (type_expr, comma) nsepseq par reg
(* Function and procedure declarations *)
@ -306,7 +305,7 @@ and var_decl = {
name : variable;
colon : colon;
var_type : type_expr;
ass : ass;
assign : assign;
init : expr;
terminator : semi option
}
@ -318,13 +317,13 @@ and instruction =
| Block of block reg
and single_instr =
Cond of conditional reg
| Match of match_instr reg
| Ass of ass_instr
| Loop of loop
| ProcCall of fun_call
| Null of kwd_null
| Fail of fail_instr reg
Cond of conditional reg
| Match of match_instr reg
| Assign of assignment reg
| Loop of loop
| ProcCall of fun_call
| Fail of fail_instr reg
| DoNothing of Region.t
and fail_instr = {
kwd_fail : kwd_fail;
@ -357,19 +356,9 @@ and case = {
instr : instruction
}
and ass_instr =
VarAss of var_ass reg
| MapAss of map_ass reg
and var_ass = {
var : variable;
ass : ass;
expr : expr
}
and map_ass = {
lookup : map_lookup reg;
ass : ass;
and assignment = {
var : variable;
assign : assign;
expr : expr
}
@ -389,7 +378,7 @@ and for_loop =
and for_int = {
kwd_for : kwd_for;
var_ass : var_ass reg;
assign : assignment reg;
down : kwd_down option;
kwd_to : kwd_to;
bound : expr;
@ -429,21 +418,21 @@ and logic_expr =
| CompExpr of comp_expr
and bool_expr =
Or of bool_or bin_op reg
Or of bool_or bin_op reg
| And of bool_and bin_op reg
| Not of kwd_not un_op reg
| Not of kwd_not un_op reg
| False of c_False
| True of c_True
and 'a bin_op = {
op1 : expr;
op : 'a;
op2 : expr
op : 'a;
arg1 : expr;
arg2 : expr
}
and 'a un_op = {
op : 'a;
op1 : expr
arg : expr
}
and comp_expr =
@ -460,7 +449,7 @@ and arith_expr =
| Mult of times bin_op reg
| Div of slash bin_op reg
| Mod of kwd_mod bin_op reg
| Neg of minus un_op reg
| Neg of minus un_op reg
| Int of (Lexer.lexeme * Z.t) reg
and string_expr =
@ -488,12 +477,12 @@ and record_expr =
and record_injection = {
opening : kwd_record;
fields : (field_ass reg, semi) nsepseq;
fields : (field_assign reg, semi) nsepseq;
terminator : semi option;
close : kwd_end
}
and field_ass = {
and field_assign = {
field_name : field_name;
equal : equal;
field_expr : expr
@ -502,7 +491,7 @@ and field_ass = {
and record_projection = {
record_name : variable;
selector : dot;
field_name : field_name
field_path : (field_name, dot) nsepseq
}
and record_copy = {
@ -545,11 +534,14 @@ and fun_call = (fun_name * arguments) reg
and arguments = tuple
and map_lookup = {
map_name : variable;
selector : dot;
map_path : map_path;
index : expr brackets reg
}
and map_path =
Map of map_name
| MapPath of record_projection reg
(* Patterns *)
and pattern =
@ -653,13 +645,12 @@ and record_expr_to_region = function
let instr_to_region = function
Single Cond {region; _}
| Single Match {region; _}
| Single Ass VarAss {region; _}
| Single Ass MapAss {region; _}
| Single Assign {region; _}
| Single Loop While {region; _}
| Single Loop For ForInt {region; _}
| Single Loop For ForCollect {region; _}
| Single ProcCall {region; _}
| Single Null region
| Single DoNothing region
| Single Fail {region; _}
| Block {region; _} -> region
@ -812,7 +803,7 @@ and print_field_decl {value; _} =
and print_type_tuple {value; _} =
let {lpar; inside; rpar} = value in
print_token lpar "(";
print_nsepseq "," print_var inside;
print_nsepseq "," print_type_expr inside;
print_token rpar ")"
and print_lambda_decl = function
@ -922,12 +913,12 @@ and print_local_decl = function
and print_var_decl {value; _} =
let {kwd_var; name; colon; var_type;
ass; init; terminator} = value in
assign; init; terminator} = value in
print_token kwd_var "var";
print_var name;
print_token colon ":";
print_type_expr var_type;
print_token ass ":=";
print_token assign ":=";
print_expr init;
print_terminator terminator
@ -941,11 +932,11 @@ and print_instruction = function
and print_single_instr = function
Cond {value; _} -> print_conditional value
| Match {value; _} -> print_match_instr value
| Ass instr -> print_ass_instr instr
| Assign assign -> print_assignment assign
| Loop loop -> print_loop loop
| ProcCall fun_call -> print_fun_call fun_call
| Null kwd_null -> print_token kwd_null "null"
| Fail {value; _} -> print_fail value
| DoNothing region -> print_token region "do nothing"
and print_fail {kwd_fail; fail_expr} =
print_token kwd_fail "fail";
@ -984,20 +975,10 @@ and print_case {value; _} =
print_token arrow "->";
print_instruction instr
and print_ass_instr = function
VarAss a -> print_var_ass a
| MapAss a -> print_map_ass a
and print_var_ass {value; _} =
let {var; ass; expr} = value in
and print_assignment {value; _} =
let {var; assign; expr} = value in
print_var var;
print_token ass ":=";
print_expr expr
and print_map_ass {value; _} =
let {lookup; ass; expr} = value in
print_map_lookup lookup;
print_token ass ":=";
print_token assign ":=";
print_expr expr
and print_loop = function
@ -1015,15 +996,15 @@ and print_for_loop = function
| ForCollect for_collect -> print_for_collect for_collect
and print_for_int ({value; _} : for_int reg) =
let {kwd_for; var_ass; down; kwd_to;
let {kwd_for; assign; down; kwd_to;
bound; step; block} = value in
print_token kwd_for "for";
print_var_ass var_ass;
print_down down;
print_token kwd_to "to";
print_expr bound;
print_step step;
print_block block
print_token kwd_for "for";
print_assignment assign;
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"
@ -1071,52 +1052,52 @@ and print_logic_expr = function
| CompExpr e -> print_comp_expr e
and print_bool_expr = function
Or {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "||"; print_expr op2
| And {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "&&"; print_expr op2
| Not {value = {op; op1}; _} ->
print_token op "not"; print_expr op1
Or {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "||"; print_expr arg2
| And {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "&&"; print_expr arg2
| Not {value = {op; arg}; _} ->
print_token op "not"; print_expr arg
| False region -> print_token region "False"
| True region -> print_token region "True"
and print_comp_expr = function
Lt {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "<"; print_expr op2
| Leq {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "<="; print_expr op2
| Gt {value = {op1; op; op2}; _} ->
print_expr op1; print_token op ">"; print_expr op2
| Geq {value = {op1; op; op2}; _} ->
print_expr op1; print_token op ">="; print_expr op2
| Equal {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "="; print_expr op2
| Neq {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "=/="; print_expr op2
Lt {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "<"; print_expr arg2
| Leq {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "<="; print_expr arg2
| Gt {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op ">"; print_expr arg2
| Geq {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op ">="; print_expr arg2
| Equal {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "="; print_expr arg2
| Neq {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "=/="; print_expr arg2
and print_arith_expr = function
Add {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "+"; print_expr op2
| Sub {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "-"; print_expr op2
| Mult {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "*"; print_expr op2
| Div {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "/"; print_expr op2
| Mod {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "mod"; print_expr op2
| Neg {value = {op; op1}; _} ->
print_token op "-"; print_expr op1
Add {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "+"; print_expr arg2
| Sub {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "-"; print_expr arg2
| Mult {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "*"; print_expr arg2
| Div {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "/"; print_expr arg2
| Mod {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "mod"; print_expr arg2
| Neg {value = {op; arg}; _} ->
print_token op "-"; print_expr arg
| Int i -> print_int i
and print_string_expr = function
Cat {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "^"; print_expr op2
Cat {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "^"; print_expr arg2
| String s -> print_string s
and print_list_expr = function
Cons {value = {op1; op; op2}; _} ->
print_expr op1; print_token op "#"; print_expr op2
Cons {value = {arg1; op; arg2}; _} ->
print_expr arg1; print_token op "#"; print_expr arg2
| List e -> print_list e
| EmptyList e -> print_empty_list e
@ -1137,21 +1118,24 @@ and print_record_expr = function
and print_record_injection {value; _} =
let {opening; fields; terminator; close} = value in
print_token opening "record";
print_nsepseq ";" print_field_ass fields;
print_nsepseq ";" print_field_assign fields;
print_terminator terminator;
print_token close "end"
and print_field_ass {value; _} =
and print_field_assign {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
let {record_name; selector; field_path} = value in
print_var record_name;
print_token selector ".";
print_var field_name
print_field_path field_path
and print_field_path sequence =
print_nsepseq "." print_var sequence
and print_record_copy {value; _} =
let {kwd_copy; record_name; kwd_with; delta} = value in
@ -1223,13 +1207,16 @@ and print_some_app {value; _} =
print_tuple arguments
and print_map_lookup {value; _} =
let {map_name; selector; index} = value in
let {map_path; index} = value in
let {lbracket; inside; rbracket} = index.value in
print_var map_name;
print_token selector ".";
print_token lbracket "[";
print_expr inside;
print_token rbracket "]"
print_map_path map_path;
print_token lbracket "[";
print_expr inside;
print_token rbracket "]"
and print_map_path = function
Map map_name -> print_var map_name
| MapPath path -> print_record_projection path
and print_par_expr {value; _} =
let {lpar; inside; rpar} = value in

124
AST.mli
View File

@ -1,4 +1,4 @@
(* Abstract Syntax Tree (AST) for Ligo *)
(* Abstract Syntax Tree (AST) for LIGO *)
[@@@warning "-30"]
@ -21,7 +21,7 @@ val nseq_to_region : ('a -> Region.t) -> 'a nseq -> Region.t
val nsepseq_to_region : ('a -> Region.t) -> ('a,'sep) nsepseq -> Region.t
val sepseq_to_region : ('a -> Region.t) -> ('a,'sep) sepseq -> Region.t
(* Keywords of Ligo *)
(* Keywords of LIGO *)
type kwd_begin = Region.t
type kwd_const = Region.t
@ -39,7 +39,6 @@ type kwd_is = Region.t
type kwd_match = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
type kwd_null = Region.t
type kwd_of = Region.t
type kwd_procedure = Region.t
type kwd_record = Region.t
@ -62,34 +61,34 @@ type c_Unit = Region.t
(* Symbols *)
type semi = Region.t
type comma = Region.t
type lpar = Region.t
type rpar = Region.t
type lbrace = Region.t
type rbrace = Region.t
type lbracket = Region.t
type rbracket = Region.t
type cons = Region.t
type vbar = Region.t
type arrow = Region.t
type ass = Region.t
type equal = Region.t
type colon = Region.t
type bool_or = Region.t
type bool_and = Region.t
type lt = Region.t
type leq = Region.t
type gt = Region.t
type geq = Region.t
type neq = Region.t
type plus = Region.t
type minus = Region.t
type slash = Region.t
type times = Region.t
type dot = Region.t
type wild = Region.t
type cat = Region.t
type semi = Region.t (* ";" *)
type comma = Region.t (* "," *)
type lpar = Region.t (* "(" *)
type rpar = Region.t (* ")" *)
type lbrace = Region.t (* "{" *)
type rbrace = Region.t (* "}" *)
type lbracket = Region.t (* "[" *)
type rbracket = Region.t (* "]" *)
type cons = Region.t (* "#" *)
type vbar = Region.t (* "|" *)
type arrow = Region.t (* "->" *)
type assign = Region.t (* ":=" *)
type equal = Region.t (* "=" *)
type colon = Region.t (* ":" *)
type bool_or = Region.t (* "||" *)
type bool_and = Region.t (* "&&" *)
type lt = Region.t (* "<" *)
type leq = Region.t (* "<=" *)
type gt = Region.t (* ">" *)
type geq = Region.t (* ">=" *)
type neq = Region.t (* "=/=" *)
type plus = Region.t (* "+" *)
type minus = Region.t (* "-" *)
type slash = Region.t (* "/" *)
type times = Region.t (* "*" *)
type dot = Region.t (* "." *)
type wild = Region.t (* "_" *)
type cat = Region.t (* "^" *)
(* Virtual tokens *)
@ -192,7 +191,7 @@ and field_decl = {
field_type : type_expr
}
and type_tuple = (type_name, comma) nsepseq par reg
and type_tuple = (type_expr, comma) nsepseq par reg
(* Function and procedure declarations *)
@ -290,7 +289,7 @@ and var_decl = {
name : variable;
colon : colon;
var_type : type_expr;
ass : ass;
assign : assign;
init : expr;
terminator : semi option
}
@ -302,13 +301,13 @@ and instruction =
| Block of block reg
and single_instr =
Cond of conditional reg
| Match of match_instr reg
| Ass of ass_instr
| Loop of loop
| ProcCall of fun_call
| Null of kwd_null
| Fail of fail_instr reg
Cond of conditional reg
| Match of match_instr reg
| Assign of assignment reg
| Loop of loop
| ProcCall of fun_call
| Fail of fail_instr reg
| DoNothing of Region.t
and fail_instr = {
kwd_fail : kwd_fail;
@ -341,19 +340,9 @@ and case = {
instr : instruction
}
and ass_instr =
VarAss of var_ass reg
| MapAss of map_ass reg
and var_ass = {
var : variable;
ass : ass;
expr : expr
}
and map_ass = {
lookup : map_lookup reg;
ass : ass;
and assignment = {
var : variable;
assign : assign;
expr : expr
}
@ -373,7 +362,7 @@ and for_loop =
and for_int = {
kwd_for : kwd_for;
var_ass : var_ass reg;
assign : assignment reg;
down : kwd_down option;
kwd_to : kwd_to;
bound : expr;
@ -413,21 +402,21 @@ and logic_expr =
| CompExpr of comp_expr
and bool_expr =
Or of bool_or bin_op reg
Or of bool_or bin_op reg
| And of bool_and bin_op reg
| Not of kwd_not un_op reg
| Not of kwd_not un_op reg
| False of c_False
| True of c_True
and 'a bin_op = {
op1 : expr;
op : 'a;
op2 : expr
op : 'a;
arg1 : expr;
arg2 : expr
}
and 'a un_op = {
op : 'a;
op1 : expr
arg : expr
}
and comp_expr =
@ -444,7 +433,7 @@ and arith_expr =
| Mult of times bin_op reg
| Div of slash bin_op reg
| Mod of kwd_mod bin_op reg
| Neg of minus un_op reg
| Neg of minus un_op reg
| Int of (Lexer.lexeme * Z.t) reg
and string_expr =
@ -472,12 +461,12 @@ and record_expr =
and record_injection = {
opening : kwd_record;
fields : (field_ass reg, semi) nsepseq;
fields : (field_assign reg, semi) nsepseq;
terminator : semi option;
close : kwd_end
}
and field_ass = {
and field_assign = {
field_name : field_name;
equal : equal;
field_expr : expr
@ -486,7 +475,7 @@ and field_ass = {
and record_projection = {
record_name : variable;
selector : dot;
field_name : field_name
field_path : (field_name, dot) nsepseq
}
and record_copy = {
@ -529,11 +518,14 @@ and fun_call = (fun_name * arguments) reg
and arguments = tuple
and map_lookup = {
map_name : variable;
selector : dot;
map_path : map_path;
index : expr brackets reg
}
and map_path =
Map of map_name
| MapPath of record_projection reg
(* Patterns *)
and pattern =

10
EvalOpt.ml
View File

@ -1,4 +1,4 @@
(* Parsing the command-line option for testing the Ligo lexer and
(* Parsing the command-line option for testing the LIGO lexer and
parser *)
let printf = Printf.printf
@ -11,8 +11,8 @@ let abort msg =
let help () =
let file = Filename.basename Sys.argv.(0) in
printf "Usage: %s [<option> ...] [<input>.li | \"-\"]\n" file;
print_endline "where <input>.li is the Ligo source file (default: stdin),";
printf "Usage: %s [<option> ...] [<input>.ligo | \"-\"]\n" file;
print_endline "where <input>.ligo is the LIGO source file (default: stdin),";
print_endline "and each <option> (if any) is one of the following:";
print_endline " -I <paths> Library paths (colon-separated)";
print_endline " -c, --copy Print lexemes of tokens and markup (lexer)";
@ -127,11 +127,11 @@ let input =
match !input with
None | Some "-" -> !input
| Some file_path ->
if Filename.check_suffix file_path ".li"
if Filename.check_suffix file_path ".ligo"
then if Sys.file_exists file_path
then Some file_path
else abort "Source file not found."
else abort "Source file lacks the extension .li."
else abort "Source file lacks the extension .ligo."
(* Exporting remaining options as non-mutable values *)

4
EvalOpt.mli
View File

@ -1,4 +1,4 @@
(* Parsing the command-line option for testing the Ligo lexer and
(* Parsing the command-line option for testing the LIGO lexer and
parser *)
(* If the value [offsets] is [true], then the user requested that
@ -25,7 +25,7 @@ val verbose : Utils.String.Set.t
val input : string option
(* Paths where to find Ligo files for inclusion *)
(* Paths where to find LIGO files for inclusion *)
val libs : string list

5
LexToken.mli
View File

@ -1,4 +1,4 @@
(* This signature defines the lexical tokens for Ligo
(* This signature defines the lexical tokens for LIGO
_Tokens_ are the abstract units which are used by the parser to
build the abstract syntax tree (AST), in other words, the stream of
@ -70,6 +70,7 @@ type t =
| Begin of Region.t (* "begin" *)
| Const of Region.t (* "const" *)
| Copy of Region.t (* "copy" *)
| Do of Region.t (* "do" *)
| Down of Region.t (* "down" *)
| Fail of Region.t (* "fail" *)
| If of Region.t (* "if" *)
@ -85,7 +86,7 @@ type t =
| Then of Region.t (* "then" *)
| Else of Region.t (* "else" *)
| Match of Region.t (* "match" *)
| Null of Region.t (* "null" *)
| Nothing of Region.t (* "nothing" *)
| Procedure of Region.t (* "procedure" *)
| Record of Region.t (* "record" *)
| Step of Region.t (* "step" *)

18
LexToken.mll
View File

@ -1,4 +1,4 @@
(* Lexer specification for Ligo, to be processed by [ocamllex] *)
(* Lexer specification for LIGO, to be processed by [ocamllex] *)
{
(* START HEADER *)
@ -69,6 +69,7 @@ type t =
| Begin of Region.t
| Const of Region.t
| Copy of Region.t
| Do of Region.t
| Down of Region.t
| Fail of Region.t
| If of Region.t
@ -84,7 +85,7 @@ type t =
| Then of Region.t
| Else of Region.t
| Match of Region.t
| Null of Region.t
| Nothing of Region.t
| Procedure of Region.t
| Record of Region.t
| Step of Region.t
@ -188,6 +189,7 @@ let proj_token = function
| Begin region -> region, "Begin"
| Const region -> region, "Const"
| Copy region -> region, "Copy"
| Do region -> region, "Do"
| Down region -> region, "Down"
| Fail region -> region, "Fail"
| If region -> region, "If"
@ -203,7 +205,7 @@ let proj_token = function
| Then region -> region, "Then"
| Else region -> region, "Else"
| Match region -> region, "Match"
| Null region -> region, "Null"
| Nothing region -> region, "Nothing"
| Procedure region -> region, "Procedure"
| Record region -> region, "Record"
| Step region -> region, "Step"
@ -272,6 +274,7 @@ let to_lexeme = function
| Begin _ -> "begin"
| Const _ -> "const"
| Copy _ -> "copy"
| Do _ -> "do"
| Down _ -> "down"
| Fail _ -> "fail"
| If _ -> "if"
@ -287,7 +290,7 @@ let to_lexeme = function
| Then _ -> "then"
| Else _ -> "else"
| Match _ -> "match"
| Null _ -> "null"
| Nothing _ -> "nothing"
| Procedure _ -> "procedure"
| Record _ -> "record"
| Step _ -> "step"
@ -324,6 +327,7 @@ let keywords = [
(fun reg -> Begin reg);
(fun reg -> Const reg);
(fun reg -> Copy reg);
(fun reg -> Do reg);
(fun reg -> Down reg);
(fun reg -> Fail reg);
(fun reg -> If reg);
@ -339,7 +343,7 @@ let keywords = [
(fun reg -> Then reg);
(fun reg -> Else reg);
(fun reg -> Match reg);
(fun reg -> Null reg);
(fun reg -> Nothing reg);
(fun reg -> Procedure reg);
(fun reg -> Record reg);
(fun reg -> Step reg);
@ -359,7 +363,6 @@ let reserved =
|> add "assert"
|> add "class"
|> add "constraint"
|> add "do"
|> add "done"
|> add "downto"
|> add "exception"
@ -548,6 +551,7 @@ let is_kwd = function
Begin _
| Const _
| Copy _
| Do _
| Down _
| Fail _
| If _
@ -563,7 +567,7 @@ let is_kwd = function
| Then _
| Else _
| Match _
| Null _
| Nothing _
| Procedure _
| Record _
| Step _

8
Lexer.mli
View File

@ -1,16 +1,16 @@
(* Lexer specification for Ligo, to be processed by [ocamllex].
(* Lexer specification for LIGO, to be processed by [ocamllex].
The underlying design principles are:
(1) enforce stylistic constraints at a lexical level, in order to
early reject potentially misleading or poorly written
Ligo contracts;
LIGO contracts;
(2) provide precise error messages with hint as how to fix the
issue, which is achieved by consulting the lexical
right-context of lexemes;
(3) be as independent as possible from the Ligo version, so
(3) be as independent as possible from the LIGO version, so
upgrades have as little impact as possible on this
specification: this is achieved by using the most general
regular expressions to match the lexing buffer and broadly
@ -27,7 +27,7 @@
be contextualised by the lexer in terms of input source regions, so
useful error messages can be printed, therefore they are part of
the signature [TOKEN] that parameterise the functor generated
here. For instance, if, in a future release of Ligo, new tokens may
here. For instance, if, in a future release of LIGO, new tokens may
be added, and the recognition of their lexemes may entail new
errors, the signature [TOKEN] will have to be augmented and the
lexer specification changed. However, it is more likely that

10
Lexer.mll
View File

@ -1,4 +1,4 @@
(* Lexer specification for Ligo, to be processed by [ocamllex]. *)
(* Lexer specification for LIGO, to be processed by [ocamllex]. *)
{
(* START HEADER *)
@ -231,13 +231,13 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
lexer.
The state also includes a field [pos] which holds the current
position in the Ligo source file. The position is not always
position in the LIGO source file. The position is not always
updated after a single character has been matched: that depends
on the regular expression that matched the lexing buffer.
The fields [decoder] and [supply] offer the support needed
for the lexing of UTF-8 encoded characters in comments (the
only place where they are allowed in Ligo). The former is the
only place where they are allowed in LIGO). The former is the
decoder proper and the latter is the effectful function
[supply] that takes a byte, a start index and a length and feed
it to [decoder]. See the documentation of the third-party
@ -508,14 +508,14 @@ and scan state = parse
(* Management of #include CPP directives
An input Ligo program may contain GNU CPP (C preprocessor)
An input LIGO program may contain GNU CPP (C preprocessor)
directives, and the entry modules (named *Main.ml) run CPP on them
in traditional mode:
https://gcc.gnu.org/onlinedocs/cpp/Traditional-Mode.html
The main interest in using CPP is that it can stand for a poor
man's (flat) module system for Ligo thanks to #include
man's (flat) module system for LIGO thanks to #include
directives, and the traditional mode leaves the markup mostly
undisturbed.

2
LexerMain.ml
View File

@ -1,4 +1,4 @@
(* Driver for the lexer of Ligo *)
(* Driver for the lexer of LIGO *)
open! EvalOpt (* Reads the command-line options: Effectful! *)

2
Markup.mli
View File

@ -1,4 +1,4 @@
(* This module defines the sorts of markup recognised by the Ligo
(* This module defines the sorts of markup recognised by the LIGO
lexer *)
(* A lexeme is piece of concrete syntax belonging to a token. In

3
ParToken.mly
View File

@ -47,6 +47,7 @@
%token <Region.t> Begin (* "begin" *)
%token <Region.t> Const (* "const" *)
%token <Region.t> Copy (* "copy" *)
%token <Region.t> Do (* "do" *)
%token <Region.t> Down (* "down" *)
%token <Region.t> Fail (* "fail" *)
%token <Region.t> If (* "if" *)
@ -62,7 +63,7 @@
%token <Region.t> Then (* "then" *)
%token <Region.t> Else (* "else" *)
%token <Region.t> Match (* "match" *)
%token <Region.t> Null (* "null" *)
%token <Region.t> Nothing (* "nothing" *)
%token <Region.t> Procedure (* "procedure" *)
%token <Region.t> Record (* "record" *)
%token <Region.t> Step (* "step" *)

118
Parser.mly
View File

@ -149,11 +149,11 @@ core_type:
in TypeApp {region; value = $1,$2}
}
| par(type_expr) {
ParType $1
ParType $1
}
type_tuple:
par(nsepseq(type_name,COMMA)) { $1 }
par(nsepseq(type_expr,COMMA)) { $1 }
sum_type:
nsepseq(variant,VBAR) {
@ -369,6 +369,24 @@ const_decl:
var_decl:
Var var COLON type_expr ASS expr option(SEMI) {
let stop =
match $7 with
Some region -> region
| None -> expr_to_region $6 in
let region = cover $1 stop in
let value = {
kwd_var = $1;
name = $2;
colon = $3;
var_type = $4;
assign = $5;
init = $6;
terminator = $7}
in {region; value}
}
(*
| Var var COLON type_name type_tuple
ASS extended_expr option(SEMI) {
let stop =
match $7 with
Some region -> region
@ -385,18 +403,23 @@ var_decl:
in {region; value}
}
extended_expr:
expr { }
| LBRACKET RBRACKET { }
| C_None { }
*)
instruction:
single_instr { Single $1 }
| block { Block $1 }
single_instr:
conditional { Cond $1 }
| match_instr { Match $1 }
| ass { Ass $1 }
| loop { Loop $1 }
| proc_call { ProcCall $1 }
| Null { Null $1 }
| fail_instr { Fail $1 }
conditional { Cond $1 }
| match_instr { Match $1 }
| assignment { Assign $1 }
| loop { Loop $1 }
| proc_call { ProcCall $1 }
| fail_instr { Fail $1 }
| Do Nothing { let region = cover $1 $2 in DoNothing region }
fail_instr:
Fail expr {
@ -446,20 +469,10 @@ case:
in {region; value}
}
ass:
var_ass {
VarAss $1
}
| map_selection ASS expr {
let region = cover $1.region (expr_to_region $3)
and value = {lookup = $1; ass = $2; expr = $3}
in MapAss {region; value}
}
var_ass:
assignment:
var ASS expr {
let region = cover $1.region (expr_to_region $3)
and value = {var = $1; ass = $2; expr = $3}
and value = {var = $1; assign = $2; expr = $3}
in {region; value}
}
@ -478,12 +491,12 @@ while_loop:
}
for_loop:
For var_ass Down? To expr option(step_clause) block {
For assignment Down? To expr option(step_clause) block {
let region = cover $1 $7.region in
let value =
{
kwd_for = $1;
var_ass = $2;
assign = $2;
down = $3;
kwd_to = $4;
bound = $5;
@ -521,7 +534,7 @@ expr:
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3} in
and value = {arg1 = $1; op = $2; arg2 = $3} in
LogicExpr (BoolExpr (Or {region; value}))
}
| conj_expr { $1 }
@ -531,7 +544,7 @@ conj_expr:
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3} in
and value = {arg1 = $1; op = $2; arg2 = $3} in
LogicExpr (BoolExpr (And {region; value}))
}
| comp_expr { $1 }
@ -541,42 +554,42 @@ comp_expr:
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3} in
and value = {arg1 = $1; op = $2; arg2 = $3} in
LogicExpr (CompExpr (Lt {region; value}))
}
| comp_expr LEQ cat_expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in LogicExpr (CompExpr (Leq {region; value}))
}
| comp_expr GT cat_expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in LogicExpr (CompExpr (Gt {region; value}))
}
| comp_expr GEQ cat_expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in LogicExpr (CompExpr (Geq {region; value}))
}
| comp_expr EQUAL cat_expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in LogicExpr (CompExpr (Equal {region; value}))
}
| comp_expr NEQ cat_expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in LogicExpr (CompExpr (Neq {region; value}))
}
| cat_expr { $1 }
@ -586,7 +599,7 @@ cat_expr:
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in StringExpr (Cat {region; value})
}
| cons_expr { $1 }
@ -596,7 +609,7 @@ cons_expr:
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in ListExpr (Cons {region; value})
}
| add_expr { $1 }
@ -606,14 +619,14 @@ add_expr:
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in ArithExpr (Add {region; value})
}
| add_expr MINUS mult_expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in ArithExpr (Sub {region; value})
}
| mult_expr { $1 }
@ -623,21 +636,21 @@ mult_expr:
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in ArithExpr (Mult {region; value})
}
| mult_expr SLASH unary_expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in ArithExpr (Div {region; value})
}
| mult_expr Mod unary_expr {
let start = expr_to_region $1
and stop = expr_to_region $3 in
let region = cover start stop
and value = {op1 = $1; op = $2; op2 = $3}
and value = {arg1 = $1; op = $2; arg2 = $3}
in ArithExpr (Mod {region; value})
}
| unary_expr { $1 }
@ -646,13 +659,13 @@ unary_expr:
MINUS core_expr {
let stop = expr_to_region $2 in
let region = cover $1 stop
and value = {op = $1; op1 = $2}
and value = {op = $1; arg = $2}
in ArithExpr (Neg {region; value})
}
| Not core_expr {
let stop = expr_to_region $2 in
let region = cover $1 stop
and value = {op = $1; op1 = $2} in
and value = {op = $1; arg = $2} in
LogicExpr (BoolExpr (Not {region; value}))
}
| core_expr { $1 }
@ -684,14 +697,20 @@ core_expr:
}
map_selection:
map_name DOT brackets(expr) {
let region = cover $1.region $3.region in
map_name brackets(expr) {
let region = cover $1.region $2.region in
let value = {
map_name = $1;
selector = $2;
index = $3}
map_path = Map $1;
index = $2}
in {region; value}
}
| record_projection brackets(expr) {
let region = cover $1.region $2.region in
let value = {
map_path = MapPath $1;
index = $2}
in {region; value}
}
record_expr:
record_injection { RecordInj $1 }
@ -744,12 +763,13 @@ field_assignment:
}
record_projection:
record_name DOT field_name {
let region = cover $1.region $3.region in
let value = {
record_name DOT nsepseq(field_name,DOT) {
let stop = nsepseq_to_region (fun x -> x.region) $3 in
let region = cover $1.region stop
and value = {
record_name = $1;
selector = $2;
field_name = $3}
field_path = $3}
in {region; value}
}

6
ParserMain.ml
View File

@ -1,4 +1,4 @@
(* Driver for the parser of Ligo *)
(* Driver for the parser of LIGO *)
open! EvalOpt (* Reads the command-line options: Effectful! *)
@ -99,12 +99,14 @@ let () =
print_error ~offsets EvalOpt.mode error
| Sys_error msg -> Utils.highlight msg
(*
(* Temporary: force dune to build AST2.ml *)
let () =
let open AST2 in
let _ = s_ast in
()
(*
(* Temporary: force dune to build AST2.ml *)
let () =
if false then
@ -112,3 +114,5 @@ let () =
()
else
()
*)
*)

48
Tests/Crowdfunding.li → Tests/crowdfunding.ligo
View File

@ -1,4 +1,4 @@
type state =
type state is
record
goal : nat;
deadline : timestamp;
@ -6,61 +6,63 @@ type state =
funded : bool
end
entrypoint donate (storage store : state;
const sender : address;
const amount : mutez)
: storage * list (operation) is
var operations : list (operation) := []
entrypoint contribute (storage store : state;
const sender : address;
const amount : mutez)
: state * list (operation) is
var operations : list (operation) := ([] : list (operation)) // TODO
begin
if now > store.deadline then
fail "Deadline passed"
else
if store.backers.[sender] = None then
store :=
copy store with
record
backers = map_add store.backers (sender, amount)
end
else null
match store.backers[sender] with
None ->
store :=
copy store with
record
backers = add_binding ((sender, amount), store.backers)
end
| _ -> do nothing
end
end with (store, operations)
entrypoint get_funds (storage store : state; const sender : address)
: storage * list (operation) is
var operations : list (operation) := []
: state * list (operation) is
var operations : list (operation) := ([] : list (operation)) // TODO
begin
if sender = owner then
if now >= store.deadline then
if balance >= store.goal then
begin
store := copy store with record funded = true end;
store := copy store with record funded = True end;
operations := [Transfer (owner, balance)]
end
else fail "Below target"
else fail "Too soon"
else null
else do nothing
end with (store, operations)
entrypoint claim (storage store : state; const sender : address)
: storage * list (operation) is
var operations : list (operation) := [];
: state * list (operation) is
var operations : list (operation) := ([] : list (operation)) // TODO
var amount : mutez := 0
begin
if now <= store.deadline then
fail "Too soon"
else
match store.backers.[sender] with
match store.backers[sender] with
None ->
fail "Not a backer"
| Some amount ->
| Some (amount) ->
if balance >= store.goal || store.funded then
fail "Cannot refund"
else
begin
amount := store.backers.[sender];
amount := store.backers[sender];
store :=
copy store with
record
backers = map_remove store.backers sender
backers = remove_entry (sender, store.backers)
end;
operations := [Transfer (sender, amount)]
end