content: module Minigent.CG(cg) where
  import Minigent.Syntax
  import Minigent.Environment
  import Minigent.Syntax.Utils(operators)
  import Data.List (intersperse)
  import Data.Char (isDigit)
  import Text.Read (readMaybe)
  import qualified Data.Map as M
  format :: String -> [String] -> String
  format a xs = foldr replace a (zip [0..] xs)
    where
      replace (i, n) [] = []
      replace (i, n) (x:xs) 
         | x == '$'
         , (body, rest) <- span isDigit xs
         , Just v <- readMaybe body
         , v == i = n ++ replace (i,n) rest
         | otherwise = x : replace (i,n) xs
  
  
  
  jsOperators :: [(Op, String)]
  jsOperators = (NotEqual, "!=")
              : filter ((`notElem` [Not, NotEqual]) . fst) 
                       (map (\(x,y)->(y,x)) operators)
  
  cg :: GlobalEnvironments -> String
  cg envs = let ds = M.toList (defns envs)
             in "var C = require('./minigent.js');\n" 
                ++ "var A = require('./abstract.js');\n"
                ++ genDefs ds
                ++ "\n" ++ case lookup "main" ds of
                             Just _ -> "main(null);\n"
                             _ -> ""
    where
      genExpr :: Expr -> String
      genExpr (PrimOp Not [e]) = format "!($0)" [genExpr e]
      genExpr (PrimOp o [e1,e2]) 
        | Just x <- lookup o jsOperators
        = format "($0 $1 $2)" [genExpr e1, x, genExpr e2]
      genExpr (Literal (BoolV True)) = "true"
      genExpr (Literal (BoolV False)) = "false"
      genExpr (Literal (IntV i)) = show i
      genExpr (Literal UnitV) = "null"
      genExpr (Var v) = v
      genExpr (Con c e) = format "({tag:$0, val:$1})" [show c, genExpr e]
      genExpr (TypeApp f ts) = if M.member f (defns envs) then f else "A." ++ f
      genExpr (Sig e t) = genExpr e
      genExpr (Apply a b) = format "$0($1)" [genExpr a, genExpr b]
      genExpr (Struct fs) = format "({$0})" [ concat (intersperse ", " (map genField fs)) ] 
        where genField (f,e) = format "$0: $1" [f, genExpr e]
      genExpr (If e1 e2 e3) = format "($0 ? $1 : $2)" (map genExpr [e1,e2,e3])
      genExpr (Let v e1 e2) = format "C.Let($1,$0=>$2)" [v, genExpr e1, genExpr e2]
      genExpr (LetBang vs v e1 e2) = genExpr (Let v e1 e2)
      genExpr (Take v f vf e1 e2) = format "C.Let($3, $0=> C.Let(($3).$1, $2=> $4))"
                                           [v,f,vf,genExpr e1, genExpr e2]
      genExpr (Put e1 f e2) = case e1 of
         Sig e1' (Record _ _ Unboxed) 
           -> format "C.UPut($0,{$1:$2})"          [genExpr e1', f, genExpr e2]
         _ -> format "Object.assign($0,{$1:$2})" [genExpr e1 , f, genExpr e2]
      
      genExpr (Member e1 f) = format "($0).$1" [genExpr e1, f]
      genExpr (Case e c v1 e1 v2 e2) = format "C.Case($0, $1, $2=>$3,$4=>$5)" 
                                       [genExpr e, show c, v1, genExpr e1, v2, genExpr e2]
      genExpr (Esac e c v1 e1) = format "C.Let(($0).val, $1=>$2)"
                                 [genExpr e, v1, genExpr e1]
      
      genDef :: (FunName, (VarName, Expr)) -> String
      genDef (f,(v,e)) = format "function $0 ($1) { return $2; };" [f, v, genExpr e]
      
      genDefs :: [(FunName, (VarName, Expr))] -> String
      genDefs = unlines . map genDef
    
  