First import of my first designs for a front-end generator for Ligodity.

This commit is contained in:
Christian Rinderknecht 2019-07-14 16:41:52 +02:00
parent 6d3679290d
commit 685c25de9a
5 changed files with 1421 additions and 0 deletions

View File

@ -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

View File

@ -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 ...
| (item sep)+
seq<item> ::= nseq<item>?
nseq<item> ::= item seq<item>
nsepseq<item,sep> ::=
item
| item sep nsepseq<item,sep>
sepseq<item,sep> ::= nsepseq<item,sep>?
(* The following are specific to the present grammar *)
list_of<item> ::= "[" item ";" ... "]"
csv<item> ::= 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_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<cons_pat>
| "(" ptuple ")"
| constr core_pattern
variable == ident
number == int
ptuple ::= csv<cons_pat>
unit ::= "(" ")"
cons_pat ::=
pattern "::" cons_pat
| pattern
pattern ::=
"(" cons_pat ")"
| core_pattern
(* Expressions *)
expr ::=
base_cond__open<expr>
| match_expr<base_cond>
base_cond__open<x> ::=
base_expr<x>
| conditional<x>
base_cond ::= base_cond__open<base_cond>
base_expr<right_expr> ::=
let_expr<right_expr>
| fun_expr<right_expr>
| csv<op_expr>
| op_expr
conditional<right_expr> ::=
if_then_else<right_expr>
| if_then<right_expr>
if_then<right_expr> ::= "if" expr "then" right_expr
if_then_else<right_expr> ::=
"if" expr "then" closed_if "else" right_expr
base_if_then_else__open<x> ::=
base_expr<x>
| if_then_else<x>
base_if_then_else ::=
base_if_then_else__open<base_if_then_else>
closed_if ::=
base_if_then_else__open<closed_if>
| match_expr<base_if_then_else>
match_expr<right_expr> ::=
"match" expr "with" cases<right_expr>
cases<right_expr> ::=
case<right_expr>
| cases<base_cond> "|" case<right_expr>
case<right_expr> ::= let_lhs "->" right_expr
let_in<right_expr> ::= "let" par_let "in" right_expr
fun_expr<right_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>
| "(" 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"

View File

@ -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 ...
| (item sep)+
seq<item> ::= nseq<item>?
nseq<item> ::= item seq<item>
nsepseq<item,sep> ::=
item
| item sep nsepseq<item,sep>
sepseq<item,sep> ::= nsepseq<item,sep>?
(* The following are specific to the present grammar *)
list_of<item> ::= "[" item ";" ... "]"
csv<item> ::= 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_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<cons_pat>
| "(" ptuple ")"
| constr core_pattern
variable == ident
number == int
ptuple ::= csv<cons_pat>
unit ::= "(" ")"
cons_pat ::=
pattern "::" cons_pat
| pattern
pattern ::=
"(" cons_pat ")"
| core_pattern
(* Expressions *)
expr ::=
base_cond__open<expr>
| match_expr<base_cond>
base_cond__open<x> ::=
base_expr<x>
| conditional<x>
base_cond ::= base_cond__open<base_cond>
base_expr<right_expr> ::=
let_expr<right_expr>
| fun_expr<right_expr>
| csv<op_expr>
| op_expr
conditional<right_expr> ::=
if_then_else<right_expr>
| if_then<right_expr>
if_then<right_expr> ::= "if" expr "then" right_expr
if_then_else<right_expr> ::=
"if" expr "then" closed_if "else" right_expr
base_if_then_else__open<x> ::=
base_expr<x>
| if_then_else<x>
base_if_then_else ::=
base_if_then_else__open<base_if_then_else>
closed_if ::=
base_if_then_else__open<closed_if>
| match_expr<base_if_then_else>
match_expr<right_expr> ::=
"match" expr "with" cases<right_expr>
cases<right_expr> ::=
case<right_expr>
| cases<base_cond> "|" case<right_expr>
case<right_expr> ::= let_lhs "->" right_expr
let_in<right_expr> ::= "let" par_let "in" right_expr
fun_expr<right_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>
| "(" 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"

View File

