ddc-driver 0.4.1.3 → 0.4.2.1

raw patch · 36 files changed

+1780/−588 lines, 36 filesdep +timedep −ddc-core-evaldep −ddc-interfacedep ~basedep ~ddc-basedep ~ddc-buildPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: time

Dependencies removed: ddc-core-eval, ddc-interface

Dependency ranges changed: base, ddc-base, ddc-build, ddc-core, ddc-core-flow, ddc-core-llvm, ddc-core-salt, ddc-core-simpl, ddc-core-tetra, ddc-source-tetra, deepseq, filepath, mtl

API changes (from Hackage documentation)

Files

• DDC/Driver/Build/Locate.hs +66/−0
• DDC/Driver/Build/Main.hs +117/−0
• DDC/Driver/Command/BaseBuild.hs +13/−19
• DDC/Driver/Command/Build.hs +54/−0
• DDC/Driver/Command/Check.hs +32/−25
• DDC/Driver/Command/Compile.hs +400/−29
• DDC/Driver/Command/Flow/Concretize.hs +4/−4
• DDC/Driver/Command/Flow/Lower.hs +10/−8
• DDC/Driver/Command/Flow/Melt.hs +4/−4
• DDC/Driver/Command/Flow/Prep.hs +4/−4
• DDC/Driver/Command/Flow/Rate.hs +37/−5
• DDC/Driver/Command/Flow/Thread.hs +6/−6
• DDC/Driver/Command/Flow/ToTetra.hs +144/−0
• DDC/Driver/Command/Flow/Wind.hs +4/−4
• DDC/Driver/Command/Load.hs +118/−62
• DDC/Driver/Command/Make.hs +0/−81
• DDC/Driver/Command/Parse.hs +13/−19
• DDC/Driver/Command/Read.hs +2/−7
• DDC/Driver/Command/RewriteRules.hs +3/−3
• DDC/Driver/Command/Tetra/Boxing.hs +14/−5
• DDC/Driver/Command/Tetra/Curry.hs +51/−0
• DDC/Driver/Command/ToC.hs +35/−38
• DDC/Driver/Command/ToLlvm.hs +35/−38
• DDC/Driver/Command/ToPHP.hs +170/−0
• DDC/Driver/Command/ToSalt.hs +35/−41
• DDC/Driver/Command/Trans.hs +25/−23
• DDC/Driver/Config.hs +51/−13
• DDC/Driver/Dump.hs +1/−1
• DDC/Driver/Interface/Input.hs +189/−0
• DDC/Driver/Interface/Source.hs +43/−0
• DDC/Driver/Stage.hs +2/−6
• DDC/Driver/Stage/Flow.hs +19/−2
• DDC/Driver/Stage/Lite.hs +0/−79
• DDC/Driver/Stage/Salt.hs +13/−19
• DDC/Driver/Stage/Tetra.hs +41/−25
• ddc-driver.cabal +25/−18

@@ -0,0 +1,66 @@++module DDC.Driver.Build.Locate+        (locateModuleFromPaths)+where+import DDC.Core.Module+import qualified DDC.Core.Pretty        as P+import Control.Monad+import Control.Monad.Trans.Except+import Control.Monad.IO.Class+import Data.Maybe+import System.FilePath+import qualified System.Directory       as Directory+++-- | Locate the source file for a module, starting from the given list of base paths.+--   If the module cannot be found, or is found from multiple paths then throw+--   an error in the monad.+--+locateModuleFromPaths+        :: [FilePath]           -- ^ Base paths.+        -> ModuleName           -- ^ Module name.+        -> String               -- ^ Source file extension+        -> ExceptT String IO FilePath++locateModuleFromPaths pathsBase name ext+ = do+        mPaths  <- liftIO +                $  liftM catMaybes+                $  mapM  (\d -> locateModuleFromPath d name ext) pathsBase++        case mPaths of+         []        -> throwE $ unlines +                   $  [ "Cannot locate source for module '" +                                ++ (P.renderIndent $ P.ppr name)  +                                ++ "' from base directories:" ]+                   ++ ["    " ++ dir | dir <- pathsBase]++         [path]    -> return path++         paths     -> throwE $ unlines+                   $  [ "Source for module '" +                                ++ (P.renderIndent $ P.ppr name )+                                ++ "' found at multiple paths:" ]+                   ++ ["    " ++ dir | dir <- paths]+++-- | Given the path of a .build spec, and a module name, yield the path where+--   the source of the module should be.+locateModuleFromPath +        :: FilePath             -- ^ Base path.+        -> ModuleName           -- ^ Module name.+        -> String               -- ^ Source file extension.+        -> IO (Maybe FilePath)++locateModuleFromPath pathBase (ModuleName parts) ext+ = let  +        go []           = ext+        go [p]          = p <.> ext+        go (p : ps)     = p </> go ps++   in do+        let pathFile    = pathBase </> go parts+        exists          <- Directory.doesFileExist pathFile+        if exists +         then return $ Just pathFile+         else return Nothing

@@ -0,0 +1,117 @@++module DDC.Driver.Build.Main+        ( buildSpec+        , buildComponent+        , buildModule)+where+import DDC.Driver.Command.Compile+import DDC.Driver.Build.Locate+import DDC.Driver.Config+import DDC.Build.Spec+import Control.Monad+import Control.Monad.Trans.Except+import Control.Monad.IO.Class+import DDC.Build.Interface.Store        (Store)+import qualified DDC.Core.Module        as C+++---------------------------------------------------------------------------------------------------+-- | Build all the components defined by a build spec.+buildSpec  +        :: Config               -- ^ Build config.+        -> Store                -- ^ Interface store.+        -> Spec                 -- ^ Build spec.+        -> ExceptT String IO ()++buildSpec config store spec+ = do   mapM_   (buildComponent config store) +                (specComponents spec)+++---------------------------------------------------------------------------------------------------+-- | Build a single component of a build spec.+buildComponent +        :: Config               -- ^ Build config.+        -> Store                -- ^ Interface store.+        -> Component            -- ^ Component to build.+        -> ExceptT String IO ()++buildComponent config store component@SpecLibrary{}+ = do+        when (configLogBuild config)+         $ liftIO $ putStrLn $ "* Building library " ++ specLibraryName component++        buildLibrary config store+         $ specLibraryTetraModules component++        return ()++buildComponent config store component@SpecExecutable{}+ = do   +        when (configLogBuild config)+         $ liftIO $ putStrLn $ "* Building executable " ++ specExecutableName component++        buildExecutable config store+                (specExecutableTetraMain  component)+                (specExecutableTetraOther component)++        return ()+++---------------------------------------------------------------------------------------------------+-- | Build a library consisting of several modules.+buildLibrary +        :: Config               -- ^ Build config+        -> Store                -- ^ Interface store.+        -> [C.ModuleName]       -- ^ Names of modules still to build+        -> ExceptT String IO ()++buildLibrary config store ms0+ = go ms0+ where+        go []+         = return ()++        go (m : more)+         = do   buildModule config store m+                go more+++---------------------------------------------------------------------------------------------------+-- | Build an executable consisting of several modules.+buildExecutable+        :: Config               -- ^ Build config.+        -> Store                -- ^ Interface store.+        -> C.ModuleName         -- ^ Name  of main module.+        -> [C.ModuleName]       -- ^ Names of dependency modules+        -> ExceptT String IO ()++buildExecutable config store mMain msOther0+ = go msOther0+ where  +        go [] +         = do   let dirs = configModuleBaseDirectories config+                path     <- locateModuleFromPaths dirs mMain "ds"+                _        <- cmdCompile config True store path+                return ()++        go (m : more)+         = do   buildModule config store m+                go more+++---------------------------------------------------------------------------------------------------+-- | Build a single module.+buildModule+        :: Config               -- ^ Build config.+        -> Store                -- ^ Interface store.+        -> C.ModuleName         -- ^ Module name.+        -> ExceptT String IO ()++buildModule config store name+ = do   let dirs = configModuleBaseDirectories config+        path    <- locateModuleFromPaths dirs name "ds"+        _       <- cmdCompile config False store path+        return ()++

