{
module ParseIntel  where

import Data.Int

import GenSym
import Frame -- Acc
import Intel
import TokenIntel hiding (Label, Temp, Reg)
import qualified TokenIntel as Tok
import LexIntel
import FrameIntel

}

%tokentype { (Token AlexPosn) }

%name parse

%token
  	'['		{ LBrack _ }
  	']'		{ RBrack _ }
  	':' 		{ Colon _ }
  	',' 		{ Comma _ }
  	'.' 		{ Dot _ }
  	'+' 		{ Plus _ }
  	'-'		{ Minus _ }
  	'*' 		{ Times _ }
        '0'             { Nat 0 _ }
        '2'             { Nat 2 _ }
        '4'             { Nat 4 _ }
        '8'             { Nat 8 _ }

        args            { Args _ }
        loc             { LOC _ }
        rg              { REG _ }

        mov             { Mov _ }
        add             { Add _ }
        sub             { Sub _ }
        shl             { Shl _ }
        shr             { Shr _ }
        sal             { Sal _ }
        sar             { Sar _ }
        and             { And _ }
        or              { Or _ }
        xor             { Xor _ }
        neg             { Neg _ }
        not             { Not _ }
        inc             { Inc _ }
        dec             { Dec _ }
        pop             { Pop _ }
        push            { Push _ }
        imul            { Imul _ }
        idiv            { Idiv _ }
  	jmp             { Jmp _ }
        lea             { Lea _ }
  	cmp             { Cmp _ }
        je              { Je _  }
        jne             { Jne _ }
        jl              { Jl _ }
        jle             { Jle _ }
        jg              { Jg _ }
        jge             { Jge _ }
        call            { Call _ }
        ret             { Ret _ }
        enter           { Enter _ }
        leave           { Leave _ }
        nop             { Nop _ }

        dword           { Dword _ }
        ptr             { Ptr _ }

        nat             { Nat $$ _ }
        temp            { Tok.Temp $$ _ }
        reg             { Tok.Reg $$ _ }
        label           { Id $$ _ }

%%

-- a function starts with a label and ends with "ret"

Prg  :: { [IntelFrame] }
Prg  : {- empty -}        { [] }
     | Label MaybeArgs IList         { [Frame $1 (mkFrameData $2) $3] }
     | Label MaybeArgs IList ret Prg { (Frame $1 (mkFrameData $2) ($3 ++ [RET])) : $5 }

MaybeArgs :: { [Acc] }
MaybeArgs : {- empty -}   { [] }
          | args          { [] }
          | args Args     { $2 }

Args :: { [Acc] }
Args : Arg                { [ $1 ] }
     | Arg ',' Args       { $1 : $3 }

Arg :: { Acc }
Arg : loc Nat             { InFrame (fromIntegral $2) }
    | rg temp             { InReg (Temp $2) }

IList :: { [Instr] }
IList :                { [ ] }
      | Instr IList       { $1 : $2 }

Instr :: { Instr }
Instr : Label             { LABEL $1 }
      | DS Dest ',' Src   { DS $1 $2 $4 }
      | D  Dest           { D  $1 $2 }
      | lea Reg ',' dword ptr '[' Addr ']'  { LEA $2 $7 }
      | cmp Dest ',' Src  { CMP $2 $4 }
      | push Src          { PUSH $2 }
      | imul Reg ',' Dest { DS IMUL2 (Reg $2) (Dest $4) } -- Dest because no Imm
      | imul Dest         { IMUL $2 }     -- Dest because no Imm
      | idiv Dest         { IDIV $2 }     -- Dest because no Imm
      | jmp  label        { JMP  $2 }
      | CJmp label        { J $1 $2 }
      | call label        { CALL $2 }
      | enter Nat ',' '0' { ENTER $2 }
      | leave             { LEAVE }
      | nop               { NOP }
--      | ret               { RET }

-- a Label ends in a colon

Label :: { Label }
Label : label ':'         { $1 }

-- instruction taking both destination and source

DS :: { DS }
DS    : mov               { MOV }
      | add               { ADD }
      | sub               { SUB }
      | shl               { SHL }
      | shr               { SHR }
      | sal               { SAL }
      | sar               { SAR }
      | and               { AND }
      | or                { OR  }
      | xor               { XOR }

-- instruction taking only destination

D :: { D }
D     : pop               { POP }
      | neg               { NEG }
      | not               { NOT }
      | inc               { INC }
      | dec               { DEC }

-- conditional jump

CJmp :: { Cond }
CJmp  : je                { E  }
      | jne               { NE }
      | jl                { L  }
      | jle               { LE }
      | jg                { G  }
      | jge               { GE }

-- operands

Src :: { Src }
Src   : Int               { Imm $1  }
      | Dest              { Dest $1 }

Dest :: { Dest }
Dest  : Reg               { Reg $1 }
      | dword ptr '[' Addr ']'  { ( \ (a,b,c,d) -> Mem a b c d) $4 }

Reg :: { Reg }
Reg   : reg               { Fixed $1 }
      | temp              { Flex (Temp $1)  }

