%{
open LogoRep
%}

%start start

%token <string> ID
%token <int> INT
%token LBRACE RBRACE COMMA PLUS MINUS MUL DIV LPAREN RPAREN EOF
%token LTURN RTURN FORWARD PEN COLOR IF REPEAT SPLIT DEFINE

%left PLUS MINUS
%left MUL DIV

%type <prog> start

%%

start: prog EOF { let ss, bs = $1 Map.empty in Prog (ss, List.toArray bs) }

prog:                       { fun _  -> [], [] }
    | stmt prog             { fun fs -> let ss, bs = $2 fs in $1 fs Map.empty :: ss, bs }
    | DEFINE newmethod prog { fun fs -> let b, fs' = $2 fs
                                        let ss, bs = $3 fs' in ss, b :: bs }


newmethod: ID LPAREN args RPAREN LBRACE stmts RBRACE { fun fs ->
  if fs.ContainsKey $1 then failwithf "Cannot redefine existing method '%s'" $1
  let fs' = fs.Add ($1, fs.Count)
  let add_arg (m:Map<_,_>) a = if m.ContainsKey a then failwithf "Argument '%s' of function '%s' is duplicated" a $1
                               m.Add (a, m.Count)
  (List.length $3, $6 fs' (List.fold add_arg Map.empty $3)), fs'
}
args:                       { [] }
        | someargs          { $1 }
someargs: ID                { [$1] }
        | ID COMMA someargs { $1 :: $3}


stmt: LTURN   LPAREN expr RPAREN                       { fun _  vs -> Turn ($3 vs) }
    | RTURN   LPAREN expr RPAREN                       { fun _  vs -> Turn (Minus (Int 0, ($3 vs))) }
    | FORWARD LPAREN expr RPAREN                       { fun _  vs -> Forward ($3 vs) }
    | PEN     LPAREN expr RPAREN                       { fun _  vs -> Pen ($3 vs) }
    | COLOR   LPAREN expr COMMA expr COMMA expr RPAREN { fun _  vs -> Color ($3 vs, $5 vs, $7 vs) }
    | IF      LPAREN expr RPAREN LBRACE stmts RBRACE   { fun fs vs -> If ($3 vs, $6 fs vs) }
    | REPEAT  LPAREN expr RPAREN LBRACE stmts RBRACE   { fun fs vs -> Repeat ($3 vs, $6 fs vs) }
    | SPLIT   LBRACE stmts RBRACE                      { fun fs vs -> Split ($3 fs vs) }
    | ID      LPAREN exps RPAREN                       { fun fs vs -> match fs.TryFind $1 with
                                                                      | Some i -> UserFun ($3 vs, i)
                                                                      | None   -> failwithf "Unknown function '%s'" $1
                                                       }
stmts:            { fun _  _  -> [] }
     | stmt stmts { fun fs vs -> $1 fs vs :: $2 fs vs }


expr: INT                  { fun _  -> Int $1 }
    | ID                   { fun vs -> match vs.TryFind $1 with
                                       | Some i -> Var i
                                       | None   -> failwithf "Unknown variable '%s'" $1
                           }
    | expr PLUS expr       { fun vs -> Plus ($1 vs, $3 vs) }
    | expr MINUS expr      { fun vs -> Minus ($1 vs, $3 vs) }
    | expr MUL expr        { fun vs -> Mul ($1 vs, $3 vs) }
    | expr DIV expr        { fun vs -> Div ($1 vs, $3 vs) }
    | MINUS expr %prec MUL { fun vs -> Minus (Int 0, $2 vs) }
    | LPAREN expr RPAREN   { fun vs -> $2 vs }

exps:                         { fun _  -> [] }
        | someexps            { $1 }
someexps: expr                { fun vs -> [$1 vs] }
        | expr COMMA someexps { fun vs -> $1 vs :: $3 vs }