@@ -8,23 +8,22 @@ import DDC.Driver.Command.Compile import System.FilePath import System.Directory-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import Control.Monad---baseLiteFiles :: Builder -> [FilePath]-baseLiteFiles builder- = let  _bits    = show $ archPointerWidth $ platformArch $ buildTarget builder-   in   [ "lite" </> "base" </> "Data" </> "Numeric" </> "Bool.dcl"-        , "lite" </> "base" </> "Data" </> "Numeric" </> "Int.dcl"-        , "lite" </> "base" </> "Data" </> "Numeric" </> "Nat.dcl" ]+import DDC.Build.Interface.Store        (Store)   baseSaltFiles :: Builder -> [FilePath] baseSaltFiles builder  = let  bits    = show $ archPointerWidth $ platformArch $ buildTarget builder-   in   [ "salt" </> "runtime"   ++ bits </> "Object.dcs" ]+        runtime = "salt" </> "runtime" ++ bits+   in   [ runtime </> "debug"           </> "Trace.dcs"+        , runtime </> "primitive"       </> "Array.dcs"+        , runtime </> "primitive"       </> "Ref.dcs"+        , runtime </> "primitive"       </> "Text.dcs"+        , runtime </> "Apply.dcs"+        , runtime </> "Object.dcs" ]   baseSeaFiles  :: Builder -> [FilePath]@@ -33,8 +32,8 @@   -- Buid the base libraries and runtime system.-cmdBaseBuild :: Config  -> ErrorT String IO ()-cmdBaseBuild config+cmdBaseBuild :: Config  -> Store -> ExceptT String IO ()+cmdBaseBuild config store  = do   let builder     = configBuilder config         let target      = buildTarget builder         @@ -43,16 +42,11 @@         when (not exists)          $ liftIO $ createDirectory $ buildBaseLibDir builder -        -- Build all the .dcl files.-        let srcLiteFiles = map (buildBaseSrcDir builder </>) (baseLiteFiles builder)-        let objLiteFiles = map (flip replaceExtension "o")   srcLiteFiles-        mapM_ (cmdCompile config) srcLiteFiles-         -- Build all the .dcs files.         let config'      = config { configInferTypes = True }         let srcSaltFiles = map (buildBaseSrcDir builder </>) (baseSaltFiles builder)         let objSaltFiles = map (flip replaceExtension "o")   srcSaltFiles-        mapM_ (cmdCompile config') srcSaltFiles+        mapM_ (cmdCompile config' False store) srcSaltFiles          -- Build all the .c files.         let srcSeaFiles  = map (buildBaseSrcDir builder </>) (baseSeaFiles builder)@@ -60,7 +54,7 @@         liftIO $ zipWithM_ (buildCC builder) srcSeaFiles objSeaFiles          -- All the .o files-        let objFiles     = objLiteFiles ++ objSaltFiles ++ objSeaFiles+        let objFiles     = objSaltFiles ++ objSeaFiles          -- Link the .o files into a static library.         let staticRuntime 

@@ -0,0 +1,54 @@++module DDC.Driver.Command.Build+        (cmdBuild)+where+import DDC.Driver.Config+import DDC.Driver.Build.Main+import DDC.Driver.Command.Compile+import DDC.Base.Pretty+import DDC.Build.Interface.Store        (Store)+import Control.Monad.Trans.Except+import Control.Monad.IO.Class+import qualified System.FilePath        as FilePath+import qualified DDC.Build.Spec.Parser  as Spec+import qualified DDC.Build.Builder      as Builder+import qualified Data.List              as List+++-- Perform a build following a build specification.+cmdBuild :: Config -> Store -> FilePath -> ExceptT String IO ()+cmdBuild config store filePath++ -- Build from a build spec file+ | ".build"      <- FilePath.takeExtension filePath+ = do+        -- Search for modules in the base library as well as the same directory+        -- the build file is in.+        let config'     +                = config+                { configModuleBaseDirectories+                        =  List.nub +                        $  configModuleBaseDirectories config+                        ++ [ FilePath.takeDirectory filePath+                           , Builder.buildBaseSrcDir (configBuilder config) +                                FilePath.</> "tetra" FilePath.</> "base" ]+                }++        -- Parse the spec file.+        str     <- liftIO $ readFile filePath+        case Spec.parseBuildSpec filePath str of+         Left err       -> throwE $ renderIndent $ ppr err+         Right spec     -> buildSpec config' store spec+++ -- If we were told to build a source file then just compile it instead.+ -- This is probably the least surprising behaviour.+ | ".ds"        <- FilePath.takeExtension filePath+ = do   cmdCompileRecursive config False store filePath+        return ()++ -- Don't know how to build from this file.+ | otherwise+ = let  ext     = FilePath.takeExtension  filePath+   in   throwE $ "Cannot build from '" ++ ext ++ "' files."+

@@ -24,7 +24,8 @@ import DDC.Driver.Stage import DDC.Driver.Output import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Command.Compile+import DDC.Driver.Interface.Source import DDC.Build.Language import DDC.Build.Pipeline import DDC.Core.Fragment@@ -32,20 +33,20 @@ import DDC.Core.Parser import DDC.Core.Lexer import DDC.Core.Module-import DDC.Core.Exp+import DDC.Core.Exp.Annot import DDC.Core.Pretty-import DDC.Core.Compounds import DDC.Type.Transform.SpreadT import DDC.Type.Universe import DDC.Type.Equiv-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class-import qualified DDC.Base.Parser        as BP-import qualified DDC.Type.Check         as T-import qualified DDC.Core.Check         as C import Control.Monad import System.FilePath import System.Directory+import DDC.Build.Interface.Store        (Store)+import qualified DDC.Base.Parser        as BP+import qualified DDC.Type.Check         as T+import qualified DDC.Core.Check         as C   -- Module -----------------------------------------------------------------------------------------@@ -58,14 +59,15 @@ -- cmdCheckFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdCheckFromFile config filePath+cmdCheckFromFile config store filePath    -- Check a Disciple Source Tetra module.- | ".dst"       <- takeExtension filePath- =      cmdCheckSourceTetraFromFile config filePath+ | ".ds"       <- takeExtension filePath+ =      cmdCheckSourceTetraFromFile config store filePath   -- Check a module in some fragment of Disciple Core.  | Just language <- languageOfExtension (takeExtension filePath)@@ -74,51 +76,56 @@  -- Don't know how to check this file.  | otherwise  = let  ext     = takeExtension filePath-   in   throwError $ "Cannot check '" ++ ext ++ "'files."+   in   throwE $ "Cannot check '" ++ ext ++ "'files."   --------------------------------------------------------------------------------------------------- -- | Check a Disciple Source Tetra module from a file. cmdCheckSourceTetraFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdCheckSourceTetraFromFile config filePath+cmdCheckSourceTetraFromFile config store filePath  = do         -- Check that the file exists.         exists <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath +        -- Call the compiler to build/load all dependent modules.+        cmdCompileRecursive config False store filePath+         -- Read in the source file.         src     <- liftIO $ readFile filePath -        cmdCheckSourceTetraFromString config (SourceFile filePath) src+        cmdCheckSourceTetraFromString config store (SourceFile filePath) src   --------------------------------------------------------------------------------------------------- -- | Check a Disciple Source Tetra module from a string.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdCheckSourceTetraFromString         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdCheckSourceTetraFromString config source str+cmdCheckSourceTetraFromString config store source str  = let         pmode   = prettyModeOfConfig $ configPretty config          pipeLoad          = pipeText     (nameOfSource source) (lineStartOfSource source) str-         $ stageSourceTetraLoad config source+         $ stageSourceTetraLoad config source store          [ PipeCoreOutput pmode SinkDiscard ]    in do         errs    <- liftIO pipeLoad         case errs of          [] -> return ()-         es -> throwError $ renderIndent $ vcat $ map ppr es+         es -> throwE $ renderIndent $ vcat $ map ppr es    ---------------------------------------------------------------------------------------------------@@ -127,7 +134,7 @@         :: Config               -- ^ Driver config.         -> Language             -- ^ Core language definition.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdCheckCoreFromFile config language filePath  | Language bundle      <- language@@ -138,7 +145,7 @@                 $ (if configInferTypes config then C.Synth else C.Recon)                  case mModule of-                (Left  err, _ct) -> throwError (renderIndent $ ppr err)+                (Left  err, _ct) -> throwE (renderIndent $ ppr err)                 (Right _,   _ct) -> return ()  @@ -149,7 +156,7 @@         -> Source               -- ^ Source of the program text.         -> String               -- ^ Program text.         -> C.Mode n             -- ^ Type checker mode.-        -> ErrorT String IO (Module (AnTEC BP.SourcePos n) n)+        -> ExceptT String IO (Module (AnTEC BP.SourcePos n) n)  cmdCheckCoreFromString fragment source str mode  = do   @@ -158,7 +165,7 @@                         mode str          case mModule of-                (Left err, _ct) -> throwError (renderIndent $ ppr err)+                (Left err, _ct) -> throwE (renderIndent $ ppr err)                 (Right mm, _ct) -> return mm  

@@ -1,40 +1,272 @@  module DDC.Driver.Command.Compile-        (cmdCompile)+        ( cmdCompileRecursive+        , cmdCompileRecursiveDS+        , cmdLoadOrCompile+        , cmdCompile+        , getModificationTimeIfExists) where import DDC.Driver.Stage-import DDC.Interface.Source+import DDC.Driver.Config+import DDC.Driver.Interface.Source import DDC.Build.Pipeline+import DDC.Build.Interface.Base+import DDC.Data.Canned+import DDC.Data.Token import System.FilePath import System.Directory import Control.Monad-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class-import qualified DDC.Core.Pretty        as P+import Data.Time.Clock+import Data.IORef+import qualified DDC.Driver.Build.Locate        as Locate+import qualified DDC.Build.Builder              as Builder+import qualified DDC.Source.Tetra.Module        as SE+import qualified DDC.Source.Tetra.Lexer         as SE+import qualified DDC.Source.Tetra.Parser        as SE+import qualified DDC.Core.Pretty                as P+import qualified DDC.Core.Module                as C+import qualified DDC.Core.Parser                as C+import qualified DDC.Core.Lexer                 as C+import qualified DDC.Base.Parser                as BP+import qualified DDC.Version                    as Version+import qualified Data.List                      as List +import DDC.Driver.Command.Flow.ToTetra+import qualified DDC.Core.Flow                  as Flow --- | Compile a source module into a @.o@ file.-cmdCompile :: Config -> FilePath -> ErrorT String IO ()-cmdCompile config filePath+import DDC.Build.Interface.Store                (Store)+import qualified DDC.Build.Interface.Store      as Store+++---------------------------------------------------------------------------------------------------+-- | Recursively compile source modules into @.o@ files,+--   or load existing interfaces if we have them and the @.o@ file is+--   still fresh.+--+--   * Interface files that are loaded or generated during compilation+--     are added to the interface store.+--+cmdCompileRecursive+        :: Config               -- ^ Build driver config.+        -> Bool                 -- ^ Build an exectable.+        -> Store                -- ^ Interface store.+        -> FilePath             -- ^ Path to file to compile+        -> ExceptT String IO ()++cmdCompileRecursive config bBuildExe store filePath+ | takeExtension filePath == ".ds"+ = do   cmdCompileRecursiveDS config bBuildExe store [filePath] []++ | otherwise+ = do   cmdCompile            config bBuildExe store filePath+++---------------------------------------------------------------------------------------------------+-- | Recursively compile @.ds@ source modules into @.o@ files,+--   or load existing interfaces if we have them and the @.o@ file is+--   still fresh.+--+--   * Interface files that are loaded or generated during compilation+--     are added to the interface store.+--+cmdCompileRecursiveDS+        :: Config               -- ^ Build driver config.+        -> Bool                 -- ^ Build an executable.+        -> Store                -- ^ Inferface store.+        -> [FilePath]           -- ^ Names of source files still to load.+        -> [FilePath]           -- ^ Names of source files currently blocked.+        -> ExceptT String IO ()++cmdCompileRecursiveDS _config _bBuildExe _store []           _fsBlocked+ = return ()++cmdCompileRecursiveDS  config  bBuildExe  store (filePath:fs) fsBlocked  = do   +        -- Check if the requested file exists.+        exists  <- liftIO $ doesFileExist filePath+        when (not exists)+         $ throwE $ "No such file " ++ show filePath+         -- Read in the source file.+        src             <- liftIO $ readFile filePath++        -- Parse just the header of the module to determine what+        -- other modules it imports.+        modNamesNeeded  <- tasteNeeded filePath src++        -- Names of all the modules that we have interfaces for.+        modsNamesHave   <- liftIO $ Store.getModuleNames store++        -- Names of modules that we are missing interfaces for.+        let missing     = filter (\m -> not $ elem m modsNamesHave) +                        $ modNamesNeeded++        case missing of+         -- We've already got all the interfaces needed by the+         -- current module.+         [] -> do+                -- Compile the current module.+                cmdLoadOrCompile config bBuildExe store filePath++                -- Build other modules that are still queued.+                cmdCompileRecursiveDS config bBuildExe store fs []++         -- We still need to load or compile dependent modules.+         ms -> do+                -- Determine filepaths for all dependent modules.+                fsMore  <- mapM (locateModuleFromConfig config) ms++                -- Check that we're not on a recursive loop, +                -- trying to compile a module that's importing itself.+                let fsRec = List.intersect fsMore fsBlocked+                when (not $ null fsRec)+                 $ throwE $ unlines+                 $  [ "Cannot build recursive module" ]+                 ++ [ "    " ++ show fsRec ]++                -- Shift the current module to the end of the queue, +                -- compiling the dependent modules first.+                cmdCompileRecursiveDS config bBuildExe store +                        (List.nub $ fsMore ++ fs ++ [filePath]) +                        (filePath : fsBlocked)+++---------------------------------------------------------------------------------------------------+-- | Load the interface correponding to a source file,+--   or re-compile the source if it's fresher than the interface.+--+--   * Interfaces for dependent modules must already be in the+--     interface store.+--+cmdLoadOrCompile+        :: Config               -- ^ Build driver config.+        -> Bool                 -- ^ Build an exeecutable.+        -> Store                -- ^ Interface store.+        -> FilePath             -- ^ Path to source file.+        -> ExceptT String IO ()++cmdLoadOrCompile config buildExe store filePath+ = do+        -- Check that the source file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath +        -- Read in the source file.         src             <- liftIO $ readFile filePath+        Just timeDS     <- liftIO $ getModificationTimeIfExists filePath++        -- Parse just the header of the module to determine what other modules+        -- it imports.+        modNamesNeeded  <- tasteNeeded filePath src++        -- It's safe to reload the module from an inteface file if:+        --  1. There is an existing interface which is fresher than the source.+        --  2. There is an existing object    which is fresher than the source.+        --  3. There is an existing interface which is fresher than the +        --     interfaces of all dependencies.+        --+        -- Additionally, we force rebuild for the top level module, because+        -- that's what was mentioned on the command line. We're trying to+        -- follow the principle of least surprise in this regard.+        --+        let filePathO   =  objectPathOfConfig config filePath+        let filePathDI  =  replaceExtension filePathO ".di"+        mTimeO          <- liftIO $ getModificationTimeIfExists filePathO+        mTimeDI         <- liftIO $ getModificationTimeIfExists filePathDI+        meta'           <- liftIO $ Store.getMeta store++        let loadOrCompile+                -- object and interface are fresher than source.+                | Just timeO    <- mTimeO,      timeDS < timeO+                , Just timeDI   <- mTimeDI,     timeDS < timeDI++                  -- Interface at least as fresh than all dependencies.+                  -- See Note: Timestamp accuracy during rebuild.+                , and   [ Store.metaTimeStamp m <= timeDI +                                | m <- meta'+                                , elem (Store.metaModuleName m) modNamesNeeded ]++                  -- this is not the top-level module.+                , not $ takeFileName filePath == "Main.ds"+                = do+                        result  <- liftIO $ Store.load filePathDI+                        case result of+                         Left  err -> throwE $ P.renderIndent $ P.ppr err+                         Right int -> liftIO $ Store.wrap store int++                | otherwise+                = do    cmdCompile config buildExe store filePath++        loadOrCompile+++---------------------------------------------------------------------------------------------------+-- | Compile a source module into a @.o@ file.+--+--   * Interfaces for dependent modules must already be in the interface+--     store.+--+--   * This produces an @.o@ file next to the source file, and may also+--     produce a @.di@ interface, depending on what sort of source file+--     we're compiling.+-- +--   * If compilation produces an interface then it is added to the+--     existing store.+--+cmdCompile+        :: Config               -- ^ Build driver config.+        -> Bool                 -- ^ Build an executable.+        -> Store                -- ^ Interface store.+        -> FilePath             -- ^ Path to source file.+        -> ExceptT String IO ()++cmdCompile config bBuildExe' store filePath+ = do   +        let buildExe+                =  takeBaseName filePath == "Main"+                && bBuildExe'++        if buildExe +         then liftIO $ putStrLn $ "* Compiling " ++ filePath ++ " as executable"+         else liftIO $ putStrLn $ "* Compiling " ++ filePath+         let ext         = takeExtension filePath         let source      = SourceFile filePath -        -- Decide what to do based on file extension.+        -- Read in the source file.+        exists  <- liftIO $ doesFileExist filePath+        when (not exists)+         $ throwE $ "No such file " ++ show filePath++        src     <- liftIO $ readFile filePath++        -- If we're building an executable, then get paths to the other object+        -- files that we need to link with.+        metas   <- liftIO $ Store.getMeta store+        let pathsDI     = map Store.metaFilePath metas+        let otherObjs+                | buildExe  = Just $ map (\path -> replaceExtension path "o") pathsDI+                | otherwise = Nothing++        -- During complation of this module the intermediate code will be+        -- stashed in these refs. We will use the intermediate code to build+        -- the interface for this module.+        refTetra <- liftIO $ newIORef Nothing+        refSalt  <- liftIO $ newIORef Nothing++        -- Use the file extension to decide what compilation pipeline to use.         let make                 -- Compile a Source Tetra module.-                | ext == ".dst"+                | ext == ".ds"                 = liftIO                 $ pipeText (nameOfSource source) (lineStartOfSource source) src-                $ stageSourceTetraLoad config source-                [ PipeCoreReannotate  (const ())-                [ stageTetraToSalt     config source pipesSalt ]]+                $ stageSourceTetraLoad config source store+                [ PipeCoreHacks      (Canned $ \m -> writeIORef refTetra (Just m) >> return m)+                [ PipeCoreReannotate (const ())+                [ stageTetraToSalt    config source pipesSalt ]]]                  -- Compile a Core Tetra module.                 | ext == ".dct"@@ -43,40 +275,179 @@                 $ stageTetraLoad    config source                 [ stageTetraToSalt  config source pipesSalt ] -                -- Compile a Core Lite module.-                | ext == ".dcl"+                -- Compile a Core Salt module.+                | ext == ".dcs"                 = liftIO                  $ pipeText (nameOfSource source) (lineStartOfSource source) src-                $ stageLiteLoad     config source-                [ stageLiteOpt      config source  -                [ stageLiteToSalt   config source pipesSalt ]]+                $ stageSaltLoad     config source pipesSalt                  -- Compile a Core Salt module.-                | ext == ".dcs"+                | ext == ".dcf"                 = liftIO                  $ pipeText (nameOfSource source) (lineStartOfSource source) src-                $ stageSaltLoad     config source pipesSalt+                $ pipelineFlowToTetra config Flow.defaultConfigScalar source pipesSalt                  -- Unrecognised.                 | otherwise-                = throwError $ "Cannot compile '" ++ ext ++ "' files."+                = throwE $ "Cannot compile '" ++ ext ++ "' files."              pipesSalt              = case configViaBackend config of                 ViaLLVM                  -> [ PipeCoreReannotate (const ())-                    [ stageSaltOpt      config source-                    [ stageSaltToLLVM   config source -                    [ stageCompileLLVM  config source filePath False ]]]]+                    [ stageSaltOpt     config source+                    [ PipeCoreHacks    (Canned $ \m -> writeIORef refSalt (Just m) >> return m)+                    [ stageSaltToLLVM  config source +                    [ stageCompileLLVM config source filePath otherObjs ]]]]]                  ViaC                  -> [ PipeCoreReannotate (const ())-                    [ stageSaltOpt      config source-                    [ stageCompileSalt  config source filePath False ]]]+                    [ stageSaltOpt     config source+                    [ stageCompileSalt config source filePath False ]]] -        -- Throw any errors that arose during compilation.+        -- Run the compilation pipeline.         errs <- make+++        -- Read back intermediate code from our refs.+        --   This will be written out as part of the interface file for this module.+        modTetra  <- liftIO $ readIORef refTetra+        modSalt   <- liftIO $ readIORef refSalt++        -- Handle errors ------------------------         case errs of-         []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         -- There was some error during compilation.+         es@(_:_)     +          -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es +         -- Compilation was successful, +         --  but we need to have produced at least a Tetra or Salt module+         --  before we can build the interface file.+         []    +          | Just (mn : _)       +                <- sequence +                        [ liftM C.moduleName modTetra+                        , liftM C.moduleName modSalt ]+          -> do+                -- write out the interface file.+                let pathO       = objectPathOfConfig config filePath+                let pathDI      = replaceExtension pathO ".di"++                timeDI  <- liftIO $ getCurrentTime +                let int = Interface+                        { interfaceVersion      = Version.version+                        , interfaceFilePath     = pathDI+                        , interfaceTimeStamp    = timeDI+                        , interfaceModuleName   = mn+                        , interfaceTetraModule  = modTetra +                        , interfaceSaltModule   = modSalt  }++                liftIO  $ writeFile pathDI+                        $ P.renderIndent $ P.ppr int++                -- Add the new interface to the store.+                liftIO $ Store.wrap store int++                return ()++          -- Compilation was successful,+          --  but we didn't get enough build products to produce an interface file.+          | otherwise+          -> return ()+++---------------------------------------------------------------------------------------------------+-- Taste the header of the module to see what other modules it depends on.+--  Only Source modules can import other modules.+--  For core modules, all the required information is listed explicitly +--  in the module itself.+tasteNeeded+        :: FilePath             -- ^ Path of module.+        -> String               -- ^ Module source.+        -> ExceptT String IO [C.ModuleName]++tasteNeeded filePath src + | takeExtension filePath == ".ds"+ = do    +        -- Lex the module, dropping all tokens after and including+        -- the first 'where', because we only need the module header.+        let tokens +                = dropBody+                $ SE.lexModuleString filePath 1 src++        let context +                = C.Context+                { C.contextTrackedEffects         = True+                , C.contextTrackedClosures        = True+                , C.contextFunctionalEffects      = False+                , C.contextFunctionalClosures     = False +                , C.contextMakeStringName         = Nothing }++        case BP.runTokenParser C.describeTok filePath+                (SE.pModule context) tokens of+         Left  err  -> throwE $ P.renderIndent $ P.ppr err+         Right mm   -> return $ SE.moduleImportModules mm++ | otherwise+ = return []+++---------------------------------------------------------------------------------------------------+-- | Given a driver config, locate the module with the given name.+locateModuleFromConfig +        :: Config +        -> C.ModuleName +        -> ExceptT String IO FilePath++locateModuleFromConfig config mname+ = do   -- Automatically look for modules in the base library.+        let baseDirs +                =  configModuleBaseDirectories config+                ++ [Builder.buildBaseSrcDir (configBuilder config)+                        </> "tetra" </> "base"]++        Locate.locateModuleFromPaths baseDirs mname ".ds"+++-- | If the given file exists then get its modification time,+--   otherwise Nothing.+getModificationTimeIfExists :: FilePath -> IO (Maybe UTCTime)+getModificationTimeIfExists path+ = do   exists  <- doesFileExist path+        if exists +         then do+                timeStamp <- getModificationTime path+                return $ Just timeStamp++         else   return Nothing+++-- | Drop tokens after and including the first 'where' keyword.+--   When parsing just the module header we can drop these tokens+--   because they only represent the body of the module.+dropBody :: [Token (C.Tok n)] -> [Token (C.Tok n)]+dropBody toks = go toks+ where  go []                                      = []+        go (Token { tokenTok = C.KA C.KWhere} : _) = []+        go (t : moar)                              = t : go moar+++-- [Note: Timestamp acccuracy during rebuild]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- There's an ugly system where if the underlying file system does not+-- support file time stamps with sub-second accuracy, then the timestamps+-- of the interface files we compile in this run will have more accuracy+-- than the ones we load from the file system.+-- +-- The problem with inaccurate timestamps is that if we compiled two +-- dependent modules within the same second, then both will have the+-- same time-stamp and none is fresher than the other.+--+-- Due to this we allow the time stamp of dependent interface files to+-- be equal so that they will not be rebuilt in this situation.+--+-- We assume that if any process legitimately changes a dependent+-- object file then this will be done at least a second after we first+-- created it.+--

@@ -6,9 +6,9 @@ import DDC.Build.Language.Flow import DDC.Driver.Stage import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Data.Canned-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified DDC.Core.Flow.Transform.Concretize     as Concretize import qualified DDC.Core.Check                         as C@@ -20,7 +20,7 @@         :: Config         -> Source       -- ^ Source of the code.         -> String       -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdFlowConcretize config source sourceText  = let  pmode   = prettyModeOfConfig $ configPretty config@@ -39,7 +39,7 @@         errs    <- liftIO pipeConcretize         case errs of          []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es   

@@ -2,11 +2,11 @@ module DDC.Driver.Command.Flow.Lower         (cmdFlowLower) where-import DDC.Driver.Stage                         as Driver-import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Stage+import DDC.Driver.Config                        as Driver+import DDC.Driver.Interface.Source import DDC.Build.Pipeline-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified DDC.Base.Pretty                as P import qualified DDC.Core.Check                 as C@@ -20,7 +20,7 @@         -> Flow.Config          -- ^ Config for the lowering transform.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdFlowLower         configDriver configLower@@ -35,7 +35,9 @@          $  stageFlowLoad  configDriver source           [  stageFlowPrep  configDriver source          [  PipeCoreCheck  Flow.fragment C.Recon SinkDiscard-         [  stageFlowLower configDriver configLower source [ pipeFinal ]]]]+         [  stageFlowLower configDriver configLower source+         [ PipeCoreOutput pmode SinkStdout , pipeFinal ]]]]+         -- [ pipeFinal ]]]]          pipeFinal          | configTaintAvoidTypeChecks configDriver@@ -43,11 +45,11 @@           | otherwise          = PipeCoreCheck    Flow.fragment C.Recon SinkDiscard-         [ PipeCoreOutput   pmode SinkStdout ]+         [] -- [ PipeCoreOutput   pmode SinkStdout ]     in do                 errs    <- liftIO pipeLower         case errs of          []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es 

