civicaml/parser.mly

%{
    (**
     * Parser for the CiviC language.
     *
     * Note that some shift/reduce conflicts exist, but these need not be solved
     * since menhir can automatically resolve them
     *)

    open Lexing
    open Types

    let loc start stop = [Loc (Util.loc_from_lexpos start stop)]

    let rec make_dims dimloc = function
        | [] -> []
        | dim :: tail -> Dim (dim, dimloc) :: (make_dims dimloc tail)

    let rec make_args = function
        | [] -> []
        | h::t -> Arg h :: (make_args t)
%}

(* Tokens *)
%token LPAREN RPAREN LBRACK RBRACK LBRACE RBRACE SEMICOL COMMA
%token NOT ADD SUB MUL DIV MOD
%token EQ NE LT LE GT GE
%token AND OR
%token ASSIGN IF ELSE WHILE DO FOR RETURN EXTERN EXPORT
%token INT BOOL FLOAT VOID
%token EOF

%token <bool> BOOL_CONST
%token <float> FLOAT_CONST
%token <int> INT_CONST
%token <string> ID

(* Precedence *)
(*%right ASSIGN*)
%left OR
%left AND
%left EQ NE
%left LT LE GT GE
%left ADD SUB
%left MUL DIV MOD
%right NOT NEG CAST

%nonassoc IF
%nonassoc ELSE

(* Start symbol *)
%type <Types.node> program
%start program

%%

basic_type:
    | FLOAT { Float }
    | INT   { Int }
    | BOOL  { Bool }

program:
    decl*; EOF
    { Program ($1, loc $startpos $endpos) }

decl:
    (* function: use location of function name *)
    | EXTERN; hdr=fun_header; SEMICOL
    { let (t, n, p, nameloc) = hdr in
      FunDec(t, n, p, nameloc) }

    | export=boption(EXPORT); hdr=fun_header; LBRACE; body=fun_body; RBRACE
    { let (t, n, p, nameloc) = hdr in
      FunDef (export, t, n, p, Block body, nameloc) }

    (* global variable declaration: use location of variable name *)
    | EXTERN; ctype=basic_type; name=ID; SEMICOL
    { GlobalDec (ctype, name, loc $startpos $endpos) }

    | EXTERN; ctype=basic_type;
      LBRACK; dims=separated_list(COMMA, ID); RBRACK;
      name=ID; SEMICOL
    { let dimloc = loc $startpos(dims) $endpos(dims) in
      let loc = loc $startpos(name) $endpos(name) in
      GlobalDec (Array (ctype, make_dims dimloc dims), name, loc) }

    | export=boption(EXPORT); ctype=basic_type; name=ID; SEMICOL
    { let loc = loc $startpos(name) $endpos(name) in
      GlobalDef (export, ctype, name, None, loc) }

    | export=boption(EXPORT); ctype=basic_type; name=ID; ASSIGN; init=expr; SEMICOL
    { let loc = loc $startpos(name) $endpos(name) in
      GlobalDef (export, ctype, name, Some init, loc) }

    | export=boption(EXPORT); ctype=basic_type;
      LBRACK; dims=separated_list(COMMA, expr); RBRACK;
      name=ID; SEMICOL
    { let loc = loc $startpos(name) $endpos(name) in
      GlobalDef (export, Array (ctype, dims), name, None, loc) }

fun_header:
    (* function header: use location of function name *)
    | ret=basic_type; name=ID; LPAREN; params=separated_list(COMMA, param); RPAREN
    { (ret, name, params, loc $startpos(name) $endpos(name)) }

    | VOID; name=ID; LPAREN; params=separated_list(COMMA, param); RPAREN
    { (Void, name, params, loc $startpos(name) $endpos(name)) }

param:
    (* parameter: use location of parameter name *)
    | ctype=basic_type; name=ID
    { Param (ctype, name, loc $startpos(name) $endpos(name)) }

    | ctype=basic_type; LBRACK; dims=separated_list(COMMA, ID); RBRACK; name=ID
    { let dimloc = loc $startpos(dims) $endpos(dims) in
      let loc = loc $startpos(name) $endpos(name) in
      Param (Array (ctype, make_dims dimloc dims), name, loc) }

fun_body:
    | var_dec* local_fun_dec* statement* loption(return_statement)
    { $1 @ $2 @ $3 @ $4 }

return_statement:
    (* return statement: use location of return value *)
    | RETURN; value=expr; SEMICOL
    { [Return (value, loc $startpos(value) $endpos(value))] }

(* function: use location of function name *)
local_fun_dec:
    hdr=fun_header; LBRACE; body=fun_body; RBRACE
    { let (t, n, p, nameloc) = hdr in
      FunDef (false, t, n, p, Block body, nameloc) }

