%{

open Quad
open Common
open Comp
open Karel


%}

/* Ensemble des non terminaux */
%token BEGIN_PROG
%token BEGIN_EXEC
%token END_EXEC
%token END_PROG

%token MOVE
%token TURN_LEFT
%token TURN_OFF

%token SEMI
%token BEGIN
%token END

%token PICK_BEEPER
%token PUT_BEEPER
%token NEXT_TO_A_BEEPER
%token NOT_NEXT_TO_A_BEEPER


%token FRONT_IS_CLEAR
%token FRONT_IS_BLOCKED
%token LEFT_IS_CLEAR
%token LEFT_IS_BLOCKED
%token RIGHT_IS_CLEAR
%token RIGHT_IS_BLOCKED

%token FACING_NORTH
%token NOT_FACING_NORTH
%token FACING_EAST
%token NOT_FACING_EAST
%token FACING_WEST
%token NOT_FACING_WEST
%token FACING_SOUTH
%token NOT_FACING_SOUTH

%token ANY_BEEPERS_IN_BEEPER_BAG
%token NO_BEEPERS_IN_BEEPER_BAG

%token ITERATE
%token TIMES

%token WHILE
%token DO

%token IF
%token THEN
%token ELSE

%token DEFINE_NEW_INSTRUCTION
%token AS

%token <string> ID
%token <int> INT


%type <unit> prog
%start prog

%%

prog:   BEGIN_PROG subprgs BEGIN_EXEC stmts_opt END_EXEC END_PROG {
    ()
};

stmts_opt:
|       { () }
|   stmts { () }
;

stmts:
| stmt                { () }
|   stmts SEMI stmt { () }
|   stmts SEMI        { () }
;

stmt:
| opened_stmt { () }
| closed_stmt { () };



opened_stmt:
| IF test THEN stmt {()}
|   IF test THEN closed_stmt ELSE opened_stmt   {()}
|   ITERATE INT TIMES opened_stmt   {()}
|   WHILE test DO opened_stmt   {()}


closed_stmt:
|   simple_stmt {()}
|   ITERATE INT TIMES closed_stmt   {()}
|   WHILE test DO closed_stmt {()}
|   BEGIN stmts END {()}
|   IF test THEN closed_stmt ELSE closed_stmt {()}

simple_stmt:
    | TURN_LEFT {
        gen (INVOKE (turn_left, 0, 0))
    }
    |   TURN_OFF {
        gen STOP
    }
    |   MOVE {
        gen (INVOKE (move, 0, 0))
    }
    | PUT_BEEPER {
        gen (INVOKE (put_beeper, 0, 0))
    }
    | PICK_BEEPER {
        gen (INVOKE (pick_beeper, 0, 0))
    }
    | ID {
        if (is_defined $1) then
            ()
        else
            (raise (SyntaxError ("Le sous programme suivant n'existe pas : " ^ $1)))
    };

test:
    | FRONT_IS_CLEAR { () }
    | FRONT_IS_BLOCKED { () }
    | LEFT_IS_CLEAR { () }
    | LEFT_IS_BLOCKED { () }
    | RIGHT_IS_CLEAR { () }
    | RIGHT_IS_BLOCKED { () }
    | NEXT_TO_A_BEEPER { () }
    | NOT_NEXT_TO_A_BEEPER { () }
    | FACING_NORTH { () }
    | NOT_FACING_NORTH { () }
    | FACING_EAST { () }
    | NOT_FACING_EAST { () }
    | FACING_SOUTH { () }
    | NOT_FACING_SOUTH { () }
    | FACING_WEST { () }
    | NOT_FACING_WEST { () }
    | ANY_BEEPERS_IN_BEEPER_BAG { () }
    | NO_BEEPERS_IN_BEEPER_BAG { () };

define_new:
    | DEFINE_NEW_INSTRUCTION ID AS stmts {
        if (is_defined $2) then
            (raise (SyntaxError ("Le nom de sous-programme suivant est deja utilise : " ^ $2)))
        else
            (define $2 0)
    };

subprgs:
    | { () }
    | define_new subprgs { () };