@@ -2,12 +2,12 @@ module DDC.Driver.Command.Flow.Melt         (cmdFlowMelt) where-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Driver.Stage import DDC.Driver.Config import DDC.Build.Pipeline import DDC.Build.Language.Flow-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified DDC.Core.Check         as C import qualified DDC.Base.Pretty        as P@@ -21,7 +21,7 @@         :: Config               -- ^ Driver config.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdFlowMelt config source sourceText  = let  pmode   = prettyModeOfConfig $ configPretty config@@ -41,7 +41,7 @@         errs    <- liftIO pipeMelt         case errs of          []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es   

@@ -4,9 +4,9 @@ where import DDC.Driver.Stage import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified DDC.Core.Check                 as C import qualified DDC.Base.Pretty                as P@@ -18,7 +18,7 @@         :: Config               -- ^ Driver config.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdFlowPrep config source sourceText  = let  pmode   = prettyModeOfConfig $ configPretty config@@ -35,5 +35,5 @@         errs    <- liftIO pipePrep         case errs of          []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es 

@@ -1,16 +1,18 @@  module DDC.Driver.Command.Flow.Rate-        (cmdFlowRate)+        ( cmdFlowRate+        , cmdFlowRateLower ) where import DDC.Driver.Stage import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified DDC.Base.Pretty                as P import qualified DDC.Core.Check                 as C import qualified DDC.Build.Language.Flow        as Flow+import qualified DDC.Core.Flow                  as Flow   -- | Perform rate inference to transform vector operations to series@@ -18,7 +20,7 @@         :: Config               -- ^ Driver config.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdFlowRate config source sourceText  = let  pmode   = prettyModeOfConfig $ configPretty config@@ -36,5 +38,35 @@         errs    <- liftIO pipeRate         case errs of          []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es+++-- | Perform rate inference, then lower+cmdFlowRateLower+        :: Config               -- ^ Driver config.+        -> Flow.Config          -- ^ Config for the lowering transform.+        -> Source               -- ^ Source of the code.+        -> String               -- ^ Program module text.+        -> ExceptT String IO ()++cmdFlowRateLower config configLower source sourceText+ = let  pmode   = prettyModeOfConfig $ configPretty config+        +        pipeRate+         = pipeText (nameOfSource source)+                    (lineStartOfSource source)+                    sourceText+         $ stageFlowLoad  config source +         [ stageFlowRate  config source +         [ stageFlowPrep  config source+         [ PipeCoreCheck  Flow.fragment C.Recon SinkDiscard+         [ stageFlowLower config configLower source+         [ PipeCoreCheck  Flow.fragment C.Recon SinkDiscard+         [ PipeCoreOutput pmode SinkStdout ]]]]]]+   +   in do+        errs    <- liftIO pipeRate+        case errs of+         []     -> return ()+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es 

@@ -2,14 +2,14 @@ module DDC.Driver.Command.Flow.Thread         (cmdFlowThread) where-import DDC.Interface.Source-import DDC.Build.Pipeline-import DDC.Build.Language.Flow+import DDC.Driver.Interface.Source import DDC.Driver.Stage import DDC.Driver.Config+import DDC.Build.Pipeline+import DDC.Build.Language.Flow import DDC.Core.Fragment import DDC.Data.Canned-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified DDC.Core.Transform.Thread      as Thread import qualified DDC.Core.Flow.Transform.Thread as Flow@@ -25,7 +25,7 @@         :: Config               -- ^ Driver config.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdFlowThread config source sourceText  = let  pmode   = prettyModeOfConfig $ configPretty config@@ -48,5 +48,5 @@         errs    <- liftIO pipeThread         case errs of          []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es 

@@ -0,0 +1,144 @@++module DDC.Driver.Command.Flow.ToTetra+        ( cmdFlowToTetraFromFile+        , cmdFlowToTetraCoreFromFile+        , cmdFlowToTetraCoreFromString+        , pipelineFlowToTetra)+where+import DDC.Driver.Stage+import DDC.Driver.Config+import DDC.Driver.Interface.Source+import DDC.Build.Pipeline+import DDC.Build.Language+import DDC.Core.Fragment+import DDC.Base.Pretty+import System.FilePath+import System.Directory+import Control.Monad.Trans.Except+import Control.Monad.IO.Class+import Control.Monad+import qualified DDC.Build.Language.Salt        as Salt +import qualified DDC.Core.Salt                  as Salt +import qualified DDC.Build.Language.Flow        as Flow+import qualified DDC.Core.Flow                  as Flow+import qualified DDC.Core.Check                 as C++import DDC.Data.Canned+import qualified DDC.Core.Flow.Transform.Concretize     as Concretize+++-------------------------------------------------------------------------------+-- | Convert a module to Core Tetra.+--   The output is printed to @stdout@.+--   Any errors are thrown in the `ExceptT` monad.+--+cmdFlowToTetraFromFile+        :: Config               -- ^ Driver config.+        -> Flow.Config          -- ^ Config for the lowering transform.+        -> FilePath             -- ^ Module file path.+        -> ExceptT String IO ()++cmdFlowToTetraFromFile config configLower filePath++ -- Convert a module in some fragment of Disciple Core.+ | Just language <- languageOfExtension (takeExtension filePath)+ =      cmdFlowToTetraCoreFromFile config configLower language filePath++ -- Don't know how to convert this file.+ | otherwise+ = let  ext     = takeExtension filePath+   in   throwE $ "Cannot convert '" ++ ext ++ "' files to Tetra."+++-------------------------------------------------------------------------------+-- | Convert some fragment of Disciple Core to Core Tetra.+--   Works for the 'Flow' fragment.+--   The result is printed to @stdout@.+--   Any errors are thrown in the `ExceptT` monad.+--+cmdFlowToTetraCoreFromFile+        :: Config               -- ^ Driver config.+        -> Flow.Config          -- ^ Config for the lowering transform.+        -> Language             -- ^ Core language definition.+        -> FilePath             -- ^ Module file path.+        -> ExceptT String IO ()  ++cmdFlowToTetraCoreFromFile config configLower language filePath+ = do   +        -- Check that the file exists.+        exists  <- liftIO $ doesFileExist filePath+        when (not exists)+         $ throwE $ "No such file " ++ show filePath++        -- Read in the source file.+        src     <- liftIO $ readFile filePath++        cmdFlowToTetraCoreFromString config configLower language (SourceFile filePath) src+++-------------------------------------------------------------------------------+-- | Convert some fragment of Disciple Core to Core Tetra.+--   Works for the 'Tetra' fragment.+--   The result is printed to @stdout@.+--   Any errors are thrown in the `ExceptT` monad.+--+cmdFlowToTetraCoreFromString+        :: Config               -- ^ Driver config.+        -> Flow.Config          -- ^ Config for the lowering transform.+        -> Language             -- ^ Language definition.+        -> Source               -- ^ Source of the code.+        -> String               -- ^ Program module text.+        -> ExceptT String IO ()++cmdFlowToTetraCoreFromString config configLower language source str+ | Language bundle      <- language+ , fragment             <- bundleFragment bundle+ , profile              <- fragmentProfile fragment+ = do   +        -- Language fragment name.+        let fragName    = profileName profile++        -- Pretty printer mode.+        let pmode       = prettyModeOfConfig $ configPretty config++        -- Decide what to do based on the fragment name.+        let compile+                -- Compile a Core Tetra module to Tetra.+                | fragName == "Flow"+                = liftIO+                $ pipeText (nameOfSource source) (lineStartOfSource source) str+                $ pipelineFlowToTetra config configLower source+                [ PipeCoreCheck    Salt.fragment C.Recon SinkDiscard+                  []+                , PipeCoreOutput   pmode SinkStdout]++                -- Unrecognised fragment name or file extension.+                | otherwise+                = throwE $ "Cannot convert '" ++ fragName ++ "' modules to Salt."++        -- Throw any errors that arose during compilation+        errs <- compile+        case errs of+         []     -> return ()+         es     -> throwE $ renderIndent $ vcat $ map ppr es+++pipelineFlowToTetra +        :: Config +        -> Flow.Config +        -> Source +        -> [PipeCore () Salt.Name] +        -> PipeText Flow.Name Flow.Error++pipelineFlowToTetra config configLower source pipesSalt+ = stageFlowLoad    config source+ [ stageFlowRate    config source+ [ stageFlowPrep  config source+ [ PipeCoreCheck  Flow.fragment C.Recon SinkDiscard+ [ stageFlowLower   config configLower source+ [ PipeCoreHacks (Canned $ \m -> return $ Concretize.concretizeModule m)+ [ PipeCoreCheck    Flow.fragment C.Recon SinkDiscard+ [ stageFlowWind    config source+ [ PipeCoreCheck    Flow.fragment C.Recon SinkDiscard+ [ stageFlowToTetra config source+   pipesSalt]]]]]]]]]

