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

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

104
AST.mli
View File

@ -1,4 +1,4 @@
(* Abstract Syntax Tree (AST) for Ligo *) (* Abstract Syntax Tree (AST) for LIGO *)
[@@@warning "-30"] [@@@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 nsepseq_to_region : ('a -> Region.t) -> ('a,'sep) nsepseq -> Region.t
val sepseq_to_region : ('a -> Region.t) -> ('a,'sep) sepseq -> 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_begin = Region.t
type kwd_const = Region.t type kwd_const = Region.t
@ -39,7 +39,6 @@ type kwd_is = Region.t
type kwd_match = Region.t type kwd_match = Region.t
type kwd_mod = Region.t type kwd_mod = Region.t
type kwd_not = Region.t type kwd_not = Region.t
type kwd_null = Region.t
type kwd_of = Region.t type kwd_of = Region.t
type kwd_procedure = Region.t type kwd_procedure = Region.t
type kwd_record = Region.t type kwd_record = Region.t
@ -62,34 +61,34 @@ type c_Unit = Region.t
(* Symbols *) (* Symbols *)
type semi = Region.t type semi = Region.t (* ";" *)
type comma = Region.t type comma = Region.t (* "," *)
type lpar = Region.t type lpar = Region.t (* "(" *)
type rpar = Region.t type rpar = Region.t (* ")" *)
type lbrace = Region.t type lbrace = Region.t (* "{" *)
type rbrace = Region.t type rbrace = Region.t (* "}" *)
type lbracket = Region.t type lbracket = Region.t (* "[" *)
type rbracket = Region.t type rbracket = Region.t (* "]" *)
type cons = Region.t type cons = Region.t (* "#" *)
type vbar = Region.t type vbar = Region.t (* "|" *)
type arrow = Region.t type arrow = Region.t (* "->" *)
type ass = Region.t type assign = Region.t (* ":=" *)
type equal = Region.t type equal = Region.t (* "=" *)
type colon = Region.t type colon = Region.t (* ":" *)
type bool_or = Region.t type bool_or = Region.t (* "||" *)
type bool_and = Region.t type bool_and = Region.t (* "&&" *)
type lt = Region.t type lt = Region.t (* "<" *)
type leq = Region.t type leq = Region.t (* "<=" *)
type gt = Region.t type gt = Region.t (* ">" *)
type geq = Region.t type geq = Region.t (* ">=" *)
type neq = Region.t type neq = Region.t (* "=/=" *)
type plus = Region.t type plus = Region.t (* "+" *)
type minus = Region.t type minus = Region.t (* "-" *)
type slash = Region.t type slash = Region.t (* "/" *)
type times = Region.t type times = Region.t (* "*" *)
type dot = Region.t type dot = Region.t (* "." *)
type wild = Region.t type wild = Region.t (* "_" *)
type cat = Region.t type cat = Region.t (* "^" *)
(* Virtual tokens *) (* Virtual tokens *)
@ -192,7 +191,7 @@ and field_decl = {
field_type : type_expr 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 *) (* Function and procedure declarations *)
@ -290,7 +289,7 @@ and var_decl = {
name : variable; name : variable;
colon : colon; colon : colon;
var_type : type_expr; var_type : type_expr;
ass : ass; assign : assign;
init : expr; init : expr;
terminator : semi option terminator : semi option
} }
@ -304,11 +303,11 @@ and instruction =
and single_instr = and single_instr =
Cond of conditional reg Cond of conditional reg
| Match of match_instr reg | Match of match_instr reg
| Ass of ass_instr | Assign of assignment reg
| Loop of loop | Loop of loop
| ProcCall of fun_call | ProcCall of fun_call
| Null of kwd_null
| Fail of fail_instr reg | Fail of fail_instr reg
| DoNothing of Region.t
and fail_instr = { and fail_instr = {
kwd_fail : kwd_fail; kwd_fail : kwd_fail;
@ -341,19 +340,9 @@ and case = {
instr : instruction instr : instruction
} }
and ass_instr = and assignment = {
VarAss of var_ass reg
| MapAss of map_ass reg
and var_ass = {
var : variable; var : variable;
ass : ass; assign : assign;
expr : expr
}
and map_ass = {
lookup : map_lookup reg;
ass : ass;
expr : expr expr : expr
} }
@ -373,7 +362,7 @@ and for_loop =
and for_int = { and for_int = {
kwd_for : kwd_for; kwd_for : kwd_for;
var_ass : var_ass reg; assign : assignment reg;
down : kwd_down option; down : kwd_down option;
kwd_to : kwd_to; kwd_to : kwd_to;
bound : expr; bound : expr;
@ -420,14 +409,14 @@ and bool_expr =
| True of c_True | True of c_True
and 'a bin_op = { and 'a bin_op = {
op1 : expr;
op : 'a; op : 'a;
op2 : expr arg1 : expr;
arg2 : expr
} }
and 'a un_op = { and 'a un_op = {
op : 'a; op : 'a;
op1 : expr arg : expr
} }
and comp_expr = and comp_expr =
@ -472,12 +461,12 @@ and record_expr =
and record_injection = { and record_injection = {
opening : kwd_record; opening : kwd_record;
fields : (field_ass reg, semi) nsepseq; fields : (field_assign reg, semi) nsepseq;
terminator : semi option; terminator : semi option;
close : kwd_end close : kwd_end
} }
and field_ass = { and field_assign = {
field_name : field_name; field_name : field_name;
equal : equal; equal : equal;
field_expr : expr field_expr : expr
@ -486,7 +475,7 @@ and field_ass = {
and record_projection = { and record_projection = {
record_name : variable; record_name : variable;
selector : dot; selector : dot;
field_name : field_name field_path : (field_name, dot) nsepseq
} }
and record_copy = { and record_copy = {
@ -529,11 +518,14 @@ and fun_call = (fun_name * arguments) reg
and arguments = tuple and arguments = tuple
and map_lookup = { and map_lookup = {
map_name : variable; map_path : map_path;
selector : dot;
index : expr brackets reg index : expr brackets reg
} }
and map_path =
Map of map_name
| MapPath of record_projection reg
(* Patterns *) (* Patterns *)
and pattern = 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 *) parser *)
let printf = Printf.printf let printf = Printf.printf
@ -11,8 +11,8 @@ let abort msg =
let help () = let help () =
let file = Filename.basename Sys.argv.(0) in let file = Filename.basename Sys.argv.(0) in
printf "Usage: %s [<option> ...] [<input>.li | \"-\"]\n" file; printf "Usage: %s [<option> ...] [<input>.ligo | \"-\"]\n" file;
print_endline "where <input>.li is the Ligo source file (default: stdin),"; 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 "and each <option> (if any) is one of the following:";
print_endline " -I <paths> Library paths (colon-separated)"; print_endline " -I <paths> Library paths (colon-separated)";
print_endline " -c, --copy Print lexemes of tokens and markup (lexer)"; print_endline " -c, --copy Print lexemes of tokens and markup (lexer)";
@ -127,11 +127,11 @@ let input =
match !input with match !input with
None | Some "-" -> !input None | Some "-" -> !input
| Some file_path -> | 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 if Sys.file_exists file_path
then Some file_path then Some file_path
else abort "Source file not found." 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 *) (* 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 *) parser *)
(* If the value [offsets] is [true], then the user requested that (* 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 val input : string option
(* Paths where to find Ligo files for inclusion *) (* Paths where to find LIGO files for inclusion *)
val libs : string list 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 _Tokens_ are the abstract units which are used by the parser to
build the abstract syntax tree (AST), in other words, the stream of build the abstract syntax tree (AST), in other words, the stream of
@ -70,6 +70,7 @@ type t =
| Begin of Region.t (* "begin" *) | Begin of Region.t (* "begin" *)
| Const of Region.t (* "const" *) | Const of Region.t (* "const" *)
| Copy of Region.t (* "copy" *) | Copy of Region.t (* "copy" *)
| Do of Region.t (* "do" *)
| Down of Region.t (* "down" *) | Down of Region.t (* "down" *)
| Fail of Region.t (* "fail" *) | Fail of Region.t (* "fail" *)
| If of Region.t (* "if" *) | If of Region.t (* "if" *)
@ -85,7 +86,7 @@ type t =
| Then of Region.t (* "then" *) | Then of Region.t (* "then" *)
| Else of Region.t (* "else" *) | Else of Region.t (* "else" *)
| Match of Region.t (* "match" *) | Match of Region.t (* "match" *)
| Null of Region.t (* "null" *) | Nothing of Region.t (* "nothing" *)
| Procedure of Region.t (* "procedure" *) | Procedure of Region.t (* "procedure" *)
| Record of Region.t (* "record" *) | Record of Region.t (* "record" *)
| Step of Region.t (* "step" *) | 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 *) (* START HEADER *)
@ -69,6 +69,7 @@ type t =
| Begin of Region.t | Begin of Region.t
| Const of Region.t | Const of Region.t
| Copy of Region.t | Copy of Region.t
| Do of Region.t
| Down of Region.t | Down of Region.t
| Fail of Region.t | Fail of Region.t
| If of Region.t | If of Region.t
@ -84,7 +85,7 @@ type t =
| Then of Region.t | Then of Region.t
| Else of Region.t | Else of Region.t
| Match of Region.t | Match of Region.t
| Null of Region.t | Nothing of Region.t
| Procedure of Region.t | Procedure of Region.t
| Record of Region.t | Record of Region.t
| Step of Region.t | Step of Region.t
@ -188,6 +189,7 @@ let proj_token = function
| Begin region -> region, "Begin" | Begin region -> region, "Begin"
| Const region -> region, "Const" | Const region -> region, "Const"
| Copy region -> region, "Copy" | Copy region -> region, "Copy"
| Do region -> region, "Do"
| Down region -> region, "Down" | Down region -> region, "Down"
| Fail region -> region, "Fail" | Fail region -> region, "Fail"
| If region -> region, "If" | If region -> region, "If"
@ -203,7 +205,7 @@ let proj_token = function
| Then region -> region, "Then" | Then region -> region, "Then"
| Else region -> region, "Else" | Else region -> region, "Else"
| Match region -> region, "Match" | Match region -> region, "Match"
| Null region -> region, "Null" | Nothing region -> region, "Nothing"
| Procedure region -> region, "Procedure" | Procedure region -> region, "Procedure"
| Record region -> region, "Record" | Record region -> region, "Record"
| Step region -> region, "Step" | Step region -> region, "Step"
@ -272,6 +274,7 @@ let to_lexeme = function
| Begin _ -> "begin" | Begin _ -> "begin"
| Const _ -> "const" | Const _ -> "const"
| Copy _ -> "copy" | Copy _ -> "copy"
| Do _ -> "do"
| Down _ -> "down" | Down _ -> "down"
| Fail _ -> "fail" | Fail _ -> "fail"
| If _ -> "if" | If _ -> "if"
@ -287,7 +290,7 @@ let to_lexeme = function
| Then _ -> "then" | Then _ -> "then"
| Else _ -> "else" | Else _ -> "else"
| Match _ -> "match" | Match _ -> "match"
| Null _ -> "null" | Nothing _ -> "nothing"
| Procedure _ -> "procedure" | Procedure _ -> "procedure"
| Record _ -> "record" | Record _ -> "record"
| Step _ -> "step" | Step _ -> "step"
@ -324,6 +327,7 @@ let keywords = [
(fun reg -> Begin reg); (fun reg -> Begin reg);
(fun reg -> Const reg); (fun reg -> Const reg);
(fun reg -> Copy reg); (fun reg -> Copy reg);
(fun reg -> Do reg);
(fun reg -> Down reg); (fun reg -> Down reg);
(fun reg -> Fail reg); (fun reg -> Fail reg);
(fun reg -> If reg); (fun reg -> If reg);
@ -339,7 +343,7 @@ let keywords = [
(fun reg -> Then reg); (fun reg -> Then reg);
(fun reg -> Else reg); (fun reg -> Else reg);
(fun reg -> Match reg); (fun reg -> Match reg);
(fun reg -> Null reg); (fun reg -> Nothing reg);
(fun reg -> Procedure reg); (fun reg -> Procedure reg);
(fun reg -> Record reg); (fun reg -> Record reg);
(fun reg -> Step reg); (fun reg -> Step reg);
@ -359,7 +363,6 @@ let reserved =
|> add "assert" |> add "assert"
|> add "class" |> add "class"
|> add "constraint" |> add "constraint"
|> add "do"
|> add "done" |> add "done"
|> add "downto" |> add "downto"
|> add "exception" |> add "exception"
@ -548,6 +551,7 @@ let is_kwd = function
Begin _ Begin _
| Const _ | Const _
| Copy _ | Copy _
| Do _
| Down _ | Down _
| Fail _ | Fail _
| If _ | If _
@ -563,7 +567,7 @@ let is_kwd = function
| Then _ | Then _
| Else _ | Else _
| Match _ | Match _
| Null _ | Nothing _
| Procedure _ | Procedure _
| Record _ | Record _
| Step _ | 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: The underlying design principles are:
(1) enforce stylistic constraints at a lexical level, in order to (1) enforce stylistic constraints at a lexical level, in order to
early reject potentially misleading or poorly written early reject potentially misleading or poorly written
Ligo contracts; LIGO contracts;
(2) provide precise error messages with hint as how to fix the (2) provide precise error messages with hint as how to fix the
issue, which is achieved by consulting the lexical issue, which is achieved by consulting the lexical
right-context of lexemes; 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 upgrades have as little impact as possible on this
specification: this is achieved by using the most general specification: this is achieved by using the most general
regular expressions to match the lexing buffer and broadly 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 be contextualised by the lexer in terms of input source regions, so
useful error messages can be printed, therefore they are part of useful error messages can be printed, therefore they are part of
the signature [TOKEN] that parameterise the functor generated 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 be added, and the recognition of their lexemes may entail new
errors, the signature [TOKEN] will have to be augmented and the errors, the signature [TOKEN] will have to be augmented and the
lexer specification changed. However, it is more likely that 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 *) (* START HEADER *)
@ -231,13 +231,13 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
lexer. lexer.
The state also includes a field [pos] which holds the current 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 updated after a single character has been matched: that depends
on the regular expression that matched the lexing buffer. on the regular expression that matched the lexing buffer.
The fields [decoder] and [supply] offer the support needed The fields [decoder] and [supply] offer the support needed
for the lexing of UTF-8 encoded characters in comments (the 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 decoder proper and the latter is the effectful function
[supply] that takes a byte, a start index and a length and feed [supply] that takes a byte, a start index and a length and feed
it to [decoder]. See the documentation of the third-party it to [decoder]. See the documentation of the third-party
@ -508,14 +508,14 @@ and scan state = parse
(* Management of #include CPP directives (* 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 directives, and the entry modules (named *Main.ml) run CPP on them
in traditional mode: in traditional mode:
https://gcc.gnu.org/onlinedocs/cpp/Traditional-Mode.html https://gcc.gnu.org/onlinedocs/cpp/Traditional-Mode.html
The main interest in using CPP is that it can stand for a poor 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 directives, and the traditional mode leaves the markup mostly
undisturbed. 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! *) 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 *) lexer *)
(* A lexeme is piece of concrete syntax belonging to a token. In (* 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> Begin (* "begin" *)
%token <Region.t> Const (* "const" *) %token <Region.t> Const (* "const" *)
%token <Region.t> Copy (* "copy" *) %token <Region.t> Copy (* "copy" *)
%token <Region.t> Do (* "do" *)
%token <Region.t> Down (* "down" *) %token <Region.t> Down (* "down" *)
%token <Region.t> Fail (* "fail" *) %token <Region.t> Fail (* "fail" *)
%token <Region.t> If (* "if" *) %token <Region.t> If (* "if" *)
@ -62,7 +63,7 @@
%token <Region.t> Then (* "then" *) %token <Region.t> Then (* "then" *)
%token <Region.t> Else (* "else" *) %token <Region.t> Else (* "else" *)
%token <Region.t> Match (* "match" *) %token <Region.t> Match (* "match" *)
%token <Region.t> Null (* "null" *) %token <Region.t> Nothing (* "nothing" *)
%token <Region.t> Procedure (* "procedure" *) %token <Region.t> Procedure (* "procedure" *)
%token <Region.t> Record (* "record" *) %token <Region.t> Record (* "record" *)
%token <Region.t> Step (* "step" *) %token <Region.t> Step (* "step" *)

106
Parser.mly
View File

@ -153,7 +153,7 @@ core_type:
} }
type_tuple: type_tuple:
par(nsepseq(type_name,COMMA)) { $1 } par(nsepseq(type_expr,COMMA)) { $1 }
sum_type: sum_type:
nsepseq(variant,VBAR) { nsepseq(variant,VBAR) {
@ -369,6 +369,24 @@ const_decl:
var_decl: var_decl:
Var var COLON type_expr ASS expr option(SEMI) { 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 = let stop =
match $7 with match $7 with
Some region -> region Some region -> region
@ -385,6 +403,11 @@ var_decl:
in {region; value} in {region; value}
} }
extended_expr:
expr { }
| LBRACKET RBRACKET { }
| C_None { }
*)
instruction: instruction:
single_instr { Single $1 } single_instr { Single $1 }
| block { Block $1 } | block { Block $1 }
@ -392,11 +415,11 @@ instruction:
single_instr: single_instr:
conditional { Cond $1 } conditional { Cond $1 }
| match_instr { Match $1 } | match_instr { Match $1 }
| ass { Ass $1 } | assignment { Assign $1 }
| loop { Loop $1 } | loop { Loop $1 }
| proc_call { ProcCall $1 } | proc_call { ProcCall $1 }
| Null { Null $1 }
| fail_instr { Fail $1 } | fail_instr { Fail $1 }
| Do Nothing { let region = cover $1 $2 in DoNothing region }
fail_instr: fail_instr:
Fail expr { Fail expr {
@ -446,20 +469,10 @@ case:
in {region; value} in {region; value}
} }
ass: assignment:
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:
var ASS expr { var ASS expr {
let region = cover $1.region (expr_to_region $3) 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} in {region; value}
} }
@ -478,12 +491,12 @@ while_loop:
} }
for_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 region = cover $1 $7.region in
let value = let value =
{ {
kwd_for = $1; kwd_for = $1;
var_ass = $2; assign = $2;
down = $3; down = $3;
kwd_to = $4; kwd_to = $4;
bound = $5; bound = $5;
@ -521,7 +534,7 @@ expr:
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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})) LogicExpr (BoolExpr (Or {region; value}))
} }
| conj_expr { $1 } | conj_expr { $1 }
@ -531,7 +544,7 @@ conj_expr:
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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})) LogicExpr (BoolExpr (And {region; value}))
} }
| comp_expr { $1 } | comp_expr { $1 }
@ -541,42 +554,42 @@ comp_expr:
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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})) LogicExpr (CompExpr (Lt {region; value}))
} }
| comp_expr LEQ cat_expr { | comp_expr LEQ cat_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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})) in LogicExpr (CompExpr (Leq {region; value}))
} }
| comp_expr GT cat_expr { | comp_expr GT cat_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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})) in LogicExpr (CompExpr (Gt {region; value}))
} }
| comp_expr GEQ cat_expr { | comp_expr GEQ cat_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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})) in LogicExpr (CompExpr (Geq {region; value}))
} }
| comp_expr EQUAL cat_expr { | comp_expr EQUAL cat_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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})) in LogicExpr (CompExpr (Equal {region; value}))
} }
| comp_expr NEQ cat_expr { | comp_expr NEQ cat_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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})) in LogicExpr (CompExpr (Neq {region; value}))
} }
| cat_expr { $1 } | cat_expr { $1 }
@ -586,7 +599,7 @@ cat_expr:
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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}) in StringExpr (Cat {region; value})
} }
| cons_expr { $1 } | cons_expr { $1 }
@ -596,7 +609,7 @@ cons_expr:
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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}) in ListExpr (Cons {region; value})
} }
| add_expr { $1 } | add_expr { $1 }
@ -606,14 +619,14 @@ add_expr:
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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}) in ArithExpr (Add {region; value})
} }
| add_expr MINUS mult_expr { | add_expr MINUS mult_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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}) in ArithExpr (Sub {region; value})
} }
| mult_expr { $1 } | mult_expr { $1 }
@ -623,21 +636,21 @@ mult_expr:
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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}) in ArithExpr (Mult {region; value})
} }
| mult_expr SLASH unary_expr { | mult_expr SLASH unary_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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}) in ArithExpr (Div {region; value})
} }
| mult_expr Mod unary_expr { | mult_expr Mod unary_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop 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}) in ArithExpr (Mod {region; value})
} }
| unary_expr { $1 } | unary_expr { $1 }
@ -646,13 +659,13 @@ unary_expr:
MINUS core_expr { MINUS core_expr {
let stop = expr_to_region $2 in let stop = expr_to_region $2 in
let region = cover $1 stop let region = cover $1 stop
and value = {op = $1; op1 = $2} and value = {op = $1; arg = $2}
in ArithExpr (Neg {region; value}) in ArithExpr (Neg {region; value})
} }
| Not core_expr { | Not core_expr {
let stop = expr_to_region $2 in let stop = expr_to_region $2 in
let region = cover $1 stop let region = cover $1 stop
and value = {op = $1; op1 = $2} in and value = {op = $1; arg = $2} in
LogicExpr (BoolExpr (Not {region; value})) LogicExpr (BoolExpr (Not {region; value}))
} }
| core_expr { $1 } | core_expr { $1 }
@ -684,12 +697,18 @@ core_expr:
} }
map_selection: map_selection:
map_name DOT brackets(expr) { map_name brackets(expr) {
let region = cover $1.region $3.region in let region = cover $1.region $2.region in
let value = { let value = {
map_name = $1; map_path = Map $1;
selector = $2; index = $2}
index = $3} 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} in {region; value}
} }
@ -744,12 +763,13 @@ field_assignment:
} }
record_projection: record_projection:
record_name DOT field_name { record_name DOT nsepseq(field_name,DOT) {
let region = cover $1.region $3.region in let stop = nsepseq_to_region (fun x -> x.region) $3 in
let value = { let region = cover $1.region stop
and value = {
record_name = $1; record_name = $1;
selector = $2; selector = $2;
field_name = $3} field_path = $3}
in {region; value} 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! *) open! EvalOpt (* Reads the command-line options: Effectful! *)
@ -99,12 +99,14 @@ let () =
print_error ~offsets EvalOpt.mode error print_error ~offsets EvalOpt.mode error
| Sys_error msg -> Utils.highlight msg | Sys_error msg -> Utils.highlight msg
(*
(* Temporary: force dune to build AST2.ml *) (* Temporary: force dune to build AST2.ml *)
let () = let () =
let open AST2 in let open AST2 in
let _ = s_ast in let _ = s_ast in
() ()
(*
(* Temporary: force dune to build AST2.ml *) (* Temporary: force dune to build AST2.ml *)
let () = let () =
if false then if false then
@ -112,3 +114,5 @@ let () =
() ()
else else
() ()
*)
*)

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

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