(* 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"