var_dec:
    (* variable declaration: use location of variable name *)
    | ctype=basic_type; name=ID; SEMICOL
    { VarDec (ctype, name, None, loc $startpos(name) $endpos(name)) }

    | ctype=basic_type; name=ID; ASSIGN; init=expr; SEMICOL
    { VarDec (ctype, name, Some init, loc $startpos(name) $endpos(name)) }

    | ctype=basic_type; LBRACK; dims=separated_list(COMMA, expr); RBRACK;
      name=ID; SEMICOL
    { let loc = loc $startpos(name) $endpos(name) in
      VarDec (Array (ctype, dims), name, None, loc) }

    | ctype=basic_type; LBRACK; dims=separated_list(COMMA, expr); RBRACK;
      name=ID; ASSIGN; init=expr; SEMICOL
    { let loc = loc $startpos(name) $endpos(name) in
      VarDec (Array (ctype, dims), name, Some init, loc) }

statement:
    (* assignment: use location of assigned variable name *)
    | name=ID; ASSIGN; value=expr; SEMICOL
    { Assign (name, None, value, loc $startpos(name) $endpos(name)) }

    | name=ID; LBRACK; dims=separated_list(COMMA, expr); brk=RBRACK;
      ASSIGN; value=expr; SEMICOL
    { Assign (name, Some dims, value, loc $startpos(name) $endpos(brk)) }

    | name=ID; LPAREN; args=separated_list(COMMA, expr); RPAREN; SEMICOL
    { Expr (FunCall (name, make_args args, loc $startpos(name) $endpos(name))) }

    (* if-statements and (do-)while-loops: use location of condition *)
    | IF; LPAREN; cond=expr; RPAREN; body=block
    { If (cond, Block body, loc $startpos $endpos) }                %prec IF

    | IF; LPAREN; c=expr; RPAREN; t=block; ELSE; f=block
    { IfElse (c, Block t, Block f, loc $startpos(c) $endpos(c)) }   %prec ELSE

    | WHILE; LPAREN; cond=expr; RPAREN; body=block
    { While (cond, Block body, loc $startpos(cond) $endpos(cond)) }

    | DO; body=block; WHILE; LPAREN; cond=expr; RPAREN; SEMICOL
    { DoWhile (cond, Block body, loc $startpos(cond) $endpos(cond)) }

    (* for-loop: use location of counter id *)
    | FOR; LPAREN; INT; cnt=ID; ASSIGN; start=expr; COMMA; stop=expr; RPAREN;
      body=block
    { let loc = loc $startpos(cnt) $endpos(cnt) in
        For (cnt, start, stop, IntConst (1, []), Block body, loc) }

    | FOR; LPAREN; INT; cnt=ID; ASSIGN; start=expr; COMMA; stop=expr; COMMA;
      step=expr; RPAREN; body=block
    { let loc = loc $startpos(cnt) $endpos(cnt) in
      For (cnt, start, stop, step, Block body, loc) }

block:
    | LBRACE; stats=statement*; RBRACE  { stats }
    | stat=statement                    { [stat] }

expr:
    | name=ID; LPAREN; args=separated_list(COMMA, expr); RPAREN
    { FunCall (name, make_args args, loc $startpos $endpos) }

    | LPAREN; expr; RPAREN              { $2 }
    | ID                                { Var ($1, None, loc $startpos $endpos) }
    | l=expr; op=binop; r=expr          { Binop (op, l, r, loc $startpos $endpos) }
    | SUB; expr                         { Monop (Neg, $2, loc $startpos $endpos) }    %prec NEG
    | NOT; expr                         { Monop (Not, $2, loc $startpos $endpos) }
    | LPAREN; basic_type; RPAREN; expr  { TypeCast ($2, $4, loc $startpos $endpos) }  %prec CAST
    | FLOAT_CONST                       { FloatConst ($1, loc $startpos $endpos) }
    | INT_CONST                         { IntConst ($1, loc $startpos $endpos) }
    | BOOL_CONST                        { BoolConst ($1, loc $startpos $endpos) }
    | ID; array_const                   { Var ($1, Some $2, loc $startpos $endpos) }
    | array_const                       { ArrayConst ($1, loc $startpos $endpos) }

%inline binop:
    | ADD  { Add }
    | SUB  { Sub }
    | MUL  { Mul }
    | DIV  { Div }
    | MOD  { Mod }
    | EQ   { Eq  }
    | NE   { Ne  }
    | LT   { Lt  }
    | LE   { Le  }
    | GT   { Gt  }
    | GE   { Ge  }
    | AND  { And }
    | OR   { Or  }

array_const:
    LBRACK; values=separated_list(COMMA, expr); RBRACK
    { values }

%%