Addr :: { EA }
Addr  : Reg                             { (,,,) $1 Nothing Nothing 0 }

      | Reg '+' Nat                     { (,,,) $1 Nothing Nothing $3 }
      | Reg '+' Reg                     { (,,,) $1 Nothing (Just $3) 0 }
      | Int '+' Reg                     { (,,,) $3 Nothing Nothing $1 }

      | Reg '+' Reg '+' Nat             { (,,,) $1 Nothing (Just $3) $5 }
      | Reg '+' Nat '+' Reg             { (,,,) $1 Nothing (Just $5) $3 }
      | Int '+' Reg '+' Reg             { (,,,) $3 Nothing (Just $5) $1 }

      | Reg '*' Scl                     { (,,,) $1 (Just $3) Nothing 0 }
      | Scl '*' Reg                     { (,,,) $3 (Just $1) Nothing 0 }

      | Reg '*' Scl '+' Nat             { (,,,) $1 (Just $3) Nothing $5 }
      | Scl '*' Reg '+' Nat             { (,,,) $3 (Just $1) Nothing $5 }
      | Reg '*' Scl '+' Reg             { (,,,) $1 (Just $3) (Just $5) 0 }
      | Scl '*' Reg '+' Reg             { (,,,) $3 (Just $1) (Just $5) 0 }

      | Int '+' Reg '*' Scl             { (,,,) $3 (Just $5) Nothing $1 }
      | Int '+' Scl '*' Reg             { (,,,) $5 (Just $3) Nothing $1 }
      | Reg '+' Reg '*' Scl             { (,,,) $3 (Just $5) (Just $1) 0 }
      | Reg '+' Scl '*' Reg             { (,,,) $5 (Just $3) (Just $1) 0 }

      | Reg '*' Scl '+' Nat '+' Reg     { (,,,) $1 (Just $3) (Just $7) $5 }
      | Scl '*' Reg '+' Nat '+' Reg     { (,,,) $3 (Just $1) (Just $7) $5 }
      | Reg '*' Scl '+' Reg '+' Nat     { (,,,) $1 (Just $3) (Just $5) $7 }
      | Scl '*' Reg '+' Reg '+' Nat     { (,,,) $3 (Just $1) (Just $5) $7 }

      | Int '+' Reg '*' Scl '+' Reg     { (,,,) $3 (Just $5) (Just $7) $1 }
      | Int '+' Scl '*' Reg '+' Reg     { (,,,) $5 (Just $3) (Just $7) $1 }
      | Reg '+' Reg '*' Scl '+' Nat     { (,,,) $3 (Just $5) (Just $1) $7 }
      | Reg '+' Scl '*' Reg '+' Nat     { (,,,) $5 (Just $3) (Just $1) $7 }

      | Reg '+' Nat '+' Reg '*' Scl     { (,,,) $5 (Just $7) (Just $1) $3 }
      | Reg '+' Nat '+' Scl '*' Reg     { (,,,) $7 (Just $5) (Just $1) $3 }
      | Int '+' Reg '+' Reg '*' Scl     { (,,,) $5 (Just $7) (Just $3) $1 }
      | Int '+' Reg '+' Scl '*' Reg     { (,,,) $7 (Just $5) (Just $3) $1 }

-- negative displacement

      | Reg '-' Nat                     { (,,,) $1 Nothing Nothing (- $3) }

      | Reg '+' Reg '-' Nat             { (,,,) $1 Nothing (Just $3) (- $5) }
      | Reg '-' Nat '+' Reg             { (,,,) $1 Nothing (Just $5) (- $3) }

      | Reg '*' Scl '-' Nat             { (,,,) $1 (Just $3) Nothing (- $5) }
      | Scl '*' Reg '-' Nat             { (,,,) $3 (Just $1) Nothing (- $5) }

      | Reg '*' Scl '-' Nat '+' Reg     { (,,,) $1 (Just $3) (Just $7) (- $5) }
      | Scl '*' Reg '-' Nat '+' Reg     { (,,,) $3 (Just $1) (Just $7) (- $5) }
      | Reg '*' Scl '+' Reg '-' Nat     { (,,,) $1 (Just $3) (Just $5) (- $7) }
      | Scl '*' Reg '+' Reg '-' Nat     { (,,,) $3 (Just $1) (Just $5) (- $7) }

      | Reg '+' Reg '*' Scl '-' Nat     { (,,,) $3 (Just $5) (Just $1) (- $7) }
      | Reg '+' Scl '*' Reg '-' Nat     { (,,,) $5 (Just $3) (Just $1) (- $7) }

      | Reg '-' Nat '+' Reg '*' Scl     { (,,,) $5 (Just $7) (Just $1) (- $3) }
      | Reg '-' Nat '+' Scl '*' Reg     { (,,,) $7 (Just $5) (Just $1) (- $3) }


-- currently only support scaling by 4

Scl :: { Scale }
Scl   : '2'                         { S2 }
      | '4'                         { S4 }
      | '8'                         { S8 }

Nat :: { Int32 }
Nat   : '0'                         { fromIntegral 0  }
      | '2'                         { fromIntegral 2  }
      | '4'                         { fromIntegral 4  }
      | '8'                         { fromIntegral 8  }
      | nat                         { fromIntegral $1 }

Int :: { Int32 }
Int   : Nat                         { $1     }
      | '-' Nat                     { (- $2) }
{

happyError :: [Token AlexPosn] -> a
happyError tks = error ("Parse error at " ++ lcn ++ "\n")
	where
	lcn = 	case tks of
		  [] -> "end of file"
		  (tk:_) -> "line " ++ show l ++ ", column " ++ show c ++ " (token " ++ filterPn (show tk) ++ ")"
			where AlexPn _ l c = token_pos tk

}