module RecCompiler where

import Language.Haskell.Pretty

import Target
import Expr

comp :: Expr -> Target
comp (Const c)         = TReturn c
comp (Val (x, m) n)    = comp m `TBind` TLambda1 x
                        (comp n)
comp (Let decls n)     = TLet (map (\ (x, m) -> let TReturn c = comp m in (PVar x, c)) decls)
                              (comp n)
comp (LetGlobal ds n)  =
  let len = length ds
      rs  = mkRefs len
      (ms, ps) = unzip $ zipWith (\ (x, m) r -> (m, (x, r))) ds rs
      cs  = map (\ m -> let TReturn c = comp m in c) ms
      s0  = TApp (TVar $ mkAt $ mkTupleCon len) cs
    in TApp (TVar "resetGlobal")
          [s0, TLet (map (\ (x, r) -> (PVar x, TApp (TVar "cmpPos") [TVar "p2_1", r])) ps) (comp n)]
comp (LetLocal ds n)   =
  let len = length ds
      rs  = mkRefs len
      (ms, ps) = unzip $ zipWith (\ (x, m) r -> (m, (x, r))) ds rs
      cs  = map (\ m -> let TReturn c = comp m in c) ms
      s0  = TApp (TVar $ mkAt $ mkTupleCon len) cs
    in TApp (TVar "resetLocal")
          [s0, TLet (map (\ (x, r) -> (PVar x, TApp (TVar "cmpPos") [TVar "p2_2", r])) ps) (comp n)]
comp (Var x)
    | isMutVar x       = TApp1 (TVar "get") (TVar x)
    | otherwise        = TReturn (TVar x)
comp (App (App (Var ":=") (Var x)) m)
                       = comp m                       `TBind` TLambda1 "_y"
                         (TApp1 (TVar "set") (TVar x) `TBind` TLambda1 "_f"
                         (TApp1 (TVar "_f") (TVar "_y")))
comp (App (Var "&") (Var x))
    | isMutVar x       = TReturn (TVar x)
comp (App f x)         = comp f `TBind` TLambda1 "_f"
                        (comp x `TBind` TLambda1 "_x"
                        (TApp1 (TVar "_f") (TVar "_x")))
-- comp (Lambda x m)      = TReturn (if x == "_" then TLambda0 (comp m) else TLambda1 x (comp m))
comp (Lambda "_" m)    = TReturn (TLambda0 (comp m))
comp (Lambda x m)      = TReturn (TLambda1 x (comp m))
comp (Delay m)         = TReturn (comp m)
comp (If e1 e2 e3)     = comp e1 `TBind` TLambda1 "_b"
                        (TIf (TVar "_b") (comp e2) (comp e3))
comp (While e1 e2)     = TLet [(PVar "_while",  body)] (TVar "_while")
                 where body = comp e1 `TBind`  TLambda1 "_b"
                             (TIf (TVar "_b") (comp e2 `TBind` TLambda0 (TVar "_while"))
                                              (TReturn (TVar "()")))
comp (Begin [e])       = compLabeledExpr e
comp (Begin (e:es))    = compLabeledExpr e `TBind` TLambda0
                        (comp (Begin es))
comp Break             = TReturn (TVar "break")            -- treat as a variable
comp Continue          = TReturn (TVar "continue")         -- treat as a variable
comp (Goto label)      = TApp1 (TVar "goto") (TVar label)  -- treat as a function


compDecls :: Decls -> [(Pattern, Target)]
compDecls decls =  map (\ (x, m) -> let TReturn c = comp m in (PVar x, c)) decls

compLabeledExpr (Nothing, e) = comp e
compLabeledExpr (Just s,  e) = comp e -- just ignored