content: module Oczor.CodeGen.CodeGenElisp (codeGen) where
  import Oczor.CodeGen.Utl
  import Data.List.Split
  import Data.Functor.Foldable
  
  phi :: AstF Doc -> Doc
  phi = \case
    NoneF -> empty
    UniqObjectF name -> parens (text "lambda")
    NotEqualF x y -> c "not" [c "eq" [x, y]]
    EqualF x y -> c "eq" [x, y]
    LitF value -> lit value
    IdentF name -> ident name
    LabelF x y -> p [text x, y]
    VarF name ast -> c "setq" [ident name, ast]
    SetF astl astr -> c "setq" [astl, astr]
    ThrowF error -> c "error" [dquotes $ text error]
    IfF p l r -> cn "if" [p, progn l, progn r]
    ReturnF ast -> ast
    FieldF ast name -> field ast name
    HasFieldF ast name -> c "gethash" [symbol name, ast]
    ObjectF list -> c "oc-hash-from-alist" [if onull list then text "'()" else cn "list" (list &map (\(name,ast) -> symbol name <+> ast))]
    CallF name args -> c "funcall" (name : args)
    OperatorF name x -> p (text name : x)
    ArrayF list -> brackets (sep list)
    ConditionOperatorF astb astl astr -> c "if" [astb,astl,astr]
    BoolAndsF list -> c "and" list
    StmtListF list -> progn list
    ParensF x -> x
    x -> error $ unwords ["codegen", show x]
  
  codeGen :: Ast -> Doc
  codeGen = code where
    code = \case
      Set (Field ast name) astr -> c "puthash" [symbol name, code astr, code ast]
      Function params body -> func params body
      Scope list y -> scope list y
      x -> phi $ fmap codeGen $ project x
  
  scope :: [Ast] -> Ast -> Doc
  scope list r  = bodyCode vars ffiVars
       where
         (newBody, ffiVars) = case list ++ [Return r] of (Code x : t) -> (t, x); body -> (body, "")
         vars = fmap (\x -> p [ident x, nil]) $ mapMaybe getVarName newBody
         bodyCode [] "" = progn $ fmap codeGen newBody
         bodyCode vars ffiVars = cn "let*" $ parens (vcat $ text ffiVars : vars) : fmap codeGen newBody
  
  func :: [String] -> [Ast] -> Doc
  func params body = p [text "lambda", p (fmap ident params), bodyCode vars ffiVars]
       where
         (newBody, ffiVars) = case body of (Code x : t) -> (t, x); _ -> (body, "")
         vars = fmap (\x -> p [ident x, nil]) $ mapMaybe getVarName newBody
         bodyCode [] "" = progn $ fmap codeGen newBody
         bodyCode vars ffiVars = c "let*" [parensNest $ text ffiVars : vars, progn $ fmap codeGen newBody]
  
  nil = text "nil"
  
  lit = createLit (('?':) . (:[])) "nil" ("t", "nil")
  
  convertName x = x & split (startsWithOneOf ['A'..'Z']) <&> toLower & intercalate "-"
  
  keywords = setFromList ["not", "log", "eq"]
  identKw = createIdent keywords
  ident name = let newName = convertName name in identKw newName
  
  parensNest [] = parens empty
  parensNest l = nest 2 (lparen <$> vcat l) <$> rparen
  
  symbol s = text "'" <> ident s
  
  field ast name = p [text "gethash", symbol name, ast]
  
  p l = parens (hsep l)
  c name args = p (text name : args)
  cn name args = nest 2 ((lparen <> text name) <$> vcat args) <> rparen
  
  progn = \case
    [] -> empty
    [x] -> x
    l -> cn "progn" l
  