From 77a55172ef71aa9ef72af0a47dff1c28d1b636e0 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 13 Jun 2019 16:57:40 +0200 Subject: [PATCH 01/12] I fixed the heterogeneity in parentheses around constructors in patterns. --- src/contracts/coase.ligo | 6 ++-- src/contracts/dispatch-counter.ligo | 4 +-- src/contracts/match.ligo | 4 +-- src/contracts/super-counter.ligo | 4 +-- src/contracts/website2.ligo | 4 +-- src/parser/pascaligo/AST.ml | 6 ++-- src/parser/pascaligo/AST.mli | 6 ++-- src/parser/pascaligo/Parser.mly | 43 +++++++++++++------------ src/parser/pascaligo/ParserLog.ml | 6 ++-- src/simplify/pascaligo.ml | 49 ++++++++++++++++++++--------- 10 files changed, 79 insertions(+), 53 deletions(-) diff --git a/src/contracts/coase.ligo b/src/contracts/coase.ligo index 8d5ad912f..ea7f9d057 100644 --- a/src/contracts/coase.ligo +++ b/src/contracts/coase.ligo @@ -92,7 +92,7 @@ function buy_single(const action : action_buy_single ; const s : storage_type) : function main(const action : action ; const s : storage_type) : (list(operation) * storage_type) is block {skip} with case action of - | Buy_single bs -> buy_single (bs , s) - | Sell_single as -> sell_single (as , s) - | Transfer_single at -> transfer_single (at , s) + | Buy_single (bs) -> buy_single (bs , s) + | Sell_single (as) -> sell_single (as , s) + | Transfer_single (at) -> transfer_single (at , s) end diff --git a/src/contracts/dispatch-counter.ligo b/src/contracts/dispatch-counter.ligo index c8c59250a..79a71b837 100644 --- a/src/contracts/dispatch-counter.ligo +++ b/src/contracts/dispatch-counter.ligo @@ -11,6 +11,6 @@ function decrement(const i : int ; const n : int) : int is function main (const p : action ; const s : int) : (list(operation) * int) is block {skip} with ((nil : list(operation)), case p of - | Increment n -> increment(s , n) - | Decrement n -> decrement(s , n) + | Increment (n) -> increment (s, n) + | Decrement (n) -> decrement (s, n) end) diff --git a/src/contracts/match.ligo b/src/contracts/match.ligo index 57a74d7dd..ff5e3a0a4 100644 --- a/src/contracts/match.ligo +++ b/src/contracts/match.ligo @@ -12,7 +12,7 @@ function match_option (const o : option(int)) : int is begin case o of | None -> skip - | Some(s) -> result := s + | Some (s) -> result := s end end with result @@ -27,5 +27,5 @@ function match_expr_option (const o : option(int)) : int is begin skip end with case o of | None -> 42 - | Some(s) -> s + | Some (s) -> s end diff --git a/src/contracts/super-counter.ligo b/src/contracts/super-counter.ligo index 45ce7462a..fcfa8422e 100644 --- a/src/contracts/super-counter.ligo +++ b/src/contracts/super-counter.ligo @@ -5,6 +5,6 @@ type action is function main (const p : action ; const s : int) : (list(operation) * int) is block {skip} with ((nil : list(operation)), case p of - | Increment n -> s + n - | Decrement n -> s - n + | Increment (n) -> s + n + | Decrement (n) -> s - n end) diff --git a/src/contracts/website2.ligo b/src/contracts/website2.ligo index 25b36a880..c58561aa9 100644 --- a/src/contracts/website2.ligo +++ b/src/contracts/website2.ligo @@ -13,6 +13,6 @@ function subtract (const a : int ; const b : int) : int is function main (const p : action ; const s : int) : (list(operation) * int) is block {skip} with ((nil : list(operation)), case p of - | Increment n -> add(s, n) - | Decrement n -> subtract(s, n) + | Increment (n) -> add (s, n) + | Decrement (n) -> subtract (s, n) end) diff --git a/src/parser/pascaligo/AST.ml b/src/parser/pascaligo/AST.ml index 8c4de5fd3..a94f3f869 100644 --- a/src/parser/pascaligo/AST.ml +++ b/src/parser/pascaligo/AST.ml @@ -632,7 +632,7 @@ and arguments = tuple_injection and pattern = PCons of (pattern, cons) nsepseq reg -| PConstr of (constr * pattern reg) reg +| PConstr of (constr * tuple_pattern option) reg | PVar of Lexer.lexeme reg | PWild of wild | PInt of (Lexer.lexeme * Z.t) reg @@ -644,7 +644,9 @@ and pattern = | PNone of c_None | PSome of (c_Some * pattern par reg) reg | PList of list_pattern -| PTuple of (pattern, comma) nsepseq par reg +| PTuple of tuple_pattern + +and tuple_pattern = (pattern, comma) nsepseq par reg and list_pattern = Sugar of pattern injection reg diff --git a/src/parser/pascaligo/AST.mli b/src/parser/pascaligo/AST.mli index eaa3d67b7..b9c7693cb 100644 --- a/src/parser/pascaligo/AST.mli +++ b/src/parser/pascaligo/AST.mli @@ -616,7 +616,7 @@ and arguments = tuple_injection and pattern = PCons of (pattern, cons) nsepseq reg -| PConstr of (constr * pattern reg) reg +| PConstr of (constr * tuple_pattern option) reg | PVar of Lexer.lexeme reg | PWild of wild | PInt of (Lexer.lexeme * Z.t) reg @@ -628,7 +628,9 @@ and pattern = | PNone of c_None | PSome of (c_Some * pattern par reg) reg | PList of list_pattern -| PTuple of (pattern, comma) nsepseq par reg +| PTuple of tuple_pattern + +and tuple_pattern = (pattern, comma) nsepseq par reg and list_pattern = Sugar of pattern injection reg diff --git a/src/parser/pascaligo/Parser.mly b/src/parser/pascaligo/Parser.mly index 6ec70672f..45f58dcd8 100644 --- a/src/parser/pascaligo/Parser.mly +++ b/src/parser/pascaligo/Parser.mly @@ -1052,22 +1052,22 @@ pattern: in PCons {region; value=$1}} core_pattern: - var { PVar $1 } -| WILD { PWild $1 } -| Int { PInt $1 } -| String { PString $1 } -| C_Unit { PUnit $1 } -| C_False { PFalse $1 } -| C_True { PTrue $1 } -| C_None { PNone $1 } -| list_patt { PList $1 } -| tuple_patt { PTuple $1 } -| constr_patt { PConstr $1 } + var { PVar $1 } +| WILD { PWild $1 } +| Int { PInt $1 } +| String { PString $1 } +| C_Unit { PUnit $1 } +| C_False { PFalse $1 } +| C_True { PTrue $1 } +| C_None { PNone $1 } +| list_pattern { PList $1 } +| tuple_pattern { PTuple $1 } +| constr_pattern { PConstr $1 } | C_Some par(core_pattern) { let region = cover $1 $2.region in PSome {region; value = $1,$2}} -list_patt: +list_pattern: injection(List,core_pattern) { Sugar $1 } | Nil { PNil $1 } | par(cons_pattern) { Raw $1 } @@ -1075,15 +1075,14 @@ list_patt: cons_pattern: core_pattern CONS pattern { $1,$2,$3 } -tuple_patt: +tuple_pattern: par(nsepseq(core_pattern,COMMA)) { $1 } -constr_patt: - Constr core_pattern { - let second = - let region = pattern_to_region $2 in - {region; value=$2} - in - let region = cover $1.region second.region in - let value = ($1 , second) in - {region; value}} +constr_pattern: + Constr tuple_pattern { + let region = cover $1.region $2.region + in {region; value = $1, Some $2} + } +| Constr { + {region=$1.region; value = $1, None} + } diff --git a/src/parser/pascaligo/ParserLog.ml b/src/parser/pascaligo/ParserLog.ml index 599543b4e..46341e800 100644 --- a/src/parser/pascaligo/ParserLog.ml +++ b/src/parser/pascaligo/ParserLog.ml @@ -681,8 +681,10 @@ and print_pattern = function and print_constr_pattern {value; _} = let (constr, args) = value in - print_constr constr ; - print_pattern args.value ; + print_constr constr; + match args with + None -> () + | Some tuple -> print_ptuple tuple and print_psome {value; _} = let c_Some, patterns = value in diff --git a/src/simplify/pascaligo.ml b/src/simplify/pascaligo.ml index 922790453..01e83b325 100644 --- a/src/simplify/pascaligo.ml +++ b/src/simplify/pascaligo.ml @@ -15,6 +15,17 @@ let pseq_to_list = function let get_value : 'a Raw.reg -> 'a = fun x -> x.value module Errors = struct + let unsupported_cst_constr p = + let title () = "constant constructor" in + let message () = + Format.asprintf "constant constructors are not supported yet" in + let pattern_loc = Raw.pattern_to_region p in + let data = [ + ("pattern_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) + ] in + error ~data title message + let unsupported_ass_None region = let title () = "assignment of None" in let message () = @@ -848,33 +859,43 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t - let get_var (t:Raw.pattern) = match t with | PVar v -> ok v.value - | p -> fail @@ unsupported_non_var_pattern p - in - let get_tuple (t:Raw.pattern) = match t with + | p -> fail @@ unsupported_non_var_pattern p in + let get_tuple (t: Raw.pattern) = + match t with | PCons v -> npseq_to_list v.value | PTuple v -> npseq_to_list v.value.inside - | x -> [ x ] - in - let get_single (t:Raw.pattern) = + | x -> [ x ] in + let get_single (t: Raw.pattern) = let t' = get_tuple t in let%bind () = trace_strong (unsupported_tuple_pattern t) @@ Assert.assert_list_size t' 1 in ok (List.hd t') in - let get_constr (t:Raw.pattern) = match t with - | PConstr v -> - let%bind var = get_single (snd v.value).value >>? get_var in - ok ((fst v.value).value , var) - | _ -> fail @@ only_constructors t - in + let get_constr (t: Raw.pattern) = + match t with + | PConstr v -> ( + let (const , pat_opt) = v.value in + let%bind pat = + trace_option (unsupported_cst_constr t) @@ + pat_opt in + let%bind single_pat = get_single (PTuple pat) in + let%bind var = get_var single_pat in + ok (const.value , var) + ) +(* + | PConstr {value = constr, Some tuple; _} -> + let%bind var = get_single (PTuple tuple) >>? get_var in + ok (constr.value, var) + | PConstr {value = constr, None; _} -> + *) + | _ -> fail @@ only_constructors t in let%bind patterns = let aux (x , y) = let xs = get_tuple x in trace_strong (unsupported_tuple_pattern x) @@ Assert.assert_list_size xs 1 >>? fun () -> ok (List.hd xs , y) - in - bind_map_list aux t in + in bind_map_list aux t in match patterns with | [(PFalse _ , f) ; (PTrue _ , t)] | [(PTrue _ , t) ; (PFalse _ , f)] -> From 6d3679290d989bbee96fc6bf104d6ed86df788bd Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 27 Jun 2019 10:32:07 +0200 Subject: [PATCH 02/12] Fixed typo in comment. --- src/parser/pascaligo/Lexer.mll | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parser/pascaligo/Lexer.mll b/src/parser/pascaligo/Lexer.mll index 6ee487350..90be90ff9 100644 --- a/src/parser/pascaligo/Lexer.mll +++ b/src/parser/pascaligo/Lexer.mll @@ -720,7 +720,7 @@ and scan_utf8 thread state = parse [lex_start_p] and [lex_curr_p], as these fields are read by parsers generated by Menhir when querying source positions (regions). This is the purpose of the function [patch_buffer]. After reading one - ore more tokens and markup by the scanning rule [scan], we have to + or more tokens and markup by the scanning rule [scan], we have to save in the hidden reference [buf_reg] the region of the source that was matched by [scan]. This atomic sequence of patching, scanning and saving is implemented by the _function_ [scan] From 685c25de9ac9568a3df74725307c25ee4d151b6b Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Sun, 14 Jul 2019 16:41:52 +0200 Subject: [PATCH 03/12] First import of my first designs for a front-end generator for Ligodity. --- src/parser/generator/doc/essai.ml | 296 +++++++++++++++++++++++ src/parser/generator/doc/mini_ml.bnf | 270 +++++++++++++++++++++ src/parser/generator/doc/mini_ml2.bnf | 270 +++++++++++++++++++++ src/parser/generator/doc/mini_ml3.bnf | 249 +++++++++++++++++++ src/parser/generator/doc/mini_ml4.bnf | 336 ++++++++++++++++++++++++++ 5 files changed, 1421 insertions(+) create mode 100644 src/parser/generator/doc/essai.ml create mode 100644 src/parser/generator/doc/mini_ml.bnf create mode 100644 src/parser/generator/doc/mini_ml2.bnf create mode 100644 src/parser/generator/doc/mini_ml3.bnf create mode 100644 src/parser/generator/doc/mini_ml4.bnf diff --git a/src/parser/generator/doc/essai.ml b/src/parser/generator/doc/essai.ml new file mode 100644 index 000000000..2cc51dbbb --- /dev/null +++ b/src/parser/generator/doc/essai.ml @@ -0,0 +1,296 @@ +type region +type 'a reg +type lexeme = string reg + +(* Tokens *) + +type integer = [`Integer of lexeme reg] +type natural = [`Natural of lexeme reg] +type ident = [`Ident of lexeme reg] +type uident = [`Uident of lexeme reg] +type chr = [`Chr of lexeme reg] +type str = [`Str of lexeme reg] + +type bool_or = [`bool_or of lexeme reg] +type bool_and = [`bool_and of lexeme reg] +type lt = [`lt of lexeme reg] +type le = [`le of lexeme reg] +type gt = [`gt of lexeme reg] +type ge = [`ge of lexeme reg] +type eq = [`eq of lexeme reg] +type ne = [`ne of lexeme reg] +type cat = [`cat of lexeme reg] +type cons = [`cons of lexeme reg] +type plus = [`plus of lexeme reg] +type minus = [`minus of lexeme reg] +type times = [`times of lexeme reg] +type slash = [`slash of lexeme reg] +type div = [`div of lexeme reg] +type kwd_mod = [`kwd_mod of lexeme reg] +type uminus = [`uminus of lexeme reg] +type kwd_not = [`kwd_not of lexeme reg] + +type lpar = [`lpar of lexeme reg] +type rpar = [`rpar of lexeme reg] +type lbracket = [`lbracket of lexeme reg] +type rbracket = [`rbracket of lexeme reg] +type lbrace = [`lbrace of lexeme reg] +type rbrace = [`rbrace of lexeme reg] +type semi = [`semi of lexeme reg] +type comma = [`comma of lexeme reg] +type colon = [`colon of lexeme reg] +type vbar = [`vbar of lexeme reg] +type arrow = [`arrow of lexeme reg] +type wild = [`wild of lexeme reg] + +type kwd_and = [`kwd_and of lexeme reg] +type kwd_begin = [`kwd_begin of lexeme reg] +type kwd_else = [`kwd_else of lexeme reg] +type kwd_end = [`kwd_end of lexeme reg] +type kwd_false = [`kwd_false of lexeme reg] +type kwd_fun = [`kwd_fun of lexeme reg] +type kwd_if = [`kwd_if of lexeme reg] +type kwd_in = [`kwd_in of lexeme reg] +type kwd_let = [`kwd_let of lexeme reg] +type kwd_list = [`kwd_list of lexeme reg] +type kwd_map = [`kwd_map of lexeme reg] +type kwd_match = [`kwd_match of lexeme reg] +type kwd_of = [`kwd_of of lexeme reg] +type kwd_set = [`kwd_set of lexeme reg] +type kwd_then = [`kwd_then of lexeme reg] +type kwd_true = [`kwd_true of lexeme reg] +type kwd_type = [`kwd_type of lexeme reg] +type kwd_with = [`kwd_with of lexeme reg] + +type token = + Integer of integer +| Natural of natural +| Ident of ident +| Uident of uident +| Chr of chr +| Str of str +| Bool_or of bool_or +| Bool_and of bool_and +| Lt of lt +| Le of le +| Gt of gt +| Ge of ge +| Eq of eq +| Ne of ne +| Cat of cat +| Cons of cons +| Plus of plus +| Minus of minus +| Times of times +| Slash of slash +| Div of div +| Kwd_mod of kwd_mod +| Uminus of uminus +| Kwd_not of kwd_not +| Lpar of lpar +| Rpar of rpar +| Lbracket of lbracket +| Rbracket of rbracket +| Lbrace of lbrace +| Rbrace of rbrace +| Semi of semi +| Comma of comma +| Colon of colon +| Vbar of vbar +| Arrow of arrow +| Wild of wild +| Kwd_and of kwd_and +| Kwd_begin of kwd_begin +| Kwd_else of kwd_else +| Kwd_end of kwd_end +| Kwd_false of kwd_false +| Kwd_fun of kwd_fun +| Kwd_if of kwd_if +| Kwd_in of kwd_in +| Kwd_let of kwd_let +| Kwd_list of kwd_list +| Kwd_map of kwd_map +| Kwd_match of kwd_match +| Kwd_of of kwd_of +| Kwd_set of kwd_set +| Kwd_then of kwd_then +| Kwd_true of kwd_true +| Kwd_type of kwd_type +| Kwd_with of kwd_with + +(* The following are meant to be part of a library *) + +type 'item seq = 'item list +type 'item nseq = 'item * 'item seq +type ('item,'sep) nsepseq = 'item * ('sep * 'item) list +type ('item,'sep) sepseq = ('item,'sep) nsepseq option +type ('item,'sep) sep_or_term_list = + ('item,'sep) nsepseq * 'sep option + +(* The following are specific to the present grammar *) + +type 'item list_of__rec_0 = { + lbracket__1 : lbracket; + list_of__rec_0__2 : ('item, semi) nsepseq; + rbracket__3 : rbracket +} + +type 'item list_of = [`List of 'item list_of__rec_0] + +type 'item tuple__rec_0 = { + item__1 : 'item; + comma__2 : comma; + tuple__rec_0__3 : ('item, comma) nsepseq +} + +type 'item tuple = [`Tuple of 'item tuple__rec_0] + +type 'item par__rec_0 = { + lpar__1 : lpar; + item__2 : 'item; + rpar__3 : rpar +} + +type 'item par = [`Par of 'item par__rec_0] + +(* Non-recursive value declarations *) + +type sub_irrefutable = [ + `P_Var of string +| `P_Wild +| `P_Unit +| closed_irrefutable par +] + +and closed_irrefutable = [ + sub_irrefutable tuple +| `P_SubI of sub_irrefutable (* `P_SubI necessary *) +] + +type irrefutable = [ + sub_irrefutable tuple +| sub_irrefutable +] + +type let_binding__rec_1 = { + variable__1 : variable; + sub_irrefutable__nseq__2 : sub_irrefutable nseq; + eq__3 : eq; + expr__4 : expr +} + +type let_binding__rec_2 = { + irrefutable__1 : irrefutable; + eq__2 : eq; + expr__3 : expr +} + +type let_binding = [ + `LetFun of let_binding__rec_1 +| `LetNonFun of let_binding__rec_2 (* `LetNonFun necessary *) +] + +type let_bindings = (let_binding, kwd_and) nsepseq + +type let_declarations = { + kwd_let : kwd_let; + let_bindings : let_bindings +} + +(* +type pattern = [ + `P_Cons of {sub_pattern: sub_pattern; cons: cons; tail: tail} +| `P_Tuple +*) + +(* Type declarations *) + +type type_name = ident +type field_name = ident +type constr = uident + +type type_constr = [ + `T_Constr of ident +| kwd_set +| kwd_map +| kwd_list +] + +type record_type = { + lbrace : lbrace; + record_type__2 : (field_decl, semi) sep_or_term_list; + rbrace : rbrace +} + +and field_decl = { + field_name : field_name; + colon : colon; + type_expr : type_expr +} + +and variant = { + constr : constr; + kwd_of : kwd_of; + cartesian : cartesian +} + +and sum_type = { + vbar_opt : vbar option; + sum_type__2 : (variant, vbar) nsepseq +} + +and type_param__rec_1 = { + core_type : core_type; + type_constr : type_constr +} + +and type_param = [ + (type_expr, comma) nsepseq par +| `T_App of type_param__rec_1 +] + +and core_type__rec_1 = { + type_param : type_param; + type_constr : type_constr +} + +and core_type = [ + `T_Alias of type_name +| `T_App of core_type__rec_1 +| cartesian par +] + +and fun_type__rec_0 = { + core_type : core_type; + arrow : arrow; + fun_type : fun_type +} + +and fun_type = [ + `T_Fun of fun_type__rec_0 +| `T_Core of core_type (* `T_Core necessary *) +] + +and cartesian = (fun_type, times) nsepseq + +and type_expr = [ + `T_Prod of cartesian +| `T_Sum of sum_type +| `T_Record of record_type +] + +type type_declaration = { + kwd_type__1 : kwd_type; + type_name__2 : type_name; + eq__3 : eq; + type_expr__4 : type_expr +} + +(* Entry *) + +type statement = [ + `Let of let_declarations +| `TypeDecl of type_declaration +] + +type program = statement list diff --git a/src/parser/generator/doc/mini_ml.bnf b/src/parser/generator/doc/mini_ml.bnf new file mode 100644 index 000000000..f930c2d68 --- /dev/null +++ b/src/parser/generator/doc/mini_ml.bnf @@ -0,0 +1,270 @@ +(* Extended Backus-Naur Form (EBNF) for Mini-ML *) + +(* LEXIS *) + +let nl = ['\n' '\r'] +let blank = [' ' '\t'] + +let digit = ['0'-'9'] +let natural = digit | digit (digit | '_')* digit +let integer = '-'? natural + +let small = ['a'-'z'] +let capital = ['A'-'Z'] +let letter = small | capital + +let ichar = letter | digit | ['_' '\''] +let ident = small ichar* | '_' ichar+ +let uident = capital ichar* + +let hexa = digit | ['A'-'F'] +let byte = hexa hexa + +let esc = "\\n" | "\\\\" | "\\b" | "\\r" | "\\t" +let string +let char_set = [^'\'' '\\'] # nl + | "\\'" | esc | "\\x" byte | "\\0" digit digit +let char = "'" char_set "'" + + +(* SYNTAX *) + +(* Helpers *) + +(* The following are meant to be part of a library *) + +sep_or_term_list ::= + item sep ... +| (item sep)+ + +seq ::= nseq? + +nseq ::= item seq + +nsepseq ::= + item +| item sep nsepseq + +sepseq ::= nsepseq? + +(* The following are specific to the present grammar *) + +list_of ::= "[" item ";" ... "]" + +csv ::= item "," item "," ... + +(* Entry *) + +program ::= statement* EOF + +statement ::= + let_declarations +| type_declaration + +(* Type declarations *) + +type_declaration ::= "type" type_name "=" type_expr + +type_name == ident + +type_expr ::= + cartesian +| sum_type +| record_type + +cartesian ::= fun_type "*" ... + +fun_type ::= + core_type "->" fun_type +| core_type + +core_type ::= + type_name +| type_param type_constr +| "(" cartesian ")" + +type_param == + core_type type_constr +| type_tuple type_constr + +type_constr == type_name + +type_tuple ::= "(" type_expr "," ... ")" + +sum_type ::= variant "|" ... + +variant ::= constr "of" cartesian + +constr == uident + +record_type ::= + "{" sep_or_term_list "}" + +field_decl ::= field_name ":" type_expr + +field_name == ident + +(* Non-recursive value declarations *) + +let_declarations ::= "let" let_bindings + +let_bindings := let_binding "and" ... + +let_binding ::= + value_name pattern+ "=" expr +| let_lhs "=" expr + +value_name == ident + +(* Patterns *) + +let_lhs ::= + pattern "::" cons_pat +| pattern "," pattern "," ... +| core_pattern + +core_pattern ::= + variable +| "_" +| "(" ")" +| number +| "true" +| "false" +| string +| list_of +| "(" ptuple ")" +| constr core_pattern + +variable == ident +number == int + +ptuple ::= csv + +unit ::= "(" ")" + +cons_pat ::= + pattern "::" cons_pat +| pattern + +pattern ::= + "(" cons_pat ")" +| core_pattern + +(* Expressions *) + +expr ::= + base_cond__open +| match_expr + +base_cond__open ::= + base_expr +| conditional + +base_cond ::= base_cond__open + +base_expr ::= + let_expr +| fun_expr +| csv +| op_expr + +conditional ::= + if_then_else +| if_then + +if_then ::= "if" expr "then" right_expr + +if_then_else ::= + "if" expr "then" closed_if "else" right_expr + +base_if_then_else__open ::= + base_expr +| if_then_else + +base_if_then_else ::= + base_if_then_else__open + +closed_if ::= + base_if_then_else__open +| match_expr + +match_expr ::= + "match" expr "with" cases + +cases ::= + case +| cases "|" case + +case ::= let_lhs "->" right_expr + +let_in ::= "let" par_let "in" right_expr + +fun_expr ::= "fun" pattern+ "->" right_expr + +op_expr ::= + op_expr "||" conj_expr +| conj_expr + +conj_expr ::= + conj_expr "&&" comp_expr +| comp_expr + +comp_expr ::= + comp_expr "<" cat_expr +| comp_expr "<=" cat_expr +| comp_expr ">" cat_expr +| comp_expr ">=" cat_expr +| comp_expr "=" cat_expr +| comp_expr "<>" cat_expr +| cat_expr + +cat_expr ::= + cons_expr "^" cat_expr +| cons_expr + +cons_expr ::= + add_expr "::" cons_expr +| add_expr + +add_expr ::= + add_expr "+" mult_expr +| add_expr "-" mult_expr +| mult_expr + +mult_expr ::= + mult_expr "*" unary_expr +| mult_expr "div" unary_expr +| mult_expr "mod" unary_expr +| unary_expr + +unary_expr ::= + "-" core_expr +| "not" core_expr +| call_expr + +call_expr ::= + call_expr core_expr +| core_expr + +core_expr ::= + number +| module_name "." variable +| string +| char +| "()" +| "false" +| "true" +| list_of +| "(" expr ")" +| constr +| sequence +| record_expr + +module_name == uident + +record_expr ::= + "{" sep_or_term_list(field_assignment,";") "}" + +field_assignment ::= field_name "=" expr + +sequence ::= "begin" (expr ";" ...)? "end" diff --git a/src/parser/generator/doc/mini_ml2.bnf b/src/parser/generator/doc/mini_ml2.bnf new file mode 100644 index 000000000..561398e18 --- /dev/null +++ b/src/parser/generator/doc/mini_ml2.bnf @@ -0,0 +1,270 @@ +(* Extended Backus-Naur Form (EBNF) for Mini-ML *) + +(* LEXIS *) + +let nl = ['\n' '\r'] +let blank = [' ' '\t'] + +let digit = ['0'-'9'] +let natural = digit | digit (digit | '_')* digit +token int = '-'? natural + +let small = ['a'-'z'] +let capital = ['A'-'Z'] +let letter = small | capital + +let ichar = letter | digit | ['_' '\''] +token ident = small ichar* | '_' ichar+ +token uident = capital ichar* + +let esc = "\\n" | "\\\\" | "\\b" | "\\r" | "\\t" +token string + +let hexa = digit | ['A'-'F'] +let byte = hexa hexa +let char_set = [^'\'' '\\'] # nl + | "\\'" | esc | "\\x" byte | "\\0" digit digit +token char = "'" char_set "'" + + +(* SYNTAX *) + +(* Helpers *) + +(* The following are meant to be part of a library *) + +sep_or_term_list ::= + item sep ... +| (item sep)+ + +seq ::= nseq? + +nseq ::= item seq + +nsepseq ::= + item +| item sep nsepseq + +sepseq ::= nsepseq? + +(* The following are specific to the present grammar *) + +list_of ::= "[" item ";" ... "]" + +csv ::= item "," item "," ... + +(* Entry *) + +program ::= statement* EOF + +statement ::= + let_declarations +| type_declaration + +(* Type declarations *) + +type_declaration ::= "type" type_name "=" type_expr + +type_name == ident + +type_expr ::= + cartesian +| sum_type +| record_type + +cartesian ::= fun_type "*" ... + +fun_type ::= + core_type "->" fun_type +| core_type + +core_type ::= + type_name +| type_param type_constr +| "(" cartesian ")" + +type_param == + core_type type_constr +| type_tuple type_constr + +type_constr == type_name + +type_tuple ::= "(" type_expr "," ... ")" + +sum_type ::= variant "|" ... + +variant ::= constr "of" cartesian + +constr == uident + +record_type ::= + "{" sep_or_term_list "}" + +field_decl ::= field_name ":" type_expr + +field_name == ident + +(* Non-recursive value declarations *) + +let_declarations ::= "let" let_bindings + +let_bindings := let_binding "and" ... + +let_binding ::= + value_name pattern+ "=" expr +| let_lhs "=" expr + +value_name == ident + +(* Patterns *) + +let_lhs ::= + pattern "::" cons_pat +| pattern "," pattern "," ... +| core_pattern + +core_pattern ::= + variable +| "_" +| "(" ")" +| number +| "true" +| "false" +| string +| list_of +| "(" ptuple ")" +| constr core_pattern + +variable == ident +number == int + +ptuple ::= csv + +unit ::= "(" ")" + +cons_pat ::= + pattern "::" cons_pat +| pattern + +pattern ::= + "(" cons_pat ")" +| core_pattern + +(* Expressions *) + +expr ::= + base_cond__open +| match_expr + +base_cond__open ::= + base_expr +| conditional + +base_cond ::= base_cond__open + +base_expr ::= + let_expr +| fun_expr +| csv +| op_expr + +conditional ::= + if_then_else +| if_then + +if_then ::= "if" expr "then" right_expr + +if_then_else ::= + "if" expr "then" closed_if "else" right_expr + +base_if_then_else__open ::= + base_expr +| if_then_else + +base_if_then_else ::= + base_if_then_else__open + +closed_if ::= + base_if_then_else__open +| match_expr + +match_expr ::= + "match" expr "with" cases + +cases ::= + case +| cases "|" case + +case ::= let_lhs "->" right_expr + +let_in ::= "let" par_let "in" right_expr + +fun_expr ::= "fun" pattern+ "->" right_expr + +op_expr ::= + op_expr "||" conj_expr +| conj_expr + +conj_expr ::= + conj_expr "&&" comp_expr +| comp_expr + +comp_expr ::= + comp_expr "<" cat_expr +| comp_expr "<=" cat_expr +| comp_expr ">" cat_expr +| comp_expr ">=" cat_expr +| comp_expr "=" cat_expr +| comp_expr "<>" cat_expr +| cat_expr + +cat_expr ::= + cons_expr "^" cat_expr +| cons_expr + +cons_expr ::= + add_expr "::" cons_expr +| add_expr + +add_expr ::= + add_expr "+" mult_expr +| add_expr "-" mult_expr +| mult_expr + +mult_expr ::= + mult_expr "*" unary_expr +| mult_expr "div" unary_expr +| mult_expr "mod" unary_expr +| unary_expr + +unary_expr ::= + "-" core_expr +| "not" core_expr +| call_expr + +call_expr ::= + call_expr core_expr +| core_expr + +core_expr ::= + number +| module_name "." variable +| string +| char +| "()" +| "false" +| "true" +| list_of +| "(" expr ")" +| constr +| sequence +| record_expr + +module_name == uident + +record_expr ::= + "{" sep_or_term_list "}" + +field_assignment ::= field_name "=" expr + +sequence ::= "begin" (expr ";" ...)? "end" diff --git a/src/parser/generator/doc/mini_ml3.bnf b/src/parser/generator/doc/mini_ml3.bnf new file mode 100644 index 000000000..392378f21 --- /dev/null +++ b/src/parser/generator/doc/mini_ml3.bnf @@ -0,0 +1,249 @@ +(* Extended Backus-Naur Form (EBNF) for Mini-ML *) + +(* LEXIS *) + +let nl = ['\n' '\r'] +let blank = [' ' '\t'] + +let digit = ['0'-'9'] +let natural = digit | digit (digit | '_')* digit +token int = '-'? natural + +let small = ['a'-'z'] +let capital = ['A'-'Z'] +let letter = small | capital + +let ichar = letter | digit | ['_' '\''] +token ident = small ichar* | '_' ichar+ +token uident = capital ichar* + +let esc = "\\n" | "\\\\" | "\\b" | "\\r" | "\\t" +let hexa = digit | ['A'-'F'] +let byte = hexa hexa +let char_set = [^'\'' '\\'] # nl + | "\\'" | esc | "\\x" byte | "\\0" digit digit +token char = "'" char_set "'" + +token string + + +(* SYNTAX *) + +(* Helpers *) + +(* The following are meant to be part of a library *) + +sep_or_term_list ::= + item sep etc. +| (item sep)+ + +seq ::= nseq? + +nseq ::= item seq + +nsepseq ::= + item +| item sep nsepseq + +sepseq ::= nsepseq? + +(* The following are specific to the present grammar *) + +list_of ::= "[" item ";" etc. "]" + +csv ::= item "," item "," etc. + +(* Entry *) + +program ::= statement* + +statement ::= + let_declarations +| type_declaration + +(* Type declarations *) + +type_declaration ::= "type" type_name "=" type_expr + +type_name == ident + +type_expr ::= + cartesian +| sum_type +| record_type + +cartesian ::= fun_type "*" etc. + +fun_type ::= + core_type "->" fun_type +| core_type + +core_type ::= + type_name +| type_param type_constr +| "(" cartesian ")" + +type_param == + core_type type_constr +| type_tuple type_constr + +type_constr == type_name + +type_tuple ::= "(" type_expr "," etc. ")" + +sum_type ::= "|"? variant "|" etc. + +variant ::= constr "of" cartesian + +constr == uident + +record_type ::= + "{" sep_or_term_list "}" + +field_decl ::= field_name ":" type_expr + +field_name == ident + +(* Non-recursive value declarations *) + +let_declarations ::= "let" let_bindings + +let_bindings := let_binding "and" etc. + +let_binding ::= + value_name pattern+ "=" expr +| let_lhs "=" expr + +value_name == ident + +(* Patterns *) + +let_lhs ::= + pattern "::" cons_pat +| pattern "," pattern "," etc. +| core_pattern + +core_pattern ::= + variable +| "_" +| "(" ")" +| number +| "true" +| "false" +| string +| list_of +| "(" ptuple ")" +| constr core_pattern + +variable == ident +number == int + +ptuple ::= csv + +unit ::= "(" ")" + +cons_pat ::= + pattern "::" cons_pat +| pattern + +pattern ::= + "(" cons_pat ")" +| core_pattern + +(* Expressions *) + +expr ::= + base_cond__ +| match_expr + +base_cond__ ::= + base_expr +| conditional + +base_cond ::= base_cond__ + +base_expr ::= + let_expr +| fun_expr +| csv +| op_expr + +conditional ::= + if_then_else +| if_then + +if_then ::= "if" expr "then" right_expr + +if_then_else ::= + "if" expr "then" closed_if "else" right_expr + +base_if_then_else__ ::= + base_expr +| if_then_else + +base_if_then_else ::= + base_if_then_else__ + +closed_if ::= + base_if_then_else__ +| match_expr + +match_expr ::= + "match" expr "with" cases + +cases ::= + case +| cases "|" case + +case ::= let_lhs "->" right_expr + +let_in ::= "let" par_let "in" right_expr + +fun_expr ::= "fun" pattern+ "->" right_expr + +op_expr ::= + op_expr "||" %left %prec1 op_expr +| op_expr "&&" %left %prec2 op_expr +| op_expr "<" %left %prec3 op_expr +| op_expr "<=" %left %prec3 op_expr +| op_expr ">" %left %prec3 op_expr +| op_expr ">=" %left %prec3 op_expr +| op_expr "=" %left %prec3 op_expr +| op_expr "<>" %left %prec3 op_expr +| op_expr "^" %right %prec4 op_expr +| op_expr "::" %right %prec5 op_expr +| op_expr "+" %left %prec6 op_expr +| op_expr "-" %left %prec6 op_expr +| op_expr "*" %left %prec7 op_expr +| op_expr "div" %left %prec7 op_expr +| op_expr "mod" %left %prec7 op_expr +| "-" %prec8 op_expr +| "not" %prec8 op_expr +| call_expr + +call_expr ::= + call_expr core_expr +| core_expr + +core_expr ::= + number +| module_name "." variable +| string +| char +| "()" +| "false" +| "true" +| list_of +| "(" expr ")" +| constr +| sequence +| record_expr + +module_name == uident + +record_expr ::= + "{" sep_or_term_list "}" + +field_assignment ::= field_name "=" expr + +sequence ::= "begin" sep_or_term_list? "end" diff --git a/src/parser/generator/doc/mini_ml4.bnf b/src/parser/generator/doc/mini_ml4.bnf new file mode 100644 index 000000000..1576ead49 --- /dev/null +++ b/src/parser/generator/doc/mini_ml4.bnf @@ -0,0 +1,336 @@ +(* Extended Backus-Naur Form (EBNF) for Mini-ML *) + +(* LEXIS *) + +let digit = ['0'-'9'] +let natural = digit | digit (digit | '_')* digit +%token integer = '-'? natural +%token natural = natural 'n' + +let small = ['a'-'z'] +let capital = ['A'-'Z'] +let letter = small | capital + +let ichar = letter | digit | ['_' '\''] +%token ident = small ichar* | '_' ichar+ +%token uident = capital ichar* + +let esc = "\\n" | "\\\\" | "\\b" | "\\r" | "\\t" +let hexa = digit | ['A'-'F'] +let byte = hexa hexa +let char_set = [^'\'' '\\'] # nl + | "\\'" | esc | "\\x" byte | "\\0" digit digit +%token chr = "'" char_set "'" + +%token str + +%token bool_or = "||" %left %prec1 +%token bool_and = "&&" %left %prec2 +%token lt = "<" %left %prec3 +%token le = "<=" %left %prec3 +%token gt = ">" %left %prec3 +%token ge = ">=" %left %prec3 +%token eq = "=" %left %prec3 +%token ne = "<>" %left %prec3 +%token cat = "^" %right %prec4 +%token cons = "::" %right %prec5 +%token plus = "+" %left %prec6 +%token minus = "-" %left %prec6 +%token times = "*" %left %prec7 +%token slash = "/" %left %prec7 +%token kwd_div = "div" %left %prec7 +%token kwd_mod = "mod" %left %prec7 +%token uminus = "-" %prec8 +%token kwd_not = "not" %prec8 + +%token lpar = "(" +%token rpar = ")" +%token lbracket = "[" +%token rbracket = "]" +%token lbrace = "{" +%token rbrace = "}" +%token semi = ";" +%token comma = "," +%token colon = ":" +%token vbar = "|" +%token arrow = "->" +%token wild = "_" + +(* SYNTAX *) + +(* Helpers *) + +(* The following are meant to be part of a library *) + +%ocaml "Utils" +type 'item seq = 'item list +type 'item nseq = 'item * 'item seq +type ('item,'sep) nsepseq = 'item * ('sep * 'item) list +type ('item,'sep) sepseq = ('item,'sep) nsepseq option +type ('item,'sep) sep_or_term_list = + ('item,'sep) nsepseq * 'sep option +%end + +%menhir_decl "Parser" +%start program interactive_expr +%type program +%type interactive_expr +%type <('item,'sep) sep_or_term_list> sep_or_term_list +%end + +%menhir_rule "Parser" +seq(item): + (**) { [] } +| X seq(item) { $1::$2 } + +nseq(item): + item seq(item) { $1,$2 } + +nsepseq(item,sep): + item { $1, [] } +| item sep nsepseq(item,sep) { let h,t = $3 in $1, ($2,h)::t } + +sepseq(item,sep): + (**) { None } +| nsepseq(item,sep) { Some $1 } + +sep_or_term_list(item,sep): + nsepseq(item,sep) { + $1, None + } +| nseq(item sep {$1,$2}) { + let (first,sep), tail = $1 in + let rec trans (seq, prev_sep as acc) = function + [] -> acc + | (item,next_sep)::others -> + trans ((prev_sep,item)::seq, next_sep) others in + let list, term = trans ([],sep) tail + in (first, List.rev list), Some term } +%end + +(* The following are specific to the present grammar *) + +list ::= "[" item ";" etc. "]" + +tuple ::= item "," item "," etc. + +par ::= "(" item ")" + +(* Entry *) + +program == statement* + +statement ::= + let_declarations { `Let } +| type_declaration { `TypeDecl } + +(* Type declarations *) + +type_declaration == "type" type_name "=" type_expr + +type_name == ident + +type_expr ::= + cartesian { `T_Prod } +| sum_type { `T_Sum } +| record_type { `T_Record } + +cartesian == fun_type "*" etc. + +fun_type ::= + core_type "->" fun_type { `T_Fun } +| core_type { `T_Core } + +core_type ::= + type_name { `T_Alias } +| type_param type_constr { `T_App } +| par + +type_param ::= + par +| core_type type_constr { `T_App } + +type_constr ::= + ident { `T_Constr } +| "set" +| "map" +| "list" + +sum_type == "|"? variant "|" etc. + +variant == constr "of" cartesian + +constr == uident + +record_type == + "{" sep_or_term_list "}" + +field_decl == field_name ":" type_expr + +field_name == ident + +(* Non-recursive value declarations *) + +let_declarations == "let" let_bindings + +let_bindings == let_binding "and" etc. + +let_binding ::= + variable sub_irrefutable+ "=" expr { `LetFun } +| irrefutable "=" expr { `LetNonFun } + +(* Patterns *) + +irrefutable ::= + tuple { `P_Tuple } +| sub_irrefutable + +sub_irrefutable ::= + variable { `P_Var } +| "_" { `P_Wild } +| unit { `P_Unit } +| par + +closed_irrefutable ::= + tuple +| sub_irrefutable { `P_SubI } + +pattern ::= + sub_pattern "::" tail { `P_Cons } +| tuple { `P_Tuple } +| core_pattern { `P_Core } + +sub_pattern ::= + par +| core_pattern { `P_Core } + +core_pattern ::= + variable { `P_Var } +| "_" { `P_Wild } +| unit { `P_Unit } +| integer { `P_Int } +| natural { `P_Nat } +| "true" { `P_True } +| "false" { `P_False } +| str { `P_Str } +| chr { `P_Chr } +| list { `P_List } +| constr sub_pattern { `P_Constr } +| record_pattern { `P_Record } +| par> + +variable == ident + +record_pattern ::= + "{" sep_or_term_list "}" + +field_pattern ::= field_name "=" sub_pattern + +unit ::= "(" ")" + +tail ::= + sub_pattern "::" tail +| sub_pattern + +(* Expressions *) + +expr ::= + base_cond__ +| match_expr + +base_cond__ ::= + base_expr +| conditional + +base_cond == base_cond__ + +base_expr ::= + let_expr +| fun_expr +| csv + +conditional ::= + if_then_else +| if_then + +if_then ::= + "if" expr "then" right_expr { `IfThen } + +if_then_else ::= + "if" expr "then" closed_if "else" right_expr { `IfThenElse } + +base_if_then_else__ ::= + base_expr +| if_then_else + +base_if_then_else ::= + base_if_then_else__ + +closed_if ::= + base_if_then_else__ +| match_expr + +match_expr ::= + "match" expr "with" cases + +cases ::= + case +| cases "|" case + +case ::= pattern "->" right_expr + +let_in ::= "let" par_let "in" right_expr + +fun_expr ::= "fun" sub_pattern+ "->" right_expr + +op_expr ::= + op_expr "||" op_expr +| op_expr "&&" op_expr +| op_expr "<" op_expr +| op_expr "<=" op_expr +| op_expr ">" op_expr +| op_expr ">=" op_expr +| op_expr "=" op_expr +| op_expr "<>" op_expr +| op_expr "^" op_expr +| op_expr "::" op_expr +| op_expr "+" op_expr +| op_expr "-" op_expr +| op_expr "*" op_expr +| op_expr "/" op_expr +| op_expr "div" op_expr +| op_expr "mod" op_expr +| "-" op_expr +| "not" op_expr +| call_expr + +call_expr ::= + call_expr core_expr +| core_expr + +core_expr ::= + variable +| module_name "." path +| unit +| integer +| natural +| "false" +| "true" +| str +| chr +| constr +| sequence +| record_expr +| list +| par + +module_name == uident + +path == ident "." etc. + +record_expr ::= + "{" sep_or_term_list "}" + +field_assignment ::= field_name "=" expr + +sequence ::= "begin" sep_or_term_list? "end" From d2f4d00011c8dbe9b342836ec1b930073568ed77 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Wed, 24 Jul 2019 14:34:26 +0200 Subject: [PATCH 04/12] Refactored module EvalOpt by removing useless command line options. --- src/parser/ligodity/EvalOpt.ml | 70 +++++++-------------------------- src/parser/ligodity/EvalOpt.mli | 16 ++------ src/parser/ligodity/Parser.mly | 7 ++-- 3 files changed, 21 insertions(+), 72 deletions(-) diff --git a/src/parser/ligodity/EvalOpt.ml b/src/parser/ligodity/EvalOpt.ml index 47731d9c7..5bd4d13a1 100644 --- a/src/parser/ligodity/EvalOpt.ml +++ b/src/parser/ligodity/EvalOpt.ml @@ -1,12 +1,9 @@ -(* Parsing the command-line option for the Mini-ML compiler/interpreter *) +(* Parsing the command-line option for CameLIGO *) type options = { - input : string option; - eval : bool; - compile : string option; - libs : string list; - verbose : Utils.String.Set.t; - raw_edits : bool + input : string option; + libs : string list; + verbose : Utils.String.Set.t } let abort msg = @@ -19,16 +16,12 @@ let sprintf = Printf.sprintf let help () = let file = Filename.basename Sys.argv.(0) in - printf "Usage: %s [