@@ -4,9 +4,9 @@ where import DDC.Driver.Stage import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified DDC.Base.Pretty                as P import qualified DDC.Core.Check                 as C@@ -18,7 +18,7 @@         :: Config         -> Source       -- ^ Source of the code.         -> String       -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdFlowWind config source sourceText  = let  pmode   = prettyModeOfConfig $ configPretty config@@ -43,4 +43,4 @@         errs    <- liftIO pipeLower         case errs of          []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es

@@ -5,31 +5,41 @@         , cmdLoadSourceTetraFromString         , cmdLoadCoreFromFile         , cmdLoadCoreFromString-        , cmdLoadSimplifier)+        , cmdLoadSimplifier+        , cmdLoadSimplifierIntoBundle) where-import DDC.Interface.Source+import DDC.Driver.Command.Compile+import DDC.Driver.Command.Read+import DDC.Driver.Stage+import DDC.Driver.Config+import DDC.Driver.Interface.Source import DDC.Build.Pipeline import DDC.Build.Language import DDC.Core.Simplifier.Parser import DDC.Core.Transform.Reannotate-import DDC.Driver.Command.Read-import DDC.Driver.Stage-import DDC.Driver.Config-import DDC.Core.Annot.AnTEC+import DDC.Core.Exp.Annot.AnTEC import DDC.Core.Pretty+import DDC.Data.SourcePos import Control.Monad-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class+import Control.DeepSeq import System.FilePath import System.Directory+import DDC.Build.Interface.Store                (Store) import qualified Data.Map                       as Map import qualified DDC.Core.Check                 as C+import qualified DDC.Build.Language.Tetra       as Tetra+import qualified DDC.Build.Spec.Parser          as Spec+import qualified DDC.Build.Interface.Load       as Interface+import qualified DDC.Core.Tetra                 as Tetra  ----------------------------------------------------------------------------------- | Load and transform a module.+---------------------------------------------------------------------------------------------------+-- | Load and transform source code, interface, or build file.+-- --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. -- --   This function handle fragments of Disciple Core, as well as Source Tetra --   modules. The language to use is determined by inspecting the file name@@ -37,19 +47,50 @@ --       --   We also take the specification of a simplifier to apply to the module. --+--   For Source Tetra modules, dependent modules will be compiled,+--   or their interfaces loaded as needed.+-- cmdLoadFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> Maybe String         -- ^ Simplifier specification.         -> [FilePath]           -- ^ More modules to use as inliner templates.         -> FilePath             -- ^ Module file name.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdLoadFromFile config mStrSimpl fsTemplates filePath+cmdLoadFromFile config store mStrSimpl fsTemplates filePath + -- Load build file.+ | ".build"     <- takeExtension filePath+ = do   +        str     <- liftIO $ readFile filePath+        case Spec.parseBuildSpec filePath str of+         Left err       -> throwE $ show err+         Right spec     -> liftIO $ putStrLn $ show spec++ -- Load an interface file.+ | ".di"        <- takeExtension filePath+ = do+        str     <- liftIO $ readFile filePath+        timeDI  <- liftIO $ getModificationTime filePath+        case Interface.loadInterface filePath timeDI str of+         Left err        -> throwE $ renderIndent $ ppr err+         Right interface -> liftIO $ putStrLn $ renderIndent $ ppr interface+  -- Load a Disciple Source Tetra module.- | ".dst"        <- takeExtension filePath- =      cmdLoadSourceTetraFromFile config filePath+ | ".ds"        <- takeExtension filePath+ = case mStrSimpl of+        Nothing+         -> do  cmdLoadSourceTetraFromFile config store Tetra.bundle filePath +        Just strSimpl+         -> do  -- Parse the specified simplifier.+                bundle' <- cmdLoadSimplifierIntoBundle config +                                Tetra.bundle strSimpl fsTemplates++                -- Load a simplify the target module.+                cmdLoadSourceTetraFromFile config store bundle' filePath+  -- Load a module in some fragment of Disciple Core.  | Just language <- languageOfExtension (takeExtension filePath)  = case mStrSimpl of@@ -63,71 +104,83 @@  -- Don't know how to load this file.  | otherwise  = let  ext     = takeExtension filePath-   in   throwError $ "Cannot load '" ++ ext ++ "' files."+   in   throwE $ "Cannot load '" ++ ext ++ "' files."  --------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------- -- | Load a Disciple Source Tetra module from a file. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdLoadSourceTetraFromFile-        :: Config               -- ^ Driver config.-        -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        :: Config                               -- ^ Driver config.+        -> Store                                -- ^ Interface store.+        -> Bundle Int Tetra.Name Tetra.Error    -- ^ Tetra language bundle.+        -> FilePath                             -- ^ Module file path.+        -> ExceptT String IO () -cmdLoadSourceTetraFromFile config filePath+cmdLoadSourceTetraFromFile config store bundle filePath  = do            -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath +        -- Call the compiler to build/load all dependent modules.+        cmdCompileRecursive config False store filePath+         -- Read in the source file.         src     <- liftIO $ readFile filePath--        cmdLoadSourceTetraFromString config (SourceFile filePath) src+                +        cmdLoadSourceTetraFromString config store bundle +                (SourceFile filePath) src  --------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------- -- | Load a Disciple Source Tetra module from a string. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdLoadSourceTetraFromString-        :: Config               -- ^ Driver config.-        -> Source               -- ^ Source of the code.-        -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        :: Config                               -- ^ Driver config.+        -> Store                                -- ^ Interface store.+        -> Bundle Int Tetra.Name Tetra.Error    -- ^ Tetra language bundle.+        -> Source                               -- ^ Source of the code.+        -> String                               -- ^ Program module text.+        -> ExceptT String IO () -cmdLoadSourceTetraFromString config source str+cmdLoadSourceTetraFromString config store bundle source str  = let         pmode   = prettyModeOfConfig $ configPretty config          pipeLoad          = pipeText     (nameOfSource source) (lineStartOfSource source) str-         $ stageSourceTetraLoad config source-         [ PipeCoreOutput pmode SinkStdout ]+         $ stageSourceTetraLoad config source store+         [ PipeCoreReannotate (\a -> a { annotTail = () })+         [ PipeCoreSimplify   Tetra.fragment    (bundleStateInit  bundle) +                                                (bundleSimplifier bundle)+         [ PipeCoreOutput pmode SinkStdout ]]]+    in do         errs    <- liftIO pipeLoad         case errs of          [] -> return ()-         es -> throwError $ renderIndent $ vcat $ map ppr es+         es -> throwE $ renderIndent $ vcat $ map ppr es   --------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------- -- | Load a Disciple Core module from a file. --   The result is printed to @stdout@. cmdLoadCoreFromFile         :: Config               -- ^ Driver config.         -> Language             -- ^ Core language definition.         -> FilePath             -- ^ Module file path-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdLoadCoreFromFile config language filePath  = do         -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath          -- Read in the source file.         src     <- liftIO $ readFile filePath@@ -135,7 +188,7 @@         cmdLoadCoreFromString config language (SourceFile filePath) src  --------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------- -- | Load a Disciple Core module from a string. --   The result it printed to @stdout@. cmdLoadCoreFromString@@ -143,7 +196,7 @@         -> Language             -- ^ Language definition         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdLoadCoreFromString config language source str  | Language bundle      <- language@@ -151,15 +204,10 @@  = let           pmode           = prettyModeOfConfig $ configPretty config -        -- The type inferencer doesn't work with the Lite fragment.-        config'         = if fragmentExtension fragment == "dcl"-                                then config { configInferTypes = False}-                                else config-         pipeLoad          = pipeText     (nameOfSource source) (lineStartOfSource source) str          $ PipeTextLoadCore  fragment -                        (if configInferTypes config' then C.Synth else C.Recon) +                        (if configInferTypes config then C.Synth else C.Recon)                          SinkDiscard          [ PipeCoreReannotate (\a -> a { annotTail = () })          [ PipeCoreSimplify  fragment (bundleStateInit bundle)@@ -170,10 +218,10 @@         errs    <- liftIO pipeLoad         case errs of          [] -> return ()-         es -> throwError $ renderIndent $ vcat $ map ppr es+         es -> throwE $ renderIndent $ vcat $ map ppr es  --------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------------- -- | Parse the simplifier defined in this string,  --   and load it and all the inliner templates into the language bundle. cmdLoadSimplifier @@ -181,11 +229,26 @@         -> Language             -- ^ Language definition.         -> String               -- ^ Simplifier specification.         -> [FilePath]           -- ^ Modules to use as inliner templates.-        -> ErrorT String IO Language+        -> ExceptT String IO Language  cmdLoadSimplifier config language strSimpl fsTemplates  | Language bundle      <- language- , modules_bundle       <- bundleModules bundle+ = do   bundle' <- cmdLoadSimplifierIntoBundle config bundle strSimpl fsTemplates+        return  $ Language bundle'+++-- | Parse the simplifier defined in this string,+--   and load it and all the inliner templates into the bundle+cmdLoadSimplifierIntoBundle+        :: (Ord n, Show n, NFData n, Pretty n, Pretty (err (AnTEC SourcePos n)))+        => Config               -- ^ Driver config.+        -> Bundle s n err       -- ^ Language bundle+        -> String               -- ^ Simplifier specification.+        -> [FilePath]           -- ^ Modules to use as inliner templates.+        -> ExceptT String IO (Bundle s n err)++cmdLoadSimplifierIntoBundle config bundle strSimpl fsTemplates+ | modules_bundle       <- bundleModules bundle  , mkNamT               <- bundleMakeNamifierT bundle  , mkNamX               <- bundleMakeNamifierX bundle  , rules                <- bundleRewriteRules bundle@@ -202,21 +265,17 @@          modules_annot          <- case mModules of-                 Nothing -> throwError $ "Cannot load inlined module."+                 Nothing -> throwE $ "Cannot load inlined module."                  Just ms -> return     $ ms          -- Zap annotations on the loaded modules.         -- Any type errors will already have been displayed, so we don't need          -- the source position info any more.-        let zapAnnot annot-                = annot { annotTail = () }--        let modules_new -                = map (reannotate zapAnnot) modules_annot+        let zapAnnot annot = annot { annotTail = () }+        let modules_new    = map (reannotate zapAnnot) modules_annot          -- Collect all definitions from modules-        let modules_all-                = Map.elems modules_bundle ++ modules_new+        let modules_all    = Map.elems modules_bundle ++ modules_new          -- Wrap up the inliner templates and current rules into         -- a SimplifierDetails, which we give to the Simplifier parser.@@ -227,9 +286,6 @@          -- Parse the simplifer string.         case parseSimplifier readName details strSimpl of-         Left err-          -> throwError $ renderIndent $ ppr err--         Right simpl-          -> return $ Language $ bundle { bundleSimplifier = simpl }+         Left err    -> throwE $ renderIndent $ ppr err+         Right simpl -> return $ bundle { bundleSimplifier = simpl } 

@@ -1,81 +0,0 @@--module DDC.Driver.Command.Make-        (cmdMake)-where-import DDC.Driver.Stage-import DDC.Interface.Source-import DDC.Build.Pipeline-import System.FilePath-import System.Directory-import Control.Monad.Trans.Error-import Control.Monad.IO.Class-import Control.Monad-import qualified DDC.Core.Pretty        as P----- | Make a source module into an executable.-cmdMake :: Config -> FilePath -> ErrorT String IO ()-cmdMake config filePath- = do-        -- Read in the source file.-        exists  <- liftIO $ doesFileExist filePath-        when (not exists)-         $ throwError $ "No such file " ++ show filePath--        src             <- liftIO $ readFile filePath-        let ext         = takeExtension filePath-        let source      = SourceFile filePath--        -- Decide what to do based on file extension.-        let make-                -- Make a Source Tetra module.-                | ext == ".dst"-                = liftIO-                $ pipeText (nameOfSource source) (lineStartOfSource source) src-                $ stageSourceTetraLoad config source-                [ PipeCoreReannotate  (const ())-                [ stageTetraToSalt     config source pipesSalt ]]--                -- Make a Core Tetra module.-                | ext == ".dct"-                = liftIO-                $ pipeText (nameOfSource source) (lineStartOfSource source) src-                $ stageTetraLoad    config source-                [ stageTetraToSalt  config source pipesSalt ]--                -- Make a Core Lite module.-                | ext == ".dcl"-                = liftIO-                $ pipeText (nameOfSource source) (lineStartOfSource source) src-                $ stageLiteLoad     config source-                [ stageLiteOpt      config source  -                [ stageLiteToSalt   config source pipesSalt ]]--                -- Make a Core Salt module.-                | ext == ".dcs"-                = liftIO-                $ pipeText (nameOfSource source) (lineStartOfSource source) src-                $ stageSaltLoad     config source pipesSalt --                -- Unrecognised.-                | otherwise-                = throwError $ "Cannot make '" ++ filePath ++ "' files."--            pipesSalt-             = case configViaBackend config of-                ViaLLVM-                 -> [ PipeCoreReannotate (const ())-                    [ stageSaltOpt      config source-                    [ stageSaltToLLVM   config source -                    [ stageCompileLLVM  config source filePath True ]]]]--                ViaC-                 -> [ PipeCoreReannotate (const ())-                    [ stageSaltOpt      config source-                    [ stageCompileSalt  config source filePath True ]]]--        -- Throw any errors that arose during compilation.-        errs <- make-        case errs of-         []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es

@@ -14,7 +14,7 @@ import DDC.Core.Lexer                   as C import DDC.Base.Parser                  as BP import DDC.Data.Token                   as Token-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import System.FilePath import System.Directory@@ -24,7 +24,7 @@ ------------------------------------------------------------------------------- -- | Parse a module. --   The result AST is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. -- --   This function handle fragments of Disciple Core, as well as Source Tetra --   modules. The language to use is determined by inspecting the file name@@ -33,12 +33,12 @@ cmdParseFromFile          :: Config               -- ^ Driver config.         -> FilePath             -- ^ Module file name.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdParseFromFile config filePath    -- Parse a Disciple Source Tetra module.- | ".dst"        <- takeExtension filePath+ | ".ds"         <- takeExtension filePath  =  cmdParseSourceTetraFromFile config filePath   -- Parse a module in some fragment of Disciple Core.@@ -48,24 +48,24 @@  -- Don't know how to parse this file.  | otherwise  = let  ext     = takeExtension filePath-   in   throwError $ "Cannot parse '" ++ ext ++ "' files."+   in   throwE $ "Cannot parse '" ++ ext ++ "' files."   ------------------------------------------------------------------------------- -- | Parse a Disciple Source Tetra module from a file. --   The result AST is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdParseSourceTetraFromFile         :: Config               -- ^ Driver config.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdParseSourceTetraFromFile config filePath  = do            -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath          -- Read in the source file.         src     <- liftIO $ readFile filePath@@ -80,18 +80,12 @@         when (configDump config)          $ liftIO $ writeFile "dump.tetra-parse.tokens"                    $ unlines $ map show $ map Token.tokenTok toks--        let context = ST.Context-                    { ST.contextTrackedEffects          = True-                    , ST.contextTrackedClosures         = True-                    , ST.contextFunctionalEffects       = False-                    , ST.contextFunctionalClosures      = False }                              case BP.runTokenParser                 C.describeTok filePath                  (ST.pModule context) toks of          Left err -          ->    throwError (renderIndent $ ppr err)+          ->    throwE (renderIndent $ ppr err)                    Right mm           ->    liftIO $ putStrLn (renderIndent $ ppr mm)@@ -100,12 +94,12 @@ ------------------------------------------------------------------------------- -- | Parse a Disciple Core module from a file. --   The AST is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdParseCoreFromFile         :: Config               -- ^ Driver config         -> Language             -- ^ Core language definition.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdParseCoreFromFile _config language filePath  | Language bundle      <- language@@ -115,7 +109,7 @@         -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath          -- Read in the source file.         src     <- liftIO $ readFile filePath@@ -127,7 +121,7 @@                 C.describeTok filePath                  (C.pModule (C.contextOfProfile profile)) toks of          Left err-          ->    throwError (renderIndent $ ppr err)+          ->    throwE (renderIndent $ ppr err)           Right mm           ->    liftIO $ putStrLn (renderIndent $ ppr mm)

@@ -3,7 +3,7 @@         ( cmdReadModule         , cmdReadModule') where-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Driver.Config import DDC.Build.Pipeline import DDC.Build.Language@@ -41,11 +41,6 @@  cmdReadModule' printErrors config fragment filePath  = do-        -- The inferencer doesn't work with the Lite fragment.-        let config'     = if fragmentExtension fragment == "dcl"-                                then config { configInferTypes = False }-                                else config-         -- Read in the source file.         exists  <- doesFileExist filePath         when (not exists)@@ -54,7 +49,7 @@         src     <- readFile filePath         let source   = SourceFile filePath -        cmdReadModule_parse printErrors config' filePath fragment source src+        cmdReadModule_parse printErrors config filePath fragment source src   cmdReadModule_parse printErrors config filePath fragment source src

@@ -2,7 +2,7 @@ module DDC.Driver.Command.RewriteRules         ( cmdTryReadRules ) where-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Language import DDC.Core.Fragment import DDC.Core.Simplifier@@ -88,8 +88,8 @@     liftSnd f (x, y) = (x, f y)      -- Final kind and type environments-    kinds'	= kinds `Env.union` kindsImp `Env.union` kindsExp-    types'	= types `Env.union` typesImp `Env.union` typesExp+    kinds'      = kinds `Env.union` kindsImp `Env.union` kindsExp+    types'      = types `Env.union` typesImp `Env.union` typesExp      source'  = nameOfSource source 

@@ -4,23 +4,32 @@ where import DDC.Driver.Stage import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline-import Control.Monad.Trans.Error+import System.FilePath+import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified DDC.Core.Check                 as C import qualified DDC.Base.Pretty                as P import qualified DDC.Build.Language.Tetra       as Tetra  --- | Prepare a Disciple Core Tetra module for lowering.+-- | Manage boxing in a Tetra module. cmdTetraBoxing         :: Config               -- ^ Driver config.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdTetraBoxing config source sourceText++ -- Curring only works for Disciple Core Tetra files.+ | SourceFile filePath  <- source+ , ext  <- takeExtension filePath + , ext /= ".dct"+ = throwE $ "The Boxing transform only works for Core Tetra (.dct) modules."++ | otherwise  = let  pmode   = prettyModeOfConfig $ configPretty config                  pipeBoxing@@ -35,6 +44,6 @@         errs    <- liftIO pipeBoxing         case errs of          []     -> return ()-         es     -> throwError $ P.renderIndent $ P.vcat $ map P.ppr es+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es  

@@ -0,0 +1,51 @@++module DDC.Driver.Command.Tetra.Curry+        (cmdTetraCurry)+where+import DDC.Driver.Stage+import DDC.Driver.Config+import DDC.Driver.Dump+import DDC.Driver.Interface.Source+import DDC.Build.Pipeline+import Control.Monad.Trans.Except+import Control.Monad.IO.Class+import System.FilePath+import qualified DDC.Core.Check                 as C+import qualified DDC.Base.Pretty                as P+import qualified DDC.Build.Language.Tetra       as Tetra+++-- | Manage higher order functions in a Tetra module.+cmdTetraCurry+        :: Config               -- ^ Driver config.+        -> Source               -- ^ Source of the code.+        -> String               -- ^ Program module text.+        -> ExceptT String IO ()++cmdTetraCurry config source sourceText++ -- Curring only works for Disciple Core Tetra files.+ | SourceFile filePath  <- source+ , ext  <- takeExtension filePath + , ext /= ".dct"+ = throwE $ "The Curry transform only works for Core Tetra (.dct) modules."++ | otherwise+ = let  pmode   = prettyModeOfConfig $ configPretty config++        pipeCurry+         = pipeText     (nameOfSource source)+                        (lineStartOfSource source) sourceText+         $ PipeTextLoadCore Tetra.fragment C.Recon SinkDiscard+         [ PipeCoreAsTetra+         [ PipeTetraCurry+         [ PipeCoreOutput   pmode (dump config source "dump.tetra-curry.dct")+         , PipeCoreCheck    Tetra.fragment C.Recon SinkDiscard+           [ PipeCoreOutput   pmode SinkStdout ]]]]++   in do+        errs    <- liftIO pipeCurry+        case errs of+         []     -> return ()+         es     -> throwE $ P.renderIndent $ P.vcat $ map P.ppr es+

@@ -6,35 +6,37 @@         , cmdToSeaCoreFromFile         , cmdToSeaCoreFromString) where+import DDC.Driver.Command.Compile import DDC.Driver.Stage-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline import DDC.Build.Language import DDC.Core.Fragment import DDC.Base.Pretty import System.FilePath import System.Directory-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class- import Control.Monad+import DDC.Build.Interface.Store        (Store)   ------------------------------------------------------------------------------- -- | Convert a module to C. --   The output is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. -- cmdToSeaFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> FilePath             -- ^ Core language definition.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToSeaFromFile config filePath+cmdToSeaFromFile config store filePath    -- Convert a Disciple Source Tetra module.- | ".dst"         <- takeExtension filePath- =      cmdToSeaSourceTetraFromFile config filePath+ | ".ds"          <- takeExtension filePath+ =      cmdToSeaSourceTetraFromFile config store filePath   -- Convert a module in some fragment of Disciple Core.  | Just language  <- languageOfExtension (takeExtension filePath)@@ -43,46 +45,51 @@  -- Don't know how to convert this file.  | otherwise  = let  ext     = takeExtension filePath-   in   throwError $ "Cannot convert '" ++ ext ++ "' files to C."+   in   throwE $ "Cannot convert '" ++ ext ++ "' files to C."   ------------------------------------------------------------------------------- -- | Convert Disciple Source Tetra to C. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdToSeaSourceTetraFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToSeaSourceTetraFromFile config filePath+cmdToSeaSourceTetraFromFile config store filePath  = do         -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath +        -- Call the compiler to build/load all dependent modules.+        cmdCompileRecursive config False store filePath+         -- Read in the source file.         src     <- liftIO $ readFile filePath -        cmdToSeaSourceTetraFromString config (SourceFile filePath) src+        cmdToSeaSourceTetraFromString config store (SourceFile filePath) src   ------------------------------------------------------------------------------- -- | Convert Disciple Source Tetra to C. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdToSeaSourceTetraFromString         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToSeaSourceTetraFromString config source str+cmdToSeaSourceTetraFromString config store source str  = let           pipeLoad          = pipeText (nameOfSource source) (lineStartOfSource source) str-         $ stageSourceTetraLoad config source+         $ stageSourceTetraLoad config source store          [ PipeCoreReannotate (const ())          [ stageTetraToSalt   config source           [ stageSaltOpt       config source@@ -92,27 +99,27 @@         errs    <- liftIO pipeLoad         case errs of          []     -> return ()-         es     -> throwError $ renderIndent $ vcat $ map ppr es+         es     -> throwE $ renderIndent $ vcat $ map ppr es   ------------------------------------------------------------------------------- -- | Parse, check and convert a Core module to Sea.---   Works for the 'Tetra', 'Lite' and 'Salt' fragments.+--   Works for the 'Tetra', and 'Salt' fragments. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. -- cmdToSeaCoreFromFile         :: Config               -- ^ Driver config.         -> Language             -- ^ Core language definition.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdToSeaCoreFromFile config language filePath  = do         -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath          -- Read in the source file.         src     <- liftIO $ readFile filePath@@ -123,14 +130,14 @@ ------------------------------------------------------------------------------- -- | Parse, check, and convert a module to C. --   The output is printed to @stdout@. ---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. -- cmdToSeaCoreFromString           :: Config       -- ^ Compiler configuration.         -> Language     -- ^ Language definition.         -> Source       -- ^ Source of the code.         -> String       -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdToSeaCoreFromString config language source str  | Language bundle      <- language@@ -150,17 +157,7 @@                 [ stageSaltOpt       config source                 [ stageSaltToC       config source SinkStdout]]]                 -                -- Convert a Core Lite module to C.-                | fragName == "Lite"-                = liftIO-                $ pipeText (nameOfSource source) (lineStartOfSource source) str-                $ stageLiteLoad      config source-                [ stageLiteOpt       config source -                [ stageLiteToSalt    config source -                [ stageSaltOpt       config source-                [ stageSaltToC       config source SinkStdout]]]]--                -- Convert a Core Lite module to Salt.+                -- Convert a Core Salt module to C                 | fragName == "Salt"                 = liftIO                 $ pipeText (nameOfSource source) (lineStartOfSource source) str@@ -170,12 +167,12 @@                  -- Unrecognised.                 | otherwise-                = throwError $ "Cannot convert '" ++ fragName ++ "'modules to C."+                = throwE $ "Cannot convert '" ++ fragName ++ "'modules to C."           -- Throw any errors that arose during compilation         errs <- compile         case errs of          []     -> return ()-         es     -> throwError $ renderIndent $ vcat $ map ppr es+         es     -> throwE $ renderIndent $ vcat $ map ppr es 

@@ -6,34 +6,37 @@         , cmdToLlvmCoreFromFile         , cmdToLlvmCoreFromString) where+import DDC.Driver.Command.Compile import DDC.Driver.Stage-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline import DDC.Build.Language import DDC.Core.Fragment import DDC.Base.Pretty import System.Directory import System.FilePath-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import Control.Monad+import DDC.Build.Interface.Store        (Store)   ------------------------------------------------------------------------------- -- | Convert a module to LLVM. --   The output is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. -- cmdToLlvmFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> FilePath             -- ^ Core language definition.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToLlvmFromFile config filePath+cmdToLlvmFromFile config store filePath    -- Convert a Disciple Source Tetra module.- | ".dst"         <- takeExtension filePath- =      cmdToLlvmSourceTetraFromFile config filePath+ | ".ds"          <- takeExtension filePath+ =      cmdToLlvmSourceTetraFromFile config store filePath   -- Convert a module in some fragment of Disciple Core.  | Just language  <- languageOfExtension (takeExtension filePath)@@ -42,46 +45,51 @@  -- Don't know how to convert this file.  | otherwise  = let  ext     = takeExtension filePath-   in   throwError $ "Cannot convert '" ++ ext ++ "' files to LLVM."+   in   throwE $ "Cannot convert '" ++ ext ++ "' files to LLVM."   ------------------------------------------------------------------------------- -- | Convert Disciple Source Tetra to LLVM. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdToLlvmSourceTetraFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToLlvmSourceTetraFromFile config filePath+cmdToLlvmSourceTetraFromFile config store filePath  = do         -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath +        -- Call the compiler to build/load all dependent modules.+        cmdCompileRecursive config False store filePath+         -- Read in the source file.         src     <- liftIO $ readFile filePath -        cmdToLlvmSourceTetraFromString config (SourceFile filePath) src+        cmdToLlvmSourceTetraFromString config store (SourceFile filePath) src   ------------------------------------------------------------------------------- -- | Convert Disciple Source Tetra to LLVM. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdToLlvmSourceTetraFromString         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToLlvmSourceTetraFromString config source str+cmdToLlvmSourceTetraFromString config store source str  = let           pipeLoad          = pipeText (nameOfSource source) (lineStartOfSource source) str-         $ stageSourceTetraLoad config source+         $ stageSourceTetraLoad config source store          [ PipeCoreReannotate (const ())          [ stageTetraToSalt     config source           [ stageSaltOpt         config source@@ -92,27 +100,27 @@         errs    <- liftIO pipeLoad         case errs of          []     -> return ()-         es     -> throwError $ renderIndent $ vcat $ map ppr es+         es     -> throwE $ renderIndent $ vcat $ map ppr es   ------------------------------------------------------------------------------- -- | Parse, check and convert a Core module to LLVM.---   Works for the 'Tetra', 'Lite' and 'Salt' fragments.+--   Works for the 'Tetra', and 'Salt' fragments. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. -- cmdToLlvmCoreFromFile         :: Config               -- ^ Driver config.         -> Language             -- ^ Core language definition.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdToLlvmCoreFromFile config language filePath  = do         -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath          -- Read in the source file.         src     <- liftIO $ readFile filePath@@ -122,16 +130,16 @@  ------------------------------------------------------------------------------- -- | Parse, check and convert a Core module to LLVM.---   Works for the 'Tetra', 'Lite' and 'Salt' fragments.+--   Works for the 'Tetra', and 'Salt' fragments. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. -- cmdToLlvmCoreFromString         :: Config               -- ^ Driver config.         -> Language             -- ^ Language definition.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdToLlvmCoreFromString config language source str  | Language bundle      <- language@@ -153,17 +161,6 @@                 [ stageSaltToLLVM    config source                 [ PipeLlvmPrint      SinkStdout]]]] -                -- Convert a Core Lite module to LLVM.-                | fragName == "Lite"-                = liftIO-                $ pipeText (nameOfSource source) (lineStartOfSource source) str-                $ stageLiteLoad      config source-                [ stageLiteOpt       config source-                [ stageLiteToSalt    config source-                [ stageSaltOpt       config source-                [ stageSaltToLLVM    config source -                [ PipeLlvmPrint SinkStdout]]]]]-                 -- Convert a Core Salt module to LLVM.                 | fragName == "Salt"                 = liftIO@@ -175,10 +172,10 @@                  -- Unrecognised.                 | otherwise-                = throwError $ "Cannot convert '" ++ fragName ++ "' modules to LLVM."+                = throwE $ "Cannot convert '" ++ fragName ++ "' modules to LLVM."          -- Throw any errors that arose during compilation         errs <- compile         case errs of          []     -> return ()-         es     -> throwError $ renderIndent $ vcat $ map ppr es+         es     -> throwE $ renderIndent $ vcat $ map ppr es

@@ -0,0 +1,170 @@++module DDC.Driver.Command.ToPHP+        ( cmdToPHPFromFile+        , cmdToPHPSourceTetraFromFile+        , cmdToPHPSourceTetraFromString+        , cmdToPHPCoreFromFile+        , cmdToPHPCoreFromString)+where+import DDC.Driver.Stage+import DDC.Driver.Command.Compile+import DDC.Driver.Interface.Source+import DDC.Build.Pipeline+import DDC.Build.Language+import DDC.Core.Fragment+import DDC.Base.Pretty+import System.FilePath+import System.Directory+import Control.Monad.Trans.Except+import Control.Monad.IO.Class+import Control.Monad+import DDC.Build.Interface.Store        (Store)+import DDC.Core.Exp.Annot.AnTEC+++-------------------------------------------------------------------------------+-- | Convert a module to PHP.+--   The output is printed to @stdout@.+--   Any errors are thrown in the `ExceptT` monad.+--+cmdToPHPFromFile+        :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.+        -> FilePath             -- ^ Core language definition.+        -> ExceptT String IO ()++cmdToPHPFromFile config store filePath+ + -- Convert a Disciple Source Tetra module.+ | ".ds"          <- takeExtension filePath+ =      cmdToPHPSourceTetraFromFile config store filePath++ -- Convert a module in some fragment of Disciple Core.+ | Just language  <- languageOfExtension (takeExtension filePath)+ =      cmdToPHPCoreFromFile config language filePath++ -- Don't know how to convert this file.+ | otherwise+ = let  ext     = takeExtension filePath+   in   throwE $ "Cannot convert '" ++ ext ++ "' files to PHP."+++-------------------------------------------------------------------------------+-- | Convert Disciple Source Tetra to PHP.+--   The result is printed to @stdout@.+--   Any errors are thrown in the `ExceptT` monad.+cmdToPHPSourceTetraFromFile+        :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.+        -> FilePath             -- ^ Module file path.+        -> ExceptT String IO ()++cmdToPHPSourceTetraFromFile config store filePath+ = do+        -- Check that the file exists.+        exists  <- liftIO $ doesFileExist filePath+        when (not exists)+         $ throwE $ "No such file " ++ show filePath++        -- Call the compiler to build/load all dependent modules.+        cmdCompileRecursive config False store filePath++        -- Read in the source file.+        src     <- liftIO $ readFile filePath++        cmdToPHPSourceTetraFromString config store (SourceFile filePath) src+++-------------------------------------------------------------------------------+-- | Convert Disciple Source Tetra to PHP.+--   The result is printed to @stdout@.+--   Any errors are thrown in the `ExceptT` monad.+cmdToPHPSourceTetraFromString+        :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.+        -> Source               -- ^ Source of the code.+        -> String               -- ^ Program module text.+        -> ExceptT String IO ()++cmdToPHPSourceTetraFromString config store source str+ = let  +        pipeLoad+         = pipeText (nameOfSource source) (lineStartOfSource source) str+         $ stageSourceTetraLoad config source store+         [ PipeCoreReannotate annotTail+         [ PipeCoreAsTetra+         [ PipeTetraToPHP     SinkStdout ]]]+         +   in do+        errs    <- liftIO pipeLoad+        case errs of+         []     -> return ()+         es     -> throwE $ renderIndent $ vcat $ map ppr es+++-------------------------------------------------------------------------------+-- | Parse, check and convert a Core module to PHP.+--   Works for the 'Tetra', and 'Salt' fragments.+--   The result is printed to @stdout@.+--   Any errors are thrown in the `ExceptT` monad.+--+cmdToPHPCoreFromFile+        :: Config               -- ^ Driver config.+        -> Language             -- ^ Core language definition.+        -> FilePath             -- ^ Module file path.+        -> ExceptT String IO ()++cmdToPHPCoreFromFile config language filePath+ = do+        -- Check that the file exists.+        exists  <- liftIO $ doesFileExist filePath+        when (not exists)+         $ throwE $ "No such file " ++ show filePath++        -- Read in the source file.+        src     <- liftIO $ readFile filePath++        cmdToPHPCoreFromString config language (SourceFile filePath) src+++-------------------------------------------------------------------------------+-- | Parse, check, and convert a module to PHP.+--   The output is printed to @stdout@. +--   Any errors are thrown in the `ExceptT` monad.+--+cmdToPHPCoreFromString  +        :: Config       -- ^ Compiler configuration.+        -> Language     -- ^ Language definition.+        -> Source       -- ^ Source of the code.+        -> String       -- ^ Program module text.+        -> ExceptT String IO ()++cmdToPHPCoreFromString config language source str+ | Language bundle      <- language+ , fragment             <- bundleFragment  bundle+ , profile              <- fragmentProfile fragment+ = do   +        let fragName = profileName profile+        +        -- Decide what to do based on file extension and current fragment.+        let compile+                -- Convert a Core Tetra module to PHP.+                | fragName == "Tetra"+                = liftIO+                $ pipeText (nameOfSource source) (lineStartOfSource source) str+                $ stageTetraLoad     config source+                [ PipeCoreReannotate (const ())+                [ PipeCoreAsTetra+                [ PipeTetraToPHP     SinkStdout ]]]++                -- Unrecognised.+                | otherwise+                = throwE $ "Cannot convert '" ++ fragName ++ "'modules to PHP."+++        -- Throw any errors that arose during compilation+        errs <- compile+        case errs of+         []     -> return ()+         es     -> throwE $ renderIndent $ vcat $ map ppr es+

@@ -6,18 +6,20 @@         , cmdToSaltCoreFromFile         , cmdToSaltCoreFromString) where+import DDC.Driver.Command.Compile import DDC.Driver.Stage import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline import DDC.Build.Language import DDC.Core.Fragment import DDC.Base.Pretty import System.FilePath import System.Directory-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import Control.Monad+import DDC.Build.Interface.Store                (Store) import qualified DDC.Build.Language.Salt        as Salt import qualified DDC.Core.Check                 as C @@ -25,18 +27,18 @@ ------------------------------------------------------------------------------- -- | Convert a module to Core Salt. --   The output is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.---+--   Any errors are thrown in the `ExceptT` monad. cmdToSaltFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToSaltFromFile config filePath+cmdToSaltFromFile config store filePath   -- Convert a Disciple Source Tetra module.- | ".dst"        <- takeExtension filePath- =      cmdToSaltSourceTetraFromFile config filePath+ | ".ds"         <- takeExtension filePath+ =      cmdToSaltSourceTetraFromFile config store filePath    -- Convert a module in some fragment of Disciple Core.  | Just language <- languageOfExtension (takeExtension filePath)@@ -45,49 +47,54 @@  -- Don't know how to convert this file.  | otherwise  = let  ext     = takeExtension filePath-   in   throwError $ "Cannot convert '" ++ ext ++ "' files to Salt."+   in   throwE $ "Cannot convert '" ++ ext ++ "' files to Salt."   ------------------------------------------------------------------------------- -- | Convert Disciple Core Tetra to Disciple Core Salt. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdToSaltSourceTetraFromFile         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToSaltSourceTetraFromFile config filePath+cmdToSaltSourceTetraFromFile config store filePath  = do         -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath +        -- Call the compiler to build/load all dependent modules.+        cmdCompileRecursive config False store filePath+         -- Read in the source file.         src     <- liftIO $ readFile filePath -        cmdToSaltSourceTetraFromString config (SourceFile filePath) src+        cmdToSaltSourceTetraFromString config store (SourceFile filePath) src   ------------------------------------------------------------------------------- -- | Convert Disciple Source Tetra to Disciple Core Salt. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.+--   Any errors are thrown in the `ExceptT` monad. cmdToSaltSourceTetraFromString         :: Config               -- ^ Driver config.+        -> Store                -- ^ Interface store.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO () -cmdToSaltSourceTetraFromString config source str+cmdToSaltSourceTetraFromString config store source str  = let           pmode   = prettyModeOfConfig $ configPretty config          pipeLoad          = pipeText (nameOfSource source)                     (lineStartOfSource source) str-         $ stageSourceTetraLoad config source+         $ stageSourceTetraLoad config source store          [ PipeCoreReannotate (const ())          [ stageTetraToSalt     config source           [ stageSaltOpt         config source@@ -98,27 +105,26 @@         errs    <- liftIO pipeLoad         case errs of          []     -> return ()-         es     -> throwError $ renderIndent $ vcat $ map ppr es+         es     -> throwE $ renderIndent $ vcat $ map ppr es   ------------------------------------------------------------------------------- -- | Convert some fragment of Disciple Core to Core Salt.---   Works for the 'Lite' and 'Tetra' fragments.+--   Works for the 'Tetra' fragment. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.---+--   Any errors are thrown in the `ExceptT` monad. cmdToSaltCoreFromFile         :: Config               -- ^ Driver config.         -> Language             -- ^ Core language definition.         -> FilePath             -- ^ Module file path.-        -> ErrorT String IO ()  +        -> ExceptT String IO ()    cmdToSaltCoreFromFile config language filePath  = do            -- Check that the file exists.         exists  <- liftIO $ doesFileExist filePath         when (not exists)-         $ throwError $ "No such file " ++ show filePath+         $ throwE $ "No such file " ++ show filePath          -- Read in the source file.         src     <- liftIO $ readFile filePath@@ -128,16 +134,15 @@  ------------------------------------------------------------------------------- -- | Convert some fragment of Disciple Core to Core Salt.---   Works for the 'Lite' and 'Tetra' fragments.+--   Works for the 'Tetra' fragment. --   The result is printed to @stdout@.---   Any errors are thrown in the `ErrorT` monad.---+--   Any errors are thrown in the `ExceptT` monad. cmdToSaltCoreFromString         :: Config               -- ^ Driver config.         -> Language             -- ^ Language definition.         -> Source               -- ^ Source of the code.         -> String               -- ^ Program module text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()                 cmdToSaltCoreFromString config language source str  | Language bundle      <- language@@ -162,25 +167,14 @@                 [ PipeCoreCheck    Salt.fragment C.Recon SinkDiscard                 [ PipeCoreOutput   pmode SinkStdout]]]]                 -                -- Convert a Core Lite module to Salt.-                | fragName == "Lite" -                = liftIO-                $ pipeText (nameOfSource source) (lineStartOfSource source) str-                $ stageLiteLoad    config source-                [ stageLiteOpt     config source-                [ stageLiteToSalt  config source-                [ stageSaltOpt     config source-                [ PipeCoreCheck    Salt.fragment C.Recon SinkDiscard-                [ PipeCoreOutput   pmode SinkStdout]]]]]-                 -- Unrecognised fragment name or file extension.                 | otherwise-                = throwError +                = throwE                  $ "Cannot convert '" ++ fragName ++ "' modules to Salt."          -- Throw any errors that arose during compilation         errs <- compile         case errs of          []     -> return ()-         es     -> throwError $ renderIndent $ vcat $ map ppr es+         es     -> throwE $ renderIndent $ vcat $ map ppr es 

