 XOR  spec32 tmp1 cond tmp2,
                             CND tmp1, PLIMM p3f ifLabel] ++
                              c1 ++ [PLIMM p3f endLabel, LB jumpOnly ifLabel] ++
                              c2 ++ [LB jumpOnly endLabel]
            IR.While var cond body ->
                do c1 <- compile' cond
                   cv <- lookupVar var
                   c2 <- extendScope (compile' body)
                   startLabel <- genLabel
                   endLabel <- genLabel
                   return $ [LB jumpOnly startLabel] ++ c1 ++
                            [LIMM spec32 tmp2 (Imm 1), XOR spec32 tmp1 cv tmp2,
                             CND tmp1, PLIMM p3f endLabel] ++
                             c2 ++ [PLIMM p3f startLabel, LB jumpOnly endLabel]

            IR.Declare var S32Int val ->
                do defineVar var
                   r <- lookupVar var
                   v <- lookupVar val
                   return [OR spec32 r v v]
            IR.Declare var (Pointer _) val ->
                do definePtr var
                   p <- lookupPtr var
                   v <- lookupPtr val
                   return [PCP p v]
            IR.Arith op var e1 e2 ->
                do defineVar var
                   r  <- lookupVar var
                   v1 <- lookupVar e1
                   v2 <- lookupVar e2
                   return [arith op spec32 r v1 v2]

            IR.Comp op var e1 e2 ->
                do defineVar var
                   r  <- lookupVar var
                   v1 <- lookupVar e1
                   v2 <- lookupVar e2
                   return [comp op spec32 spec32  r v1 v2]
            IR.ConstS32Int var int ->
                do defineVar var
                   r <- lookupVar var
                   return [LIMM spec32 r (Imm (fromInteger (toInteger int)))]
            IR.Assign var S32Int val ->
                do r <- lookupVar var
                   v <- lookupVar val
                   return [OR spec32 r v v]
            IR.Assign var (Pointer _) val ->
                do p <- lookupPtr var
                   v <- lookupPtr val
                   return [PCP p v]

            IR.Load var ptr idx ->
                do defineVar var
                   v <- lookupVar var
                   p <- lookupPtr ptr
                   i <- lookupVar idx
                   return [PADD spec32 p3e p i, LMEM0 spec32 v p3e]
            IR.Store ptr idx val ->
                do p <- lookupPtr ptr
                   i <- lookupVar idx
                   v <- lookupVar val
                   return [PADD spec32 p3e p i, SMEM0 spec32 v p3e]
            IR.Call name vars ->
                case lookup name apiList of
                  Nothing -> error $ "function not found: " ++ name
                  Just (inst, regs) -> do  
                    args <- mapM lookupVar vars
                    let move = zipWith (\d s -> OR spec32 d s s) regs args
                    lb <- genLabel
                    return $ move ++ [LIMM spec32 (Reg 0x30) inst,
                                      PLIMM p30 lb,
                                      PCP p3f p2f,
                                      LB readWrite lb]
            IR.Data name dat ->
                do definePtr name
                   p <- lookupPtr name
                   lb <- genLabel
                   return $ [PLIMM p lb, LB readWrite lb, DATA dat]
            IR.DebugStop -> return [BREAK]
--         <* mapM_ (\v -> unless (v `elem` livingVars) re) IR.varRefs ir
test1 = AST [
         Declare (Var "x") S32Int (Arith () Add
                                   (Arith () Xor (ConstS32Int () 3) (ConstS32Int () 4))
                                   (ConstS32Int () 5))]
test2 = AST [
         Data    (Var "d") [1, 2, 3],
         Declare (Var "y") S32Int (Load () (GetVar () (Var "d")) (ConstS32Int () 1)),
         Store (GetVar () (Var "d")) (ConstS32Int () 3) (ConstS32Int () 4)
        ]

test3 = AST [
         Data (Var "d") [1, 2, 3],
         Declare (Var "y") (Pointer S32Int) (GetVar () (Var "d"))
        ]
test4 = AST [
         Declare (Var "i") S32Int (ConstS32Int () 0),
         While (GetVar () (Var "i")) (AST [])
        ]
test5 = AST [
         If (Comp () Cmpe (ConstS32Int () 3) (Cons
compile :: [IR.IR] -> Program
compile is = Program $ evalState (compile' is) (CS 0 emptyFrame)
    where
      compile' :: [IR.IR] -> State CompileState [Inst]
      compile' irs = concat <$> zipWithM compileIR irs (map concat $ tails $ map IR.varRefs irs)
          
      compileIR :: IR.IR -> [Var] -> State CompileState [Inst]
      compileIR ir livingVars =
          case ir of
            IR.If var csq alt ->
                do cond <- lookupVar var
                   c1 <- extendScope (compile' csq)
                   c2 <- extendScope (compile' alt)
                  
                   ifLabel <- genLabel
                   endLabel <- genLabel

                   return $ [LIMM spec32 tmp2 (Imm 1),
                             XOR  spec32 tmp1 cond tmp2,
                             CND tmp1, PLIMM p3f ifLabel] ++
                              c1 ++ [PLIMM p3f endLabel, LB jumpOnly ifLabel] ++
                              c2 ++ [LB jumpOnly endLabel]
            IR.While var cond body ->
                do c1 <- compile' cond
                   cv <- lookupVar var
                   c2 <- extendScope (compile' body)
                   startLabel <- genLabel
                   endLabel <- genLabel
                   return $ [LB jumpOnly startLabel] ++ c1 ++
                            [LIMM spec32 tmp2 (Imm 1), XOR spec32 tmp1 cv tmp2,
                             CND tmp1, PLIMM p3f endLabel] ++
                             c2 ++ [PLIMM p3f startLabel, LB jumpOnly endLabel]

            IR.Declare var S32Int val ->
                do defineVar var
                   r <- lookupVar var
                   v <- lookupVar val
                   return [OR spec32 r v v]
            IR.Declare var (Pointer _) val ->
                do definePtr var
                   p <- lookupPtr var
                   v <- lookupPtr val
                   return [PCP p v]
            IR.Arith op var e1 e2 ->
                do defineVar var
                   r  <- lookupVar var
                   v1 <- lookupVar e1
                   v2 <- lookupVar e2
                   return [arith op spec32 r v1 v2]

            IR.Comp op var e1 e2 ->
                do defineVar var
                   r  <- lookupVar var
                   v1 <- lookupVar e1
                   v2 <- lookupVar e2
                   return [comp op spec32 spec32  r v1 v2]
            IR.ConstS32Int var int ->
                do defineVar var
                   r <- lookupVar var
                   return [LIMM spec32 r (Imm (fromInteger (toInteger int)))]
            IR.Assign var S32Int val ->
                do r <- lookupVar var
                   v <- lookupVar val
                   return [OR spec32 r v v]
            IR.Assign var (Pointer _) val ->
                do p <- lookupPtr var
                   v <- lookupPtr val
                   return [PCP p v]

            IR.Load var ptr idx ->
                do defineVar var
                   v <- lookupVar var
                   p <- lookupPtr ptr
                   i <- lookupVar idx
                   return [PADD spec32 p3e p i, LMEM0 spec32 v p3e]
            IR.Store ptr idx val ->
                do p <- lookupPtr ptr
                   i <- lookupVar idx
                   v <- lookupVar val
                   return [PADD spec32 p3e p i, SMEM0 spec32 v p3e]
            IR.Call name vars ->
                case lookup name apiList of
                  Nothing -> error $ "function not found: " ++ name
                  Just (inst, regs) -> do  
                    args <- mapM lookupVar vars
                    let move = zipWith (\d s -> OR spec32 d s s) regs args
                    lb <- genLabel
                    return $ move ++ [LIMM spec32 (Reg 0x30) inst,
                                      PLIMM p30 lb,
                                      PCP p3f p2f,
                                      LB readWrite lb]
            IR.Data name dat ->
                do definePtr name
                   p <- lookupPtr name
                   lb <- genLabel
                   return $ [PLIMM p lb, LB readWrite lb, DATA dat]
            IR.DebugStop -> return [BREAK]
--         <* mapM_ (\v -> unless (v `elem` livingVars) re) IR.varRefs ir
compile is = Program $ evalState (compile' is) (CS 0 emptyFrame)
    where
      compile' :: [IR.IR] -> State CompileState [Inst]
      compile' irs = concat <$> zipWithM compileIR irs (map concat $ tails $ map IR.varRefs irs)
          
      compileIR :: IR.IR -> [Var] -> State CompileState [Inst]
      compileIR ir livingVars =
          case ir of
            IR.If var csq alt ->
                do cond <- lookupVar var
                   c1 <- extendScope (compile' csq)
                   c2 <- extendScope (compile' alt)
                  
                   ifLabel <- genLabel
                   endLabel <- genLabel

                   return $ [LIMM spec32 tmp2 (Imm 1),
                             XOR  spec32 tmp1 cond tmp2,
                             CND tmp1, PLIMM p3f ifLabel] ++
                              c1 ++ [PLIMM p3f endLabel, LB jumpOnly ifLabel] ++
                              c2 ++ [LB jumpOnly endLabel]
            IR.While var cond body ->
                do c1 <- compile' cond
                   cv <- lookupVar var
                   c2 <- extendScope (compile' body)
                   startLabel <- genLabel
                   endLabel <- genLabel
                   return $ [LB jumpOnly startLabel] ++ c1 ++
                            [LIMM spec32 tmp2 (Imm 1), XOR spec32 tmp1 cv tmp2,
                             CND tmp1, PLIMM p3f endLabel] ++
                             c2 ++ [PLIMM p3f startLabel, LB jumpOnly endLabel]

            IR.Declare var S32Int val ->
                do defineVar var
                   r <- lookupVar var
                   v <- lookupVar val
                   return [OR spec32 r v v]
            IR.Declare var (Pointer _) val ->
                do definePtr var
                   p <- lookupPtr var
                   v <- lookupPtr val
                   return [PCP p v]
            IR.Arith op var e1 e2 ->
                do defineVar var
                   r  <- lookupVar var
                   v1 <- lookupVar e1
                   v2 <- lookupVar e2
                   return [arith op spec32 r v1 v2]

            IR.Comp op var e1 e2 ->
                do defineVar var
                   r  <- lookupVar var
                   v1 <- lookupVar e1
                   v2 <- lookupVar e2
                   return [comp op spec32 spec32  r v1 v2]
            IR.ConstS32Int var int ->
                do defineVar var
                   r <- lookupVar var
                   return [LIMM spec32 r (Imm (fromInteger (toInteger int)))]
            IR.Assign var S32Int val ->
                do r <- lookupVar var
                   v <- lookupVar val
                   return [OR spec32 r v v]
            IR.Assign var (Pointer _) val ->
                do p <- lookupPtr var
                   v <- lookupPtr val
                   return [PCP p v]

            IR.Load var ptr idx ->
                do defineVar var
                   v <- lookupVar var
                   p <- lookupPtr ptr
                   i <- lookupVar idx
                   return [PADD spec32 p3e p i, LMEM0 spec32 v p3e]
            IR.Store ptr idx val ->
                do p <- lookupPtr ptr
                   i <- lookupVar idx
                   v <- lookupVar val
                   return [PADD spec32 p3e p i, SMEM0 spec32 v p3e]
            IR.Call name vars ->
                case lookup name apiList of
                  Nothing -> error $ "function not found: " ++ name
                  Just (inst, regs) -> do  
                    args <- mapM lookupVar vars
                    let move = zipWith (\d s -> OR spec32 d s s) regs args
                    lb <- genLabel
                    return $ move ++ [LIMM spec32 (Reg 0x30) inst,
                                      PLIMM p30 lb,
                                      PCP p3f p2f,
                                      LB readWrite lb]
            IR.Data name dat ->
                do definePtr name
                   p <- lookupPtr name
                   lb <- genLabel
                   return $ [PLIMM p lb, LB readWrite lb, DATA dat]
            IR.DebugStop -> return [BREAK]
--         <* mapM_ (\v -> unless (v `elem` livingVars) re) IR.varRefs ir