@ -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> ::=
item sep etc.
| (item sep)+
seq<item> ::= nseq<item>?
nseq<item> ::= item seq<item>
nsepseq<item,sep> ::=
item
| item sep nsepseq<item,sep>
sepseq<item,sep> ::= nsepseq<item,sep>?
(* The following are specific to the present grammar *)
list_of<item> ::= "[" item ";" etc. "]"
csv<item> ::= 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_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<cons_pat>
| "(" ptuple ")"
| constr core_pattern
variable == ident
number == int
ptuple ::= csv<cons_pat>
unit ::= "(" ")"
cons_pat ::=
pattern "::" cons_pat
| pattern
pattern ::=
"(" cons_pat ")"
| core_pattern
(* Expressions *)
expr ::=
base_cond__<expr>
| match_expr<base_cond>
base_cond__<x> ::=
base_expr<x>
| conditional<x>
base_cond ::= base_cond__<base_cond>
base_expr<right_expr> ::=
let_expr<right_expr>
| fun_expr<right_expr>
| csv<op_expr>
| op_expr
conditional<right_expr> ::=
if_then_else<right_expr>
| if_then<right_expr>
if_then<right_expr> ::= "if" expr "then" right_expr
if_then_else<right_expr> ::=
"if" expr "then" closed_if "else" right_expr
base_if_then_else__<x> ::=
base_expr<x>
| if_then_else<x>
base_if_then_else ::=
base_if_then_else__<base_if_then_else>
closed_if ::=
base_if_then_else__<closed_if>
| match_expr<base_if_then_else>
match_expr<right_expr> ::=
"match" expr "with" cases<right_expr>
cases<right_expr> ::=
case<right_expr>
| cases<base_cond> "|" case<right_expr>
case<right_expr> ::= let_lhs "->" right_expr
let_in<right_expr> ::= "let" par_let "in" right_expr
fun_expr<right_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>
| "(" expr ")"
| constr
| sequence
| record_expr
module_name == uident
record_expr ::=
"{" sep_or_term_list<field_assignment,";"> "}"
field_assignment ::= field_name "=" expr
sequence ::= "begin" sep_or_term_list<expr,";">? "end"

View File

@ -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 <AST.t> program
%type <AST.expr> 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> ::= "[" item ";" etc. "]"
tuple<item> ::= item "," item "," etc.
par<item> ::= "(" 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<cartesian>
type_param ::=
par<type_expr "," etc.>
| 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_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<sub_irrefutable> { `P_Tuple }
| sub_irrefutable
sub_irrefutable ::=
variable { `P_Var }
| "_" { `P_Wild }
| unit { `P_Unit }
| par<closed_irrefutable>
closed_irrefutable ::=
tuple<sub_irrefutable>
| sub_irrefutable { `P_SubI }
pattern ::=
sub_pattern "::" tail { `P_Cons }
| tuple<sub_pattern> { `P_Tuple }
| core_pattern { `P_Core }
sub_pattern ::=
par<tail>
| 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<tail> { `P_List }
| constr sub_pattern { `P_Constr }
| record_pattern { `P_Record }
| par<tuple<tail>>
variable == ident
record_pattern ::=
"{" sep_or_term_list<field_pattern,";"> "}"
field_pattern ::= field_name "=" sub_pattern
unit ::= "(" ")"
tail ::=
sub_pattern "::" tail
| sub_pattern
(* Expressions *)
expr ::=
base_cond__<expr>
| match_expr<base_cond>
base_cond__<x> ::=
base_expr<x>
| conditional<x>
base_cond == base_cond__<base_cond>
base_expr<right_expr> ::=
let_expr<right_expr>
| fun_expr<right_expr>
| csv<op_expr>
conditional<right_expr> ::=
if_then_else<right_expr>
| if_then<right_expr>
if_then<right_expr> ::=
"if" expr "then" right_expr { `IfThen }
if_then_else<right_expr> ::=
"if" expr "then" closed_if "else" right_expr { `IfThenElse }
base_if_then_else__<x> ::=
base_expr<x>
| if_then_else<x>
base_if_then_else ::=
base_if_then_else__<base_if_then_else>
closed_if ::=
base_if_then_else__<closed_if>
| match_expr<base_if_then_else>
match_expr<right_expr> ::=
"match" expr "with" cases<right_expr>
cases<right_expr> ::=
case<right_expr>
| cases<base_cond> "|" case<right_expr>
case<right_expr> ::= pattern "->" right_expr
let_in<right_expr> ::= "let" par_let "in" right_expr
fun_expr<right_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<expr>
| par<expr>
module_name == uident
path == ident "." etc.
record_expr ::=
"{" sep_or_term_list<field_assignment,";"> "}"
field_assignment ::= field_name "=" expr
sequence ::= "begin" sep_or_term_list<expr,";">? "end"