@@ -1,33 +1,36 @@+{-# OPTIONS -Werror #-}+ module DDC.Driver.Command.Trans         ( cmdTransDetect         , cmdTransModule         , cmdTransExp         , cmdTransExpCont-	, transExp)+        , transExp) where import DDC.Driver.Config import DDC.Driver.Output import DDC.Driver.Command.Check+import DDC.Driver.Interface.Source import DDC.Build.Language import DDC.Build.Pipeline-import DDC.Interface.Source import DDC.Core.Transform.Reannotate import DDC.Core.Load import DDC.Core.Fragment import DDC.Core.Simplifier-import DDC.Core.Exp-import DDC.Core.Compounds+import DDC.Core.Exp.Annot import DDC.Type.Equiv import DDC.Type.Subsumes import DDC.Base.Pretty+import DDC.Base.Name import DDC.Core.Module import Data.Typeable import Control.Monad-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.IO.Class import DDC.Type.Env                             as Env import qualified DDC.Core.Check                 as C import qualified Control.Monad.State.Strict     as S+import Prelude                                  hiding ((<$>))   -- Detect -----------------------------------------------------------------------------------------@@ -42,7 +45,7 @@         -> Bool                 -- ^ Print transform info.         -> Source               -- ^ Source of the code.         -> String               -- ^ Input text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdTransDetect    config language shouldPrintInfo         source str@@ -64,7 +67,7 @@         -> Bool                 -- ^ Print transform info.         -> Source               -- ^ Source of the code.         -> String               -- ^ Input text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdTransModule config language _shouldPrintInfo source str  | Language bundle      <- language@@ -88,7 +91,7 @@         errs    <- liftIO pipeTrans          case errs of          [] -> return ()-         es -> throwError $ renderIndent $ vcat $ map ppr es+         es -> throwE $ renderIndent $ vcat $ map ppr es   -- Exp --------------------------------------------------------------------------------------------@@ -100,7 +103,7 @@         -> Bool                 -- ^ Print transform info.         -> Source               -- ^ Source of input text.         -> String               -- ^ Input text.-        -> ErrorT String IO ()+        -> ExceptT String IO ()  cmdTransExp config language traceTrans         source str@@ -140,10 +143,10 @@                  tr      <- transExp traceTrans profile kenv tenv zero simpl                          $  reannotate (\a -> a { annotTail = ()}) x-		+                                 case tr of-		  Nothing -> return ()-		  Just x' +                  Nothing -> return ()+                  Just x'                     -> do outDocLn $ ppr x'                          eatExp x' @@ -155,7 +158,7 @@ -- Trans ------------------------------------------------------------------------------------------ -- | Transform an expression, or display errors transExp-        :: (Eq n, Ord n, Pretty n, Show n)+        :: (Eq n, Ord n, Pretty n, Show n, CompoundName n)         => Bool                         -- ^ Trace transform information.         -> Profile n                    -- ^ Language profile.         -> KindEnv n                    -- ^ Kind Environment.@@ -170,13 +173,12 @@         let annot  = annotOfExp xx         let t1     = annotType    annot         let eff1   = annotEffect  annot-        let clo1   = annotClosure annot           -- Apply the simplifier.-        let tx          = flip S.evalState zero-                        $ applySimplifierX profile kenv tenv simpl xx+        let tx  = flip S.evalState zero+                $ applySimplifierX profile kenv tenv simpl xx         -        let x'          = reannotate (const ()) $ result tx+        let x'  = reannotate (const ()) $ result tx          when (traceTrans)          $ case (resultInfo tx) of@@ -184,12 +186,14 @@             -> outDocLn               $  text "* TRANSFORM INFORMATION: " <$> indent 4 (ppr inf) <$> text "" +        let config = C.configOfProfile profile+        let rr     = C.checkExp config kenv tenv Recon C.DemandNone x' +         -- Check that the simplifier perserved the type of the expression.-        case fst $ C.checkExp (C.configOfProfile profile) kenv tenv x' Recon of-          Right (x2, t2, eff2, clo2)+        case fst rr of+          Right (x2, t2, eff2)            |  equivT t1 t2            ,  subsumesT kEffect  eff1 eff2-           ,  subsumesT kClosure clo1 clo2            -> do return (Just x2)             | otherwise@@ -199,9 +203,7 @@                     , text ":: 1 " <+> ppr t1                     , text ":: 2 " <+> ppr t2                     , text ":!:1 " <+> ppr eff1-                    , text ":!:2 " <+> ppr eff2-                    , text ":$:1 " <+> ppr clo1-                    , text ":$:2 " <+> ppr clo2 ]+                    , text ":!:2 " <+> ppr eff2 ]                  return Nothing            Left err

@@ -5,31 +5,36 @@         , ConfigPretty  (..)         , defaultConfigPretty         , prettyModeOfConfig+        , objectPathOfConfig+        , exePathOfConfig         -        , ViaBackend    (..))+        , ViaBackend    (..)+        , RuntimeLinkStrategy (..)) where import DDC.Build.Builder                        -import DDC.Core.Simplifier                      (Simplifier)+import DDC.Core.Simplifier              (Simplifier) import DDC.Core.Pretty import DDC.Core.Module--import qualified DDC.Core.Salt.Runtime          as Salt-import qualified DDC.Core.Salt                  as Salt--import qualified DDC.Core.Lite                  as Lite+import System.FilePath+import Data.Maybe+import qualified DDC.Core.Salt.Runtime  as Salt+import qualified DDC.Core.Salt          as Salt  +--------------------------------------------------------------------------------------------------- -- | Configuration for main compiler stages. data Config         = Config-        { -- | Dump intermediate code.-          configDump                    :: Bool+        { -- | Print status to console during builds.+          configLogBuild                :: Bool +          -- | Dump intermediate code.+        , configDump                    :: Bool+           -- | Use bidirectional type inference on the input code.         , configInferTypes              :: Bool            -- | Simplifiers to apply to intermediate code-        , configSimplLite               :: Simplifier Int () Lite.Name         , configSimplSalt               :: Simplifier Int () Salt.Name            -- | Backend code generator to use@@ -38,6 +43,9 @@           -- | Runtime system configuration         , configRuntime                 :: Salt.Config +          -- | Linking strategy for the runtime.+        , configRuntimeLinkStrategy     :: RuntimeLinkStrategy+           -- | The builder to use for the target architecture         , configBuilder                 :: Builder @@ -47,6 +55,9 @@           -- | Suppress the #import prelude in C modules         , configSuppressHashImports     :: Bool  +          -- | Base directories to look for modules sources during build.+        , configModuleBaseDirectories   :: [FilePath]+           -- | Override output file         , configOutputFile              :: Maybe FilePath @@ -69,7 +80,7 @@         }  --- ConfigPretty ---------------------------------------------------------------+--------------------------------------------------------------------------------------------------- -- | Core language pretty printer configuration. data ConfigPretty         = ConfigPretty@@ -126,9 +137,27 @@         modeAlt          = PrettyModeAlt          { modeAltExp                   = modeExp }-         --- ViaBackend -----------------------------------------------------------------++-- | Given the name of a source file, +--   determine the name of the associated object file.+objectPathOfConfig :: Config -> FilePath -> FilePath+objectPathOfConfig config path+ = let  outputDir       = fromMaybe (takeDirectory path) (configOutputDir config)+        outputDirBase   = dropExtension (replaceDirectory path outputDir)+   in   outputDirBase ++ ".o"+++-- | Given the name of a source file,+--   determine the name of an associated executable file.+exePathOfConfig :: Config -> FilePath -> FilePath+exePathOfConfig config path+ = let  oPath           = objectPathOfConfig config path+        exePathDefault  = dropExtension oPath+   in   fromMaybe exePathDefault (configOutputFile config)+++--------------------------------------------------------------------------------------------------- data ViaBackend         -- | Compile via the C backend.         = ViaC@@ -137,3 +166,12 @@         | ViaLLVM         deriving Show +++data RuntimeLinkStrategy+        -- | Use the platform's default strategy.+        = LinkDefault++        -- | Link the runtime statically.+        | LinkStatic+        deriving (Show, Eq)

@@ -3,7 +3,7 @@         (dump) where import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline import System.FilePath import Data.Maybe

@@ -0,0 +1,189 @@++module DDC.Driver.Interface.Input+        ( InputInterface (..)+        , InputState     (..)+        , Input          (..)+        , readInput+        , inputLine)+where+import DDC.Driver.Interface.Source+import DDC.Data.ListUtils+import System.Directory+import Data.List+import Data.Char+++-- InputState -----------------------------------------------------------------+-- Interpreter input state+data InputState command+        = InputState+        { -- Function to parse commands.+          inputParseCommand :: String -> Maybe (command, String)++          -- Input mode.+        , inputMode         :: Input++          -- Command that we're still receiving input for,+          -- along with the line number it started on.+        , inputCommand      :: Maybe (Maybe command, Int)+++          -- The current line number in the command stream.+        , inputLineNumber   :: Int++          -- Accumulation of current input buffer.+        , inputAcc         :: String }+++-- InputInterface -------------------------------------------------------------+-- | What interface is being used.+data InputInterface+        -- | Read commands from unix command-line args.+        = InputInterfaceArgs++        -- | Read commands interactively from the console.+        | InputInterfaceConsole++        -- | Read commands from the file with this name.+        | InputInterfaceBatch    FilePath+        deriving (Eq, Show)+++-- Input ----------------------------------------------------------------------+-- | How we're reading the current expression.+data Input+        -- | Read input line-by-line, using a backslash at the end of the+        --   line to continue to the next.+        = InputLine++        -- | Read input as a block terminated by a double semicolon (;;)+        | InputBlock++        -- | Read input from a file specified on the prompt+        | InputFile     FilePath+        deriving (Eq, Show)+++-- | Read the input mode from the front of a string.+readInput :: String -> (Input, String)+readInput ss+        | isPrefixOf ".." ss+        = (InputBlock, drop 2 ss)++        | isPrefixOf "<" ss+        , filePath      <- dropWhile isSpace (drop 1 ss)+        = (InputFile filePath, drop (length filePath) ss)++        | otherwise+        = (InputLine, ss)++-------------------------------------------------------------------------------+inputLine +        :: InputInterface+        -> InputState c +        -> String+        -> IO ( InputState c+              , Maybe (Source, Maybe c, String))+                        -- Just for complete command.+                        --  .. then Maybe for the default command.++inputLine interface inputState chunk+ | InputState readCmd mode mCommand lineNumber acc <- inputState+ = do   +        -- If this is the first line then try to read the command and+        --  input mode from the front so we know how to continue.+        -- If we can't read an explicit command then assume this is +        --  an expression to evaluate.+        let (cmd, lineStart, (input, rest))+             = case mCommand of+                -- We haven't started a command yet.+                Nothing+                 -> case readCmd chunk of+                     Just (cmd', rest') -> (Just cmd', lineNumber, readInput rest')+                     Nothing            -> (Nothing,   lineNumber, (InputLine, chunk))+                +                -- We've already started a command, and this is more input for it.+                Just (cmd', lineStart')+                 -> (cmd', lineStart', (mode, chunk))++        let source +                -- We were instructed to read the program from a file.+                -- Report this file as the source location, independent+                -- of how we were instructed to read it.+                | InputFile filePath    <- input+                = SourceFile filePath++                -- The program was embedded in the command stream.+                | otherwise+                = case interface of+                        InputInterfaceArgs        -> SourceArgs+                        InputInterfaceConsole     -> SourceConsole lineStart+                        InputInterfaceBatch file  -> SourceBatch   file lineStart+++        case input of+         -- For line-by-line mode, if the line ends with backslash then keep+         -- reading, otherwise run the command.+         -- We also convert the backslash to a newline so the source+         -- position comes out right in parser error messages.+         InputLine+          | not $ null rest+          , last rest == '\\'+          , Just initRest       <- takeInit rest+          -> return     ( inputState+                                { inputCommand    =  (Just (cmd, lineStart))+                                , inputLineNumber = lineNumber + 1+                                , inputAcc        = acc ++ initRest ++ "\n" }+                        , Nothing)++          | otherwise+          -> return     ( inputState+                                { inputMode       = InputLine+                                , inputCommand    = Nothing+                                , inputLineNumber = lineNumber + 1+                                , inputAcc        = [] }+                        , Just (source, cmd, acc ++ rest))+++         -- For block mode, if the line ends with ';;' then run the command,+         -- otherwise keep reading.+         InputBlock+          | isSuffixOf ";;" rest+          -> do let rest' = take (length rest - 2) rest+                return  ( inputState+                                { inputMode       = InputLine+                                , inputCommand    = Nothing+                                , inputLineNumber = lineNumber + 1+                                , inputAcc        = [] }+                       , Just (source, cmd, acc ++ rest'))++          | otherwise+          ->    return ( inputState+                                { inputMode       = input+                                , inputCommand    = Just (cmd, lineStart)+                                , inputLineNumber = lineNumber + 1+                                , inputAcc        = acc ++ rest ++ "\n" }+                       , Nothing)++         -- Read input from a file+         InputFile filePath+          -> do exists          <- doesFileExist filePath+                if exists +                 then do        +                        contents  <- readFile filePath+                        return  ( inputState+                                        { inputMode     = InputLine+                                        , inputCommand  = Nothing+                                        , inputLineNumber = lineNumber + 1+                                        , inputAcc      = [] }+                                , Just (source, cmd, contents))+                 else do+                        putStrLn "No such file."+                        return  ( inputState+                                        { inputMode     = InputLine+                                        , inputCommand  = Nothing+                                        , inputLineNumber = lineNumber + 1+                                        , inputAcc      = [] }+                                , Nothing)++

@@ -0,0 +1,43 @@++module DDC.Driver.Interface.Source+        ( Source(..)+        , lineStartOfSource+        , nameOfSource)+where++-- | Where some source code was obtained from.+--+--   This is used when generating error messages.+data Source+        -- | Read directly from a file.+        = SourceFile            FilePath ++        -- | Supplied on the command line.+        | SourceArgs            ++        -- | Typed into the console.+        | SourceConsole         Int++        -- | Part of a @.dcx@ batch file.+        | SourceBatch           FilePath Int+        deriving (Eq, Show)+++-- | Get the starting source line number to report for this source.+lineStartOfSource :: Source -> Int+lineStartOfSource ss+ = case ss of+        SourceFile{}            -> 1+        SourceArgs{}            -> 1+        SourceConsole i         -> i+        SourceBatch _ i         -> i+++-- | Get the name of a source.+nameOfSource :: Source -> String+nameOfSource ss+ = case ss of+        SourceFile f            -> f+        SourceArgs              -> "<arg>"+        SourceConsole{}         -> "<console>"+        SourceBatch{}           -> "<batch>"

@@ -9,6 +9,7 @@ module DDC.Driver.Stage         ( Config        (..)         , ViaBackend    (..)+        , RuntimeLinkStrategy (..)            -- * Tetra stages         , stageSourceTetraLoad@@ -21,11 +22,7 @@         , stageFlowRate         , stageFlowLower         , stageFlowWind--          -- * Lite stages-        , stageLiteLoad-        , stageLiteOpt-        , stageLiteToSalt+        , stageFlowToTetra            -- * Salt stages         , stageSaltLoad@@ -40,5 +37,4 @@ import DDC.Driver.Config import DDC.Driver.Stage.Tetra import DDC.Driver.Stage.Flow-import DDC.Driver.Stage.Lite import DDC.Driver.Stage.Salt

@@ -4,16 +4,18 @@         , stageFlowPrep         , stageFlowRate         , stageFlowLower-        , stageFlowWind)+        , stageFlowWind+        , stageFlowToTetra) where import DDC.Driver.Dump import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Pipeline import DDC.Base.Pretty import qualified DDC.Core.Check                 as C import qualified DDC.Core.Flow                  as Flow import qualified DDC.Build.Language.Flow        as Flow+import qualified DDC.Core.Salt                  as Salt   ---------------------------------------------------------------------------------------------------@@ -95,4 +97,19 @@        ( PipeCoreOutput pprDefaultMode                         (dump config source "dump.flow-wind.dcf")        : pipesFlow ) ]+++---------------------------------------------------------------------------------------------------+-- | Wind loop primops into tail recursive loops in a Core Flow module.+stageFlowToTetra+        :: Config -> Source+        -> [PipeCore () Salt.Name]+        ->  PipeCore (C.AnTEC () Flow.Name) Flow.Name++stageFlowToTetra config source pipesTetra+ = PipeCoreAsFlow+     [ PipeFlowToTetra+       ( PipeCoreOutput pprDefaultMode+                        (dump config source "dump.flow-out-tetra.dct")+       : pipesTetra ) ] 

@@ -1,79 +0,0 @@--module DDC.Driver.Stage.Lite-        ( stageLiteLoad-        , stageLiteOpt-        , stageLiteToSalt)-where-import DDC.Driver.Dump-import DDC.Driver.Config-import DDC.Interface.Source-import DDC.Build.Builder-import DDC.Build.Pipeline-import DDC.Core.Transform.Namify-import DDC.Base.Pretty-import qualified DDC.Core.Salt.Name             as Salt-import qualified DDC.Build.Language.Lite        as Lite-import qualified DDC.Core.Lite                  as Lite-import qualified DDC.Core.Check                 as C-import qualified DDC.Core.Simplifier.Recipe     as S--------------------------------------------------------------------------------------------------------- | Load and type check Core Lite.-stageLiteLoad-        :: Config -> Source-        -> [PipeCore () Lite.Name]-        -> PipeText Lite.Name Lite.Error--stageLiteLoad config source pipesLite- = PipeTextLoadCore Lite.fragment-        C.Recon          (dump config source "dump.lite-check.txt")- [ PipeCoreReannotate (const ())-        ( PipeCoreOutput pprDefaultMode-                         (dump config source "dump.lite-load.dcl")-        : pipesLite ) ]--------------------------------------------------------------------------------------------------------- | Optimise Core Lite.-stageLiteOpt -        :: Config -> Source-        -> [PipeCore () Lite.Name]-        ->  PipeCore () Lite.Name--stageLiteOpt config source pipes- = PipeCoreSimplify -        Lite.fragment-        (0 :: Int) -        (configSimplLite config)-        ( PipeCoreOutput pprDefaultMode-                         (dump config source "dump.lite-opt.dcl") -        : pipes)--------------------------------------------------------------------------------------------------------- | Convert Core Lite to Core Salt.-------   The Lite to Salt transform requires the program to be normalised,---   and have type annotations.-stageLiteToSalt -        :: Config -> Source-        -> [PipeCore () Salt.Name] -        -> PipeCore  () Lite.Name--stageLiteToSalt config source pipesSalt- = PipeCoreSimplify       Lite.fragment 0 normalizeLite-   [ PipeCoreCheck        Lite.fragment C.Recon SinkDiscard-     [ PipeCoreOutput     pprDefaultMode-                          (dump config source "dump.lite-normalized.dcl")-     , PipeCoreAsLite-       [ PipeLiteToSalt   (buildSpec $ configBuilder config) -                          (configRuntime config)-         ( PipeCoreOutput pprDefaultMode-                          (dump config source "dump.salt.dcs")-         : pipesSalt)]]]-           - where  normalizeLite-         = S.anormalize-                (makeNamifier Lite.freshT)      -                (makeNamifier Lite.freshX)

@@ -9,7 +9,7 @@ where import DDC.Driver.Dump import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source import DDC.Build.Builder import DDC.Build.Pipeline import DDC.Core.Transform.Namify@@ -116,12 +116,9 @@  stageCompileSalt config source filePath shouldLinkExe  = let  -- Decide where to place the build products.-        outputDir      = fromMaybe (takeDirectory filePath) (configOutputDir config)-        outputDirBase  = dropExtension (replaceDirectory filePath outputDir)-        cPath          = outputDirBase ++ ".ddc.c"-        oPath          = outputDirBase ++ ".o"-        exePathDefault = outputDirBase-        exePath        = fromMaybe exePathDefault (configOutputFile config)+        oPath   = objectPathOfConfig config filePath+        exePath = exePathOfConfig    config filePath+        cPath   = replaceExtension   oPath  ".ddc.c"    in         PipeCoreSimplify        Salt.fragment 0 normalizeSalt          [ PipeCoreCheck        Salt.fragment C.Recon SinkDiscard@@ -152,27 +149,24 @@         :: Config -> Source         -> FilePath             -- ^ Path of original source file.                                 --   Build products are placed into the same dir.-        -> Bool                 -- ^ Should we link this into an executable+        -> Maybe [FilePath]     -- ^ If True then link with these other .os into an executable.         -> PipeLlvm -stageCompileLLVM config _source filePath shouldLinkExe+stageCompileLLVM config _source filePath mOtherExeObjs  = let  -- Decide where to place the build products.-        outputDir      = fromMaybe (takeDirectory filePath) (configOutputDir config)-        outputDirBase  = dropExtension (replaceDirectory filePath outputDir)-        llPath         = outputDirBase ++ ".ddc.ll"-        sPath          = outputDirBase ++ ".ddc.s"-        oPath          = outputDirBase ++ ".o"-        exePathDefault = outputDirBase-        exePath        = fromMaybe exePathDefault (configOutputFile config)+        oPath   = objectPathOfConfig config filePath+        exePath = exePathOfConfig    config filePath+        llPath  = replaceExtension   oPath  ".ddc.ll"+        sPath   = replaceExtension   oPath  ".ddc.s"+    in   -- Make the pipeline for the final compilation.         PipeLlvmCompile           { pipeBuilder           = configBuilder config           , pipeFileLlvm          = llPath           , pipeFileAsm           = sPath           , pipeFileObject        = oPath-          , pipeFileExe           = if shouldLinkExe -                                        then Just exePath -                                        else Nothing +          , pipeFileExe           = if isJust $ mOtherExeObjs then Just exePath else Nothing +          , pipeLinkOtherObjects  = concat $ maybeToList mOtherExeObjs           , pipeKeepLlvmFiles     = configKeepLlvmFiles config           , pipeKeepAsmFiles      = configKeepAsmFiles  config } 

@@ -6,7 +6,8 @@ where import DDC.Driver.Dump import DDC.Driver.Config-import DDC.Interface.Source+import DDC.Driver.Interface.Source+import DDC.Build.Interface.Store                (Store) import DDC.Build.Pipeline import DDC.Base.Pretty import qualified DDC.Build.Language.Tetra       as BE@@ -23,14 +24,18 @@ -- | Load and type check a Source Tetra module. stageSourceTetraLoad         :: Config -> Source+        -> Store         -> [PipeCore (C.AnTEC BP.SourcePos CE.Name) CE.Name]         -> PipeText CE.Name CE.Error -stageSourceTetraLoad config source pipesTetra+stageSourceTetraLoad config source store pipesTetra  = PipeTextLoadSourceTetra                     (dump config source "dump.tetra-load-tokens.txt")-                    (dump config source "dump.tetra-load-raw.dct")+                    (dump config source "dump.tetra-load-desugared.dct")+                    (dump config source "dump.tetra-load-core.dct")+                    (dump config source "dump.tetra-load-precheck.dct")                     (dump config source "dump.tetra-load-trace.txt")+                    store    ( PipeCoreOutput pprDefaultMode                     (dump config source "dump.tetra-load.dct")    : pipesTetra ) @@ -66,38 +71,49 @@         -> PipeCore  () CE.Name  stageTetraToSalt config source pipesSalt- = pipe_norm+ = pipe_lambdas  where-        pipe_norm-         = PipeCoreSimplify     BE.fragment 0 normalize-           [ PipeCoreCheck      BE.fragment C.Recon SinkDiscard+        pipe_lambdas+         = PipeCoreCheck        BE.fragment C.Recon SinkDiscard+           [ PipeCoreSimplify   BE.fragment (0 :: Int) C.lambdas             [ PipeCoreOutput     pprDefaultMode-                                (dump config source "dump.tetra-normalized.dct")-           , pipe_boxing ]]+                                (dump config source "dump.tetra-lambdas.dct")+           , pipe_curry]] +        pipe_curry+         = PipeCoreCheck        BE.fragment C.Recon SinkDiscard+           [ PipeCoreAsTetra+           [ PipeTetraCurry+           [ PipeCoreOutput     pprDefaultMode+                                (dump config source "dump.tetra-curry.dct")+           , pipe_prep ]]]++        pipe_prep+         = PipeCoreSimplify     BE.fragment 0 normalize+           [ pipe_boxing ]+         normalize          = C.anormalize                 (C.makeNamifier CE.freshT)                       (C.makeNamifier CE.freshX)          pipe_boxing-         = PipeCoreAsTetra      +         = PipeCoreAsTetra            [ PipeTetraBoxing-             [ PipeCoreOutput     pprDefaultMode-                                  (dump config source "dump.tetra-boxing-raw.dct")-             , PipeCoreSimplify   BE.fragment 0 normalize-               [ PipeCoreOutput   pprDefaultMode-                                  (dump config source "dump.tetra-boxing-simp.dct")-               , PipeCoreCheck    BE.fragment C.Recon SinkDiscard-                 [ PipeCoreOutput pprDefaultMode-                                  (dump config source "dump.tetra-boxing.dct")-             , pipe_toSalt]]]]+             [ PipeCoreOutput   pprDefaultMode+                                (dump config source "dump.tetra-boxing-raw.dct")+             , PipeCoreSimplify BE.fragment 0 (normalize `mappend` C.flatten)+               [ PipeCoreOutput pprDefaultMode+                                (dump config source "dump.tetra-boxing-simp.dct")+               , pipe_toSalt]]] -        pipe_toSalt-         = PipeCoreAsTetra-           [ PipeTetraToSalt    (B.buildSpec $ configBuilder config) ++        pipe_toSalt           +         = PipeCoreCheck        BE.fragment C.Recon SinkDiscard+           [ PipeCoreAsTetra+             [ PipeTetraToSalt  (B.buildSpec $ configBuilder config)                                  (configRuntime config)-           ( PipeCoreOutput     pprDefaultMode+             ( PipeCoreOutput   pprDefaultMode                                 (dump config source "dump.salt.dcs")-           : pipesSalt)]-           +             : pipesSalt)]]+

@@ -1,5 +1,5 @@ Name:           ddc-driver-Version:        0.4.1.3+Version:        0.4.2.1 License:        MIT License-file:   LICENSE Author:         The Disciplined Disciple Compiler Strike Force@@ -17,52 +17,59 @@  Library   Build-depends:-        base             >= 4.6 && < 4.8,+        base             >= 4.6 && < 4.9,         process          >= 1.1 && < 1.3,-        deepseq          == 1.3.*,+        deepseq          >= 1.3 && < 1.5,         containers       == 0.5.*,-        filepath         == 1.3.*,-        mtl              == 2.2.*,+        filepath         >= 1.3 && < 1.5,+        mtl              == 2.2.1.*,         directory        == 1.2.*,         transformers     == 0.4.*,-        ddc-base         == 0.4.1.*,-        ddc-core         == 0.4.1.*,-        ddc-core-eval    == 0.4.1.*,-        ddc-core-simpl   == 0.4.1.*,-        ddc-core-salt    == 0.4.1.*,-        ddc-core-llvm    == 0.4.1.*,-        ddc-core-flow    == 0.4.1.*,-        ddc-core-tetra   == 0.4.1.*,-        ddc-source-tetra == 0.4.1.*,-        ddc-build        == 0.4.1.*,-        ddc-interface    == 0.4.1.*+        time             >= 1.4 && < 1.6,+        ddc-base         == 0.4.2.*,+        ddc-core         == 0.4.2.*,+        ddc-core-simpl   == 0.4.2.*,+        ddc-core-salt    == 0.4.2.*,+        ddc-core-llvm    == 0.4.2.*,+        ddc-core-flow    == 0.4.2.*,+        ddc-core-tetra   == 0.4.2.*,+        ddc-source-tetra == 0.4.2.*,+        ddc-build        == 0.4.2.*      Exposed-modules:+        DDC.Driver.Build.Locate+        DDC.Driver.Build.Main++        DDC.Driver.Interface.Input+        DDC.Driver.Interface.Source+                 DDC.Driver.Command.Flow.Concretize         DDC.Driver.Command.Flow.Lower         DDC.Driver.Command.Flow.Melt         DDC.Driver.Command.Flow.Prep         DDC.Driver.Command.Flow.Rate         DDC.Driver.Command.Flow.Thread+        DDC.Driver.Command.Flow.ToTetra         DDC.Driver.Command.Flow.Wind          DDC.Driver.Command.Tetra.Boxing+        DDC.Driver.Command.Tetra.Curry          DDC.Driver.Command.BaseBuild+        DDC.Driver.Command.Build         DDC.Driver.Command.Check         DDC.Driver.Command.Compile         DDC.Driver.Command.Load-        DDC.Driver.Command.Make         DDC.Driver.Command.Parse         DDC.Driver.Command.Read         DDC.Driver.Command.RewriteRules         DDC.Driver.Command.ToC         DDC.Driver.Command.ToLlvm+        DDC.Driver.Command.ToPHP         DDC.Driver.Command.ToSalt         DDC.Driver.Command.Trans          DDC.Driver.Stage.Flow-        DDC.Driver.Stage.Lite         DDC.Driver.Stage.Salt         DDC.Driver.Stage.Tetra