module DDC.Core.Salt.Convert.Init
(initRuntime)
where
import DDC.Core.Salt.Compounds
import DDC.Core.Salt.Runtime
import DDC.Core.Salt.Name
import DDC.Core.Module
import DDC.Core.Exp
import DDC.Core.Compounds
import Data.List
initRuntime
:: Config
-> Module a Name
-> Maybe (Module a Name)
initRuntime config mm@ModuleCore{}
| isMainModule mm
= case initRuntimeTopX config (moduleBody mm) of
Nothing -> Nothing
Just x' -> Just
$ mm { moduleExportValues = patchMainExports (moduleExportValues mm)
, moduleBody = x'}
| otherwise
= Just mm
posixMainType :: Type Name
posixMainType
= tFunPE tInt (tFunPE (tPtr rTop tString) tInt)
patchMainExports
:: [(Name, ExportSource Name)]
-> [(Name, ExportSource Name)]
patchMainExports xx
= case xx of
[] -> []
(x : xs)
| (NameVar "main", ExportSourceLocal n _) <- x
-> (NameVar "main", ExportSourceLocal n posixMainType) : xs
| otherwise
-> x : patchMainExports xs
initRuntimeTopX :: Config -> Exp a Name -> Maybe (Exp a Name)
initRuntimeTopX config xx
| XLet a (LRec bxs) x2 <- xx
, Just (bMainOrig, xMainOrig) <- find (isMainBind . fst) bxs
, bxs_cut <- filter (not . isMainBind . fst) bxs
, BName _ tMainOrig <- bMainOrig
= let
bMainOrig' = BName (NameVar "_main") $ tMainOrig
bMainEntry = BName (NameVar "main") $ posixMainType
xMainEntry = makeMainEntryX config a
in Just $ XLet a
(LRec $ bxs_cut
++ [ (bMainOrig', xMainOrig)
, (bMainEntry, xMainEntry)])
x2
| otherwise
= Nothing
isMainBind :: Bind Name -> Bool
isMainBind bb
= case bb of
(BName (NameVar "main") _) -> True
_ -> False
makeMainEntryX :: Config -> a -> Exp a Name
makeMainEntryX config a
= XLam a (BName (NameVar "argc") tInt)
$ XLam a (BName (NameVar "argv") (tPtr rTop tString))
$ XLet a (LLet (BNone tVoid) (xCreate a (configHeapSize config)))
$ XLet a (LLet (BNone (tPtr rTop tObj))
(xApps a (XVar a (UName (NameVar "_main")))
[xAllocBoxed a rTop 0 (xNat a 0)]))
(xInt a 0)