content: {-# LANGUAGE OverloadedStrings #-}
  module IRTS.CodegenErlang (codegenErlang) where
  
  import           Idris.Core.TT
  import           IRTS.Lang
  import           IRTS.CodegenCommon
  import           IRTS.Defunctionalise
  
  import           Control.Applicative ((<$>))
  import           Control.Monad.Except
  import           Control.Monad.Trans.State
  
  import           Data.Char (isPrint, toUpper, isUpper, isLower, isDigit, isAlpha)
  import           Data.List (intercalate, insertBy, partition)
  import qualified Data.Map.Strict as Map
  import           Data.Ord (comparing)
  
  import           System.Directory (getPermissions, setPermissions, setOwnerExecutable)
  import           System.Exit (exitSuccess,exitFailure)
  
  import           Paths_idris_erlang (getDataFileName)
  
  import           IRTS.CodegenErlang.Foreign
  
  -- TODO: Exports
  
  debugErlang :: Bool
  debugErlang = False
  
  -- Everything actually happens in `generateErl`. This is just a bit of
  -- glue code.
  codegenErlang :: CodeGenerator
  codegenErlang ci = do let outfile = outputFile ci
                        eitherEcg <- runErlCodeGen generateErl (defunDecls ci) (exportDecls ci)
                        case eitherEcg of
                          Left err -> do putStrLn ("Error: " ++ err)
                                         exitFailure
                          Right ecg -> do data_dir <- getDataFileName "irts"
                                          let erlout = header outfile data_dir
                                                       ++ exports_section (exports ecg)
                                                       ++ ["", ""]
                                                       ++ Map.elems (forms ecg)
                                          writeFile outfile $ "\n" `intercalate` erlout ++ "\n"
  
                                          if null (exportDecls ci)
                                            then do p <- getPermissions outfile
                                                    setPermissions outfile $ setOwnerExecutable True p
                                                    return ()
                                            else return ()
  
                                          putStrLn ("Compilation Succeeded: " ++ outfile)
                                          exitSuccess
  
  
  
  -- Erlang files have to have a `-module().` annotation that matches
  -- their filename (without the extension). Given we're making this, we
  -- should be curteous and give coders a warning that this file was
  -- autogenerated, rather than hand-coded.
  header :: String -> String -> [String]
  header filename data_dir
    = ["%% -*- erlang -*-",
       "%%! -smp enable -pa " ++ data_dir ++ "",
       "%% Generated by the Idris -> Erlang Compiler (idris-erlang).",
       "",
       "-module(" ++ modulename ++ ").",
       "",
       if debugErlang then "" else "-compile(inline).             %% Enable Inlining",
       if debugErlang then "" else "-compile({inline_size,1100}). %% Turn Inlining up to 11",
       "-compile(export_all).",
       "",
       if debugErlang then "-mode(compile)." else "",
       if debugErlang then "-include_lib(\"stdlib/include/ms_transform.hrl\")." else "",
       ""]
    where modulename = takeWhile (/='.') filename
  
  exports_section :: [(String,Int)] -> [String]
  exports_section = map (\(f,a) -> "-export(["++ f ++"/"++ show a ++"]).")
  
  -- exportCompileTag
  
  -- Erlang Codegen State Monad
  data ErlCodeGen = ECG {
    forms :: Map.Map (String,Int) String, -- name and arity to form
    decls :: [(Name,DDecl)],
    records :: [(Name,Int)],
    exports :: [(String,Int)],
    checked_fns :: Map.Map (String,Int) Int
    } deriving (Show)
  
  initECG :: ErlCodeGen
  initECG = ECG { forms = Map.empty
                , decls = []
                , records = []
                , exports = []
                , checked_fns = Map.empty
                }
  
  type ErlCG = StateT ErlCodeGen (ExceptT String IO)
  
  runErlCodeGen :: ([(Name, DDecl)] -> [ExportIFace] -> ErlCG ()) -> [(Name,DDecl)] -> [ExportIFace] -> IO (Either String ErlCodeGen)
  runErlCodeGen ecg ddecls eifaces = runExceptT $ execStateT (ecg ddecls eifaces) initECG
  
  emitForm :: (String, Int) -> String -> ErlCG ()
  emitForm fa form = modify (\ecg -> ecg { forms = Map.insert fa form (forms ecg)})
  
  emitExport :: (String, Int) -> ErlCG ()
  emitExport fa = modify (\ecg -> ecg { exports = fa : (exports ecg)})
  
  addRecord :: Name -> Int -> ErlCG ()
  addRecord name arity = do records <- gets records
                            let records1 = insertBy (comparing fst) (name,arity) records
                            modify (\ecg -> ecg { records = records1 })
  
  -- We want to be able to compare the length of constructor arguments
  -- to the arity of that record constructor, so this returns the
  -- arity. If we can't find the record, then -1 is alright to return,
  -- as no list will have that length.
  recordArity :: Name -> ErlCG Int
  recordArity name = do records <- gets records
                        case lookup name records of
                         Just i  -> return i
                         Nothing -> return (-1)
  
  isRecord :: Name -> Int -> ErlCG Bool
  isRecord nm ar = do records <- gets records
                      case lookup nm records of
                       Just ar -> return True
                       _       -> return False
  
  getVar :: LVar -> ErlCG String
  getVar (Glob name) = return $ erlVar name
  getVar (Loc i) = throwError "Local Variables not supported"
  
  getNextCheckedFnName :: String -> Int -> ErlCG String
  getNextCheckedFnName fn arity =
    do checked <- gets checked_fns
       case Map.lookup (fn,arity) checked of
         Nothing -> do modify (\ecg -> ecg { checked_fns = Map.insert (fn,arity) 1 checked })
                       return . strAtom $ "checked_" ++ fn ++ "_" ++ show 0
         Just x -> do modify (\ecg -> ecg {checked_fns = Map.update (Just . (+1)) (fn,arity) checked })
                      return . strAtom $ "checked_" ++ fn ++ "_" ++ show x
  
  
  {- The Code Generator:
  
  Takes in a Name and a DDecl, and hopefully emits some Forms.
  
  Some Definitions:
  
  - Form : the syntax for top-level Erlang function in an Erlang module
  
  - Module : a group of Erlang functions
  
  - Record : Erlang has n-arity tuples, and they're used for
  datastructures, in which case it's usual for the first element in the
  tuple to be the name of the datastructure. We'll be using these for
  most constructors.
  
  More when I realise they're needed.
  -}
  
  generateErl :: [(Name,DDecl)] -> [ExportIFace] -> ErlCG ()
  generateErl alldecls exportifaces =
    let (ctors, funs) = (isCtor . snd) `partition` alldecls
    in do mapM_ (\(_,DConstructor name _ arity) -> generateCtor name arity) ctors
          mapM_ (\(_,DFun name args exp)        -> generateFun name args exp) funs
          generateExports exportifaces
  
    where isCtor (DFun _ _ _) = False
          isCtor (DConstructor _ _ _) = True
  
  
  generateExports :: [ExportIFace] -> ErlCG ()
  generateExports []      = generateMain
  generateExports exports = mapM_ (\(Export name file exports) -> generateExportIFace name file exports) exports
  
  generateMain :: ErlCG ()
  generateMain = do erlExp <- generateExp $ DApp False mainName []
                    emitForm ("main", 1) ("main(_Args) -> \n" ++ dbgStmt ++ erlExp ++ ".")
                    emitExport ("main", 1)
                      where
                        dbgStmt = if debugErlang
                                  then "dbg:tracer(), dbg:p(self(), c), dbg:tpl(?MODULE, dbg:fun2ms(fun(_) -> return_trace() end)),\n"
                                  else ""
  
  mainName :: Name
  mainName  = sMN 0 "runMain"
  
  generateFun :: Name -> [Name] -> DExp -> ErlCG ()
  generateFun _ _ DNothing = return ()
  generateFun name args exp = do erlExp <- generateExp exp
                                 emitForm (erlAtom name, length args) ((erlAtom name) ++ "(" ++ argsStr ++ ") -> "++ erlExp ++".")
    where args' = map erlVar args
          argsStr = ", " `intercalate` args'
  
  generateCtor :: Name -> Int -> ErlCG ()
  generateCtor name arity = addRecord name arity
  
  generateExportIFace :: Name -> String -> [Export] -> ErlCG ()
  generateExportIFace _ _ exports = mapM_ generateExport exports
  
  generateExport :: Export -> ErlCG ()
  generateExport (ExportData _) = return () -- Literally just string names of types, can't do anything with them.
  generateExport (ExportFun fn (FStr enm) ret args) = do liftIO . putStrLn $ erlAtom fn
                                                         return ()
    --emitForm (enm, length args) $
    --  checkedExport enm
  
  
  generateExp :: DExp -> ErlCG String
  generateExp (DV lv)            = getVar lv
  
  generateExp (DApp _ name exprs)  = do res <- isRecord name (length exprs)
                                        exprs' <- mapM generateExp exprs
                                        if res
                                          then specialCaseCtor name exprs'
                                          else return $ erlCall (erlAtom name) exprs'
  
  generateExp (DLet vn exp inExp) = do exp' <- generateExp exp
                                       inExp' <- generateExp inExp
                                       return $ (erlVar vn) ++ " = begin " ++ exp' ++ " end, "++ inExp'
  
  -- These are never generated by the compiler right now
  generateExp (DUpdate _ exp) = generateExp exp
  
  generateExp (DProj exp n)      = do exp' <- generateExp exp
                                      return $ erlCallIRTS "project" [exp', show n]
  
  
  generateExp (DC _ _ name exprs) = do res <- isRecord name (length exprs)
                                       exprs' <- mapM generateExp exprs
                                       if res
                                         then specialCaseCtor name exprs'
                                         else throwError $ "Constructor not found: " ++ show name ++ " with " ++ show (length exprs) ++ "arguments"
  
  generateExp (DCase _  exp alts) = generateCase exp alts
  generateExp (DChkCase exp alts) = generateCase exp alts
  
  generateExp (DConst c)          = generateConst c
  
  generateExp (DOp op exprs)      = do exprs' <- mapM generateExp exprs
                                       generatePrim op exprs'
  
  generateExp DNothing            = return "undefined"
  generateExp (DError str)        = return ("erlang:error("++ show str ++")")
  
  generateExp (DForeign ret nm args) = generateForeign ret nm args
  
  -- Case Statements
  generateCase :: DExp -> [DAlt] -> ErlCG String
  -- In the naive case, lots of case statements that look like the following get generated:
  --
  -- case bool_cast(x OP y) of
  --   0 -> false;
  --   _ -> true
  -- end
  --
  -- This is annoying, as bool_cast has already changed `x OP y` from
  -- returning a bool to returning an integer, so we special-case these
  -- case statements into just generating the bool again.
  generateCase (DOp op exprs) [DConstCase (I 0) false, DDefaultCase true]
    | isBoolOp op && isFalseCtor false && isTrueCtor true = do exprs' <- mapM generateExp exprs
                                                               simpleBoolOp op exprs'
    where isFalseCtor (DC _ _ (NS (UN "False") ["Bool", "Prelude"]) []) = True
          isFalseCtor _ = False
          isTrueCtor (DC _ _ (NS (UN "True") ["Bool", "Prelude"])   []) = True
          isTrueCtor _ = False
  generateCase expr alts = do expr' <- generateExp expr
                              alts' <- mapM generateCaseAlt alts
                              return $ "case " ++ expr' ++ " of\n" ++ (";\n" `intercalate` alts') ++ "\nend"
  
  -- Case Statement Clauses
  generateCaseAlt :: DAlt -> ErlCG String
  generateCaseAlt (DConCase _ name args expr) = do res <- isRecord name (length args)
                                                   let args' = map erlVar args
                                                   if res
                                                     then do expr' <- generateExp expr
                                                             ctor <- specialCaseCtor name args'
                                                             return $ ctor ++ " -> " ++ expr'
                                                     else throwError "No Constructor to Match With"
  generateCaseAlt (DConstCase con expr)       = do con' <- generateConst con
                                                   expr' <- generateExp expr
                                                   return $ con' ++ " -> " ++ expr'
  generateCaseAlt (DDefaultCase expr)         = do expr' <- generateExp expr
                                                   return $ "_ -> " ++ expr'
  
  
  -- Foreign Calls
  --
  generateForeign :: FDesc -> FDesc -> [(FDesc,DExp)] -> ErlCG String
  generateForeign Erl_Atom (FStr "list_to_atom") [(Erl_Str,DConst (Str s))] = return $ strAtom s
  generateForeign rety (FStr nm) args = do checkedNm <- getNextCheckedFnName nm (length args)
                                           args' <- mapM (generateExp . snd) args
  
                                           emitForm (checkedNm, length args) $
                                             checkedFnCall checkedNm nm rety (map fst args)
  
                                           return $ erlCall checkedNm args'
  
  -- Some Notes on Constants
  --
  -- - All Erlang's numbers are arbitrary precision. The VM copes with
  -- what size they really are underneath, including whether they're a
  -- float.
  --
  -- - Characters are just numbers. However, there's also a nice syntax
  -- for them, which is $<char> is the number of that character. So, if
  -- the char is printable, it's best to use the $<char> notation than
  -- the number.
  --
  -- - Strings are actually lists of numbers. However the nicer syntax
  -- is within double quotes. Some things will fail, but it's just
  -- easier to assume all strings are full of printables, if they're
  -- constant.
  generateConst :: Const -> ErlCG String
  generateConst TheWorld = return "the_world"
  generateConst c | constIsType c = return $ strAtom (show c)
  generateConst (I i)   = return $ show i
  generateConst (BI i)  = return $ show i
  generateConst (B8 w)  = return $ show w
  generateConst (B16 w) = return $ show w
  generateConst (B32 w) = return $ show w
  generateConst (B64 w) = return $ show w
  generateConst (Fl f)  = return $ show f
                       -- Accurate Enough for now
  generateConst (Ch c) | c == '\\'  = return "$\\\\"
                       | isPrint c = return ['$',c]
                       | otherwise = return $ show (fromEnum c)
                        -- Accurate Enough for Now
  generateConst (Str s) | any (== '\\') s = do chars <- sequence $ map (generateConst . Ch) s
                                               return $ "[" ++ (", " `intercalate` chars) ++ "]"
                        | all isPrint s = return $ show s
                        | otherwise = do chars <- sequence $ map (generateConst . Ch) s
                                         return $ "[" ++ (", " `intercalate` chars) ++ "]"
  
  generateConst c = throwError $ "Unknown Constant " ++ show c
  
  -- Some Notes on Primitive Operations
  --
  -- - Official Docs:
  -- http://www.erlang.org/doc/reference_manual/expressions.html#id78907
  -- http://www.erlang.org/doc/reference_manual/expressions.html#id78646
  --
  -- - Oh look, because we only have one number type, all mathematical
  -- operations are really easy. The only thing to note is this: `div`
  -- is explicitly integer-only, so is worth using whenever integer
  -- division is asked for (to avoid everything becoming floaty). '/' is
  -- for any number, so we just use that on floats.
  --
  --
  generatePrim :: PrimFn -> [String] -> ErlCG String
  generatePrim (LPlus _)       [x,y] = return $ erlBinOp "+" x y
  generatePrim (LMinus _)      [x,y] = return $ erlBinOp "-" x y
  generatePrim (LTimes _)      [x,y] = return $ erlBinOp "*" x y
  generatePrim (LUDiv _)       [x,y] = return $ erlBinOp "div" x y
  generatePrim (LSDiv ATFloat) [x,y] = return $ erlBinOp "/" x y
  generatePrim (LSDiv _)       [x,y] = return $ erlBinOp "div" x y
  generatePrim (LURem _)       [x,y] = return $ erlBinOp "rem" x y
  generatePrim (LSRem _)       [x,y] = return $ erlBinOp "rem" x y
  generatePrim (LAnd _)        [x,y] = return $ erlBinOp "band" x y
  generatePrim (LOr _)         [x,y] = return $ erlBinOp "bor" x y
  generatePrim (LXOr _)        [x,y] = return $ erlBinOp "bxor" x y
  generatePrim (LCompl _)      [x]   = return $ erlBinOp "bnot" "" x  -- hax
  generatePrim (LSHL _)        [x,y] = return $ erlBinOp "bsl" x y
  generatePrim (LASHR _)       [x,y] = return $ erlBinOp "bsr" x y
  generatePrim (LLSHR _)       [x,y] = return $ erlBinOp "bsr" x y -- using an arithmetic shift when we should use a logical one.
  generatePrim (LEq _)         [x,y] = return $ erlBoolOp "=:=" x y
  generatePrim (LLt _)         [x,y] = return $ erlBoolOp "<" x y
  generatePrim (LLe _)         [x,y] = return $ erlBoolOp "=<" x y
  generatePrim (LGt _)         [x,y] = return $ erlBoolOp ">" x y
  generatePrim (LGe _)         [x,y] = return $ erlBoolOp ">=" x y
  generatePrim (LSLt _)        [x,y] = return $ erlBoolOp "<" x y
  generatePrim (LSLe _)        [x,y] = return $ erlBoolOp "=<" x y
  generatePrim (LSGt _)        [x,y] = return $ erlBoolOp ">" x y
  generatePrim (LSGe _)        [x,y] = return $ erlBoolOp ">=" x y
  generatePrim (LSExt _ _)     [x]   = return $ x -- Not sure if correct
  generatePrim (LZExt _ _)     [x]   = return $ x -- Not sure if correct
  generatePrim (LTrunc _ _)    [x]   = return $ x -- Not sure if correct
  
  generatePrim (LIntFloat _)   [x]   = return $ erlBinOp "+" x "0.0"
  generatePrim (LFloatInt _)   [x]   = return $ erlCall "trunc" [x]
  generatePrim (LIntStr _)     [x]   = return $ erlCall "integer_to_list" [x]
  generatePrim (LStrInt _)     [x]   = return $ erlCall "list_to_integer" [x]
  generatePrim (LFloatStr)     [x]   = return $ erlCall "float_to_list" [x, "[compact, {decimals, 20}]"]
  generatePrim (LStrFloat)     [x]   = return $ erlCall "list_to_float" [x]
  generatePrim (LChInt _)      [x]   = return $ x -- Chars are just Integers anyway.
  generatePrim (LIntCh _)      [x]   = return $ x
  generatePrim (LBitCast _ _)  [x]   = return $ x
  
  generatePrim (LFExp)         [x]   = return $ erlCallMFA "math" "exp" [x]
  generatePrim (LFLog)         [x]   = return $ erlCallMFA "math" "log" [x]
  generatePrim (LFSin)         [x]   = return $ erlCallMFA "math" "sin" [x]
  generatePrim (LFCos)         [x]   = return $ erlCallMFA "math" "cos" [x]
  generatePrim (LFTan)         [x]   = return $ erlCallMFA "math" "tan" [x]
  generatePrim (LFASin)        [x]   = return $ erlCallMFA "math" "asin" [x]
  generatePrim (LFACos)        [x]   = return $ erlCallMFA "math" "acos" [x]
  generatePrim (LFATan)        [x]   = return $ erlCallMFA "math" "atan" [x]
  generatePrim (LFSqrt)        [x]   = return $ erlCallMFA "math" "sqrt" [x]
  generatePrim (LFFloor)       [x]   = return $ erlCallIRTS "ceil" [x]
  generatePrim (LFCeil)        [x]   = return $ erlCallIRTS "floor" [x]
  generatePrim (LFNegate)      [x]   = return $ "-" ++ x
  
  generatePrim (LStrHead)      [x]   = return $ erlCall "hd" [x]
  generatePrim (LStrTail)      [x]   = return $ erlCall "tl" [x]
  generatePrim (LStrCons)      [x,y] = return $ "["++x++"|"++y++"]"
  generatePrim (LStrIndex)     [x,y] = return $ erlCallIRTS "str_index" [x,y]
  generatePrim (LStrRev)       [x]   = return $ erlCallMFA "lists" "reverse" [x]
  generatePrim (LStrConcat)    [x,y] = return $ erlBinOp "++" x y
  generatePrim (LStrLt)        [x,y] = return $ erlBoolOp "<" x y
  generatePrim (LStrEq)        [x,y] = return $ erlBoolOp "=:=" x y
  generatePrim (LStrLen)       [x]   = return $ erlCall "length" [x]
  
  generatePrim (LReadStr)      [_]     = return $ erlCallIRTS "read_str" []
  generatePrim (LWriteStr)     [_,s]   = return $ erlCallIRTS "write_str" [s]
  
  generatePrim (LSystemInfo)    _    = throwError "System Info not supported" -- TODO
  
  generatePrim (LFork)         [e]   = return $ "spawn(fun() -> "++ erlCall (erlAtom evalName) [e] ++" end)"
  
  generatePrim (LPar)          [e]   = return e
  
  generatePrim (LExternal nm)  args  = generateExternalPrim nm args
  
  generatePrim p a = do liftIO . putStrLn $ "No Primitive: " ++ show p ++ " on " ++ show (length a) ++ " args."
                        throwError "generatePrim: Unknown Op, or incorrect arity"
  
  
  generateExternalPrim :: Name -> [String] -> ErlCG String
  generateExternalPrim nm _ | nm == sUN "prim__stdin"  = return $ "standard_io"
                            | nm == sUN "prim__stdout" = return $ "standard_io"
                            | nm == sUN "prim__stderr" = return $ "standard_io"
                            | nm == sUN "prim__vm"     = return $ "undefined"
                            | nm == sUN "prim__null"   = return $ "undefined"
  generateExternalPrim nm [_,h]     | nm == sUN "prim__readFile"     = return $ erlCallIRTS "read_file" [h]
  generateExternalPrim nm [_,h,s]   | nm == sUN "prim__writeFile"    = return $ erlCallIRTS "write_file" [h,s]
  generateExternalPrim nm [p1,p2] | nm == sUN "prim__eqPtr"        = return $ erlCallIRTS "ptr_eq" [p1,p2]
  generateExternalPrim nm [p1,p2] | nm == sUN "prim__eqManagedPtr" = return $ erlCallIRTS "ptr_eq" [p1,p2]
  generateExternalPrim nm [p,l]   | nm == sUN "prim__registerPtr"  = return $ erlCallIRTS "register_ptr" [p,l]
  generateExternalPrim nm args = do liftIO . putStrLn $ "Unknown External Primitive: " ++ show nm ++ " on " ++ show (length args) ++ " args."
                                    throwError "generatePrim: Unknown External Primitive"
  
  
  
  erlBinOp :: String -> String -> String -> String
  erlBinOp op a b = concat ["(",a," ",op," ",b,")"]
  
  -- Erlang Atoms can contain quite a lot of chars, so let's see how they cope
  erlAtom :: Name -> String
  erlAtom n = strAtom (showCG n)
  
  strAtom :: String -> String
  strAtom s = "\'" ++ concatMap atomchar s ++ "\'"
    where atomchar '\'' = "\\'"
          atomchar '\\' = "\\\\"
          atomchar '{'  = ""
          atomchar '}'  = ""
          atomchar x | isPrint x = [x]
                     | otherwise = "_" ++ show (fromEnum x) ++ "_"
  
  
  -- Erlang Variables have a more restricted set of chars, and must
  -- start with a capital letter (erased can start with an underscore)
  erlVar :: Name -> String
  erlVar n = 'I':(concatMap varchar (showCG n))
    where varchar '_' = "_"
          varchar '{' = ""
          varchar '}' = ""
          varchar x | isAlpha x = [x]
                    | isDigit x = [x]
                    | otherwise = "_" ++ show (fromEnum x) ++ "_"
  
  erlTuple :: [String] -> String
  erlTuple elems = "{" ++ (", " `intercalate` elems) ++ "}"
  
  erlCall :: String -> [String] -> String
  erlCall fun args = fun ++ "("++ (", " `intercalate` args) ++")"
  
  erlCallMFA :: String -> String -> [String] -> String
  erlCallMFA mod fun args = mod ++ ":" ++ erlCall fun args
  
  erlCallIRTS :: String -> [String] -> String
  erlCallIRTS f a = erlCallMFA "idris_erlang_rts" f a
  
  erlBoolOp :: String -> String -> String -> String
  erlBoolOp op x y = erlCallIRTS "bool_cast" [concat [x, " ", op, " ", y]]
  
  isBoolOp :: PrimFn -> Bool
  isBoolOp (LEq _) = True
  isBoolOp (LLt _) = True
  isBoolOp (LLe _) = True
  isBoolOp (LGt _) = True
  isBoolOp (LGe _) = True
  isBoolOp (LSLt _) = True
  isBoolOp (LSLe _) = True
  isBoolOp (LSGt _) = True
  isBoolOp (LSGe _) = True
  isBoolOp (LStrLt) = True
  isBoolOp (LStrEq) = True
  isBoolOp _        = False
  
  simpleBoolOp :: PrimFn -> [String] -> ErlCG String
  simpleBoolOp (LEq _) [x,y] = return $ erlBinOp "=:=" x y
  simpleBoolOp (LLt _) [x,y] = return $ erlBinOp "<"   x y
  simpleBoolOp (LLe _) [x,y] = return $ erlBinOp "=<"  x y
  simpleBoolOp (LGt _) [x,y] = return $ erlBinOp ">"   x y
  simpleBoolOp (LGe _) [x,y] = return $ erlBinOp ">="  x y
  simpleBoolOp (LSLt _) [x,y] = return $ erlBinOp "<"  x y
  simpleBoolOp (LSLe _) [x,y] = return $ erlBinOp "=<" x y
  simpleBoolOp (LSGt _) [x,y] = return $ erlBinOp ">"  x y
  simpleBoolOp (LSGe _) [x,y] = return $ erlBinOp ">=" x y
  simpleBoolOp (LStrLt) [x,y] = return $ erlBinOp "<"  x y
  simpleBoolOp (LStrEq) [x,y] = return $ erlBinOp "=:=" x y
  simpleBoolOp _ _ = throwError "Unknown Boolean Primitive Operation, this shouldn't ever happen"
  
  
  -- This is where we special case various constructors.
  --
  -- * Prelude.List.Nil gets turned into []
  -- * Prelude.List.(::) gets turned into [head|tail]
  -- * MkUnit () gets turned into {}
  -- * Prelude.Bool.True gets turned into true
  -- * Prelude.Bool.False gets turned into false
  --
  specialCaseCtor :: Name -> [String] -> ErlCG String
  specialCaseCtor (NS (UN "Nil") ["List", "Prelude"]) []      = return "[]"
  specialCaseCtor (NS (UN "::")  ["List", "Prelude"]) [hd,tl] = return $ "["++ hd ++ "|"++ tl ++"]"
  specialCaseCtor (UN "MkUnit") [] = return "{}"
  specialCaseCtor (NS (UN "True")  ["Bool", "Prelude"]) [] = return "true"
  specialCaseCtor (NS (UN "False") ["Bool", "Prelude"]) [] = return "false"
  specialCaseCtor nm args = return $ "{"++ (", " `intercalate` (erlAtom nm : args)) ++"}"
  