ddc-tools 0.3.1.3 → 0.3.2.1
raw patch · 23 files changed
+402/−287 lines, 23 filesdep +ddc-core-tetradep +ddc-interfacedep ~ddc-basedep ~ddc-builddep ~ddc-code
Dependencies added: ddc-core-tetra, ddc-interface
Dependency ranges changed: ddc-base, ddc-build, ddc-code, ddc-core, ddc-core-eval, ddc-core-llvm, ddc-core-salt, ddc-core-simpl, ddc-driver
Files
- LICENSE +1/−1
- ddc-tools.cabal +24/−20
- src/ddc-main/DDC/Main/Args.hs +56/−19
- src/ddc-main/DDC/Main/Config.hs +29/−2
- src/ddc-main/DDC/Main/Help.hs +26/−11
- src/ddc-main/Main.hs +48/−9
- src/ddci-core/DDCI/Core/Command.hs +82/−8
- src/ddci-core/DDCI/Core/Command/Eval.hs +4/−2
- src/ddci-core/DDCI/Core/Command/Help.hs +21/−15
- src/ddci-core/DDCI/Core/Command/Set.hs +4/−1
- src/ddci-core/DDCI/Core/Command/Trans.hs +9/−6
- src/ddci-core/DDCI/Core/Command/TransInteract.hs +4/−2
- src/ddci-core/DDCI/Core/Command/With.hs +5/−3
- src/ddci-core/DDCI/Core/Input.hs +24/−144
- src/ddci-core/DDCI/Core/Interface/Args.hs +2/−1
- src/ddci-core/DDCI/Core/Interface/Batch.hs +13/−2
- src/ddci-core/DDCI/Core/Interface/Interactive.hs +13/−4
- src/ddci-core/DDCI/Core/Mode.hs +6/−0
- src/ddci-core/DDCI/Core/Output.hs +3/−2
- src/ddci-core/DDCI/Core/Rewrite.hs +5/−3
- src/ddci-core/DDCI/Core/State.hs +17/−27
- src/ddci-core/DDCI/Core/Stats/Trace.hs +1/−1
- src/ddci-core/Main.hs +5/−4
LICENSE view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- The Disciplined Disciple Compiler License (MIT style) -Copyrite (K) 2007-2012 The Disciplined Disciple Compiler Strike Force+Copyrite (K) 2007-2013 The Disciplined Disciple Compiler Strike Force All rights reversed. Permission is hereby granted, free of charge, to any person obtaining a copy
ddc-tools.cabal view
@@ -1,5 +1,5 @@ Name: ddc-tools-Version: 0.3.1.3+Version: 0.3.2.1 License: MIT License-file: LICENSE Author: The Disciplined Disciple Compiler Strike Force@@ -18,7 +18,7 @@ Build-depends: base == 4.6.*,- ddc-core == 0.3.1.*+ ddc-core == 0.3.2.* Main-is: Main.hs@@ -43,15 +43,17 @@ directory == 1.2.*, mtl == 2.1.*, transformers == 0.3.*,- ddc-base == 0.3.1.*,- ddc-core == 0.3.1.*,- ddc-core-eval == 0.3.1.*,- ddc-core-simpl == 0.3.1.*,- ddc-core-salt == 0.3.1.*,- ddc-core-llvm == 0.3.1.*,- ddc-code == 0.3.1.*,- ddc-build >= 0.3.1.3 && < 0.3.2,- ddc-driver >= 0.3.1.3 && < 0.3.2+ ddc-base == 0.3.2.*,+ ddc-core == 0.3.2.*,+ ddc-core-eval == 0.3.2.*,+ ddc-core-simpl == 0.3.2.*,+ ddc-core-salt == 0.3.2.*,+ ddc-core-llvm == 0.3.2.*,+ ddc-core-tetra == 0.3.2.*,+ ddc-code == 0.3.2.*,+ ddc-build == 0.3.2.*,+ ddc-driver == 0.3.2.*,+ ddc-interface == 0.3.2.* Main-is: Main.hs@@ -78,15 +80,17 @@ haskell-src-exts== 1.*, directory == 1.2.*, mtl == 2.1.*,- ddc-base == 0.3.1.*,- ddc-core == 0.3.1.*,- ddc-core-eval == 0.3.1.*,- ddc-core-simpl == 0.3.1.*,- ddc-core-salt == 0.3.1.*,- ddc-core-llvm == 0.3.1.*,- ddc-code == 0.3.1.*,- ddc-build >= 0.3.1.3 && < 0.3.2,- ddc-driver >= 0.3.1.3 && < 0.3.2+ ddc-base == 0.3.2.*,+ ddc-core == 0.3.2.*,+ ddc-core-eval == 0.3.2.*,+ ddc-core-simpl == 0.3.2.*,+ ddc-core-salt == 0.3.2.*,+ ddc-core-llvm == 0.3.2.*,+ ddc-core-tetra == 0.3.2.*,+ ddc-code == 0.3.2.*,+ ddc-build == 0.3.2.*,+ ddc-driver == 0.3.2.*,+ ddc-interface == 0.3.2.* Main-is: Main.hs
src/ddc-main/DDC/Main/Args.hs view
@@ -97,24 +97,50 @@ = parseArgs rest $ config { configRuntimeHeapSize = read bytes } + -- Parsing ------------------------------+ | "-parse" : file : rest <- args+ = parseArgs rest+ $ config { configMode = ModeParse file }+ -- Checking ------------------------------ | "-check" : file : rest <- args+ | "-check" : file : rest <- args = parseArgs rest- $ config { configMode = ModeCheck file }+ $ config { configMode = ModeCheck file } -- Transformation ------------------------ | "-load" : file : rest <- args+ | "-load" : file : rest <- args = parseArgs rest $ setMode config $ ModeLoad file - | "-trans" : trans : rest <- args+ | "-trans" : trans : rest <- args = parseArgs rest $ config { configTrans = Just trans } - | "-with" : file : rest <- args+ | "-with" : file : rest <- args = parseArgs rest $ config { configWith = configWith config ++ [file] } + -- Flow ---------------------------------+ | "-flow-prep" : file : rest <- args+ = parseArgs rest+ $ setMode config $ ModeFlowPrep file++ | "-flow-lower" : file : rest <- args+ = parseArgs rest+ $ setMode config $ ModeFlowLower file++ | "-flow-concretize" : file : rest <- args+ = parseArgs rest+ $ setMode config $ ModeFlowConcretize file++ | "-flow-thread" : file : rest <- args+ = parseArgs rest+ $ setMode config $ ModeFlowThread file++ | "-flow-wind" : file : rest <- args+ = parseArgs rest+ $ setMode config $ ModeFlowWind file+ -- Conversion --------------------------- | "-to-salt" : file : rest <- args = parseArgs rest@@ -145,6 +171,11 @@ = parseArgs rest $ setMode config ModePrintBaseDir + -- Taints -------------------------------+ | "-taint-avoid-type-checks" : rest <- args+ = parseArgs rest+ $ config { configTaintAvoidTypeChecks = True }+ -- If we get some other argument starting with '-' then assume it's -- a flag we don't support. | arg : _ <- args@@ -189,19 +220,25 @@ flagOfMode :: Mode -> Maybe String flagOfMode mode = case mode of- ModeNone{} -> Nothing- ModeVersion{} -> Just "-version"- ModeHelp{} -> Just "-help"- ModeCheck{} -> Just "-check"- ModeLoad{} -> Just "-load"- ModeCompile{} -> Just "-compile"- ModeMake{} -> Just "-make"- ModeAST{} -> Just "-ast"- ModeToSalt{} -> Just "-to-salt"- ModeToC{} -> Just "-to-c"- ModeToLLVM{} -> Just "-to-llvm"- ModeBaseBuild{} -> Just "-basebuild"- ModePrintBuilder{} -> Just "-print-builder"- ModePrintBaseDir{} -> Just "-print-basedir"+ ModeNone{} -> Nothing+ ModeVersion{} -> Just "-version"+ ModeHelp{} -> Just "-help"+ ModeParse{} -> Just "-parse"+ ModeCheck{} -> Just "-check"+ ModeLoad{} -> Just "-load"+ ModeCompile{} -> Just "-compile"+ ModeMake{} -> Just "-make"+ ModeAST{} -> Just "-ast"+ ModeToSalt{} -> Just "-to-salt"+ ModeToC{} -> Just "-to-c"+ ModeToLLVM{} -> Just "-to-llvm"+ ModeFlowPrep{} -> Just "-flow-prep"+ ModeFlowLower{} -> Just "-flow-lower"+ ModeFlowConcretize{} -> Just "-flow-concretize"+ ModeFlowThread{} -> Just "-flow-thread"+ ModeFlowWind{} -> Just "-flow-wind"+ ModeBaseBuild{} -> Just "-basebuild"+ ModePrintBuilder{} -> Just "-print-builder"+ ModePrintBaseDir{} -> Just "-print-basedir"
src/ddc-main/DDC/Main/Config.hs view
@@ -27,6 +27,9 @@ -- | Display the help page. | ModeHelp + -- | Parse a module.+ | ModeParse FilePath+ -- | Parse and type-check a module. | ModeCheck FilePath @@ -51,6 +54,23 @@ -- | Convert a module to LLVM. | ModeToLLVM FilePath + -- Disciple Core Flow specific ----------+ -- | Prepare a Flow program for lowering.+ | ModeFlowPrep FilePath++ -- | Lower a Flow program.+ | ModeFlowLower FilePath++ -- | Wind loop primops into tail recursive loops.+ | ModeFlowWind FilePath++ -- | Concretize rate type variables in a Flow program.+ | ModeFlowConcretize FilePath++ -- | Thread the World token through a Flow program.+ | ModeFlowThread FilePath++ -- Builder ------------------------------ -- | Build the base libraries and runtime. | ModeBaseBuild @@ -119,7 +139,11 @@ -- Debugging ----------------- -- | Dump intermediate representations.- , configDump :: Bool }+ , configDump :: Bool ++ -- Taints --------------------+ -- | Disable type checking where possible.+ , configTaintAvoidTypeChecks :: Bool } deriving (Show) @@ -156,7 +180,10 @@ , configWith = [] -- Debugging ----------------- , configDump = False }+ , configDump = False ++ -- Taints -------------------+ , configTaintAvoidTypeChecks = False } -- | Get the builder configuation from the ddc configuration.
src/ddc-main/DDC/Main/Help.hs view
@@ -3,7 +3,7 @@ -- | The version identifier string. version :: String-version = "The Disciplined Disciple Compiler, version 0.3.1"+version = "The Disciplined Disciple Compiler, version 0.3.2" -- | What to print when we have no input files.@@ -14,6 +14,14 @@ -- | The command-line help page.+---+-- The following internal debugging flags are also accepted but do not appear+-- in the help page.+--+-- -taint-avoid-type-checks Avoid type checking if possible.+-- Exactly how much checking is avoided depends+-- on the compilation mode. +-- help :: String help = unlines [ version@@ -23,10 +31,10 @@ , " -version Display the version string." , "" , "Compilation:"- , " -make FILE Compile a module into an executable file."- , " -c, -compile FILE Compile a module into an object file."+ , " -make FILE Compile a module into an executable file."+ , " -c, -compile FILE Compile a module into an object file." , ""- , " -o, -output FILE Redirect output to this file."+ , " -o, -output FILE Redirect output to this file." , " -output-dir DIR Redirect output to this directory." , "" , " -fvia-llvm Compile via the LLVM backend (default)"@@ -41,16 +49,24 @@ , " -O, -O1 Do standard optimisations." , "" , "Runtime for compiled program:"- , " -run-heap BYTES Size of fixed heap (65536)"+ , " -run-heap BYTES Size of fixed heap (65536)" , ""- , "Checking:"- , " -check FILE Parse and type check a core module."+ , "Parsing and Checking:"+ , " -parse FILE Parse a module."+ , " -check FILE Parse and type check a module." , "" , "Conversion:"- , " -to-salt FILE Convert a module to Disciple Core Salt."- , " -to-c FILE Convert a module to C code."- , " -to-llvm FILE Convert a module to LLVM code."+ , " -to-salt FILE Convert a module to Disciple Core Salt."+ , " -to-c FILE Convert a module to C code."+ , " -to-llvm FILE Convert a module to LLVM code." , ""+ , "Data Flow Fusion Transforms:"+ , " These work on modules in the Disciple Core Flow (.dcf) fragment."+ , " -flow-prep FILE Prepare a module for lowering."+ , " -flow-lower FILE Lower functions to loop code."+ , " -flow-wind FILE Wind loop primops into tail recursive loops."+ , " -flow-concretize FILE Rewrite primops to use concrete series lengths."+ , "" , "Debugging:" , " -dump Dump intermediate representations." , " -ast FILE Pretty print the AST of a module."@@ -84,4 +100,3 @@ , " Elaborate Introduce default witnesses for unconstrained regions." , " Inline MODULE[NAME..] Perform inlining. Use '-with' to add source modules." ] -
src/ddc-main/Main.hs view
@@ -7,16 +7,24 @@ import DDC.Main.Help import DDC.Main.Args import DDC.Main.OptLevels-import DDC.Driver.Command.Load+import DDC.Driver.Command.Parse import DDC.Driver.Command.Check+import DDC.Driver.Command.Load import DDC.Driver.Command.Compile import DDC.Driver.Command.Make import DDC.Driver.Command.Ast import DDC.Driver.Command.BaseBuild++import DDC.Driver.Command.Flow.Prep+import DDC.Driver.Command.Flow.Lower+import DDC.Driver.Command.Flow.Concretize+import DDC.Driver.Command.Flow.Thread+import DDC.Driver.Command.Flow.Wind+ import DDC.Driver.Command.ToSalt import DDC.Driver.Command.ToC import DDC.Driver.Command.ToLlvm-import DDC.Driver.Source+import DDC.Interface.Source import DDC.Build.Builder import DDC.Build.Language import DDC.Base.Pretty@@ -61,6 +69,12 @@ ModeHelp -> putStrLn help + -- Parser a module.+ ModeParse filePath+ -> do dconfig <- getDriverConfig config (Just filePath)+ str <- readFile filePath+ runError $ cmdParseModule dconfig (SourceFile filePath) str+ -- Parse and type check a module. ModeCheck filePath -> do language <- languageFromFilePath filePath@@ -76,7 +90,6 @@ Right _ -> return () - -- Parse, type check and transform a module. ModeLoad filePath -> runError $ cmdLoadFromFile @@ -89,13 +102,11 @@ -> do dconfig <- getDriverConfig config (Just filePath) runError $ cmdCompile dconfig filePath - -- Compile a module into an executable. ModeMake filePath -> do dconfig <- getDriverConfig config (Just filePath) runError $ cmdMake dconfig filePath - -- Pretty print the AST of a module. ModeAST filePath -> do language <- languageFromFilePath filePath@@ -105,7 +116,6 @@ (SourceFile filePath) str - -- Convert a module to Salt. ModeToSalt filePath -> do language <- languageFromFilePath filePath@@ -113,7 +123,6 @@ str <- readFile filePath runError $ cmdToSalt dconfig language (SourceFile filePath) str - -- Convert a module to C ModeToC filePath -> do language <- languageFromFilePath filePath@@ -121,7 +130,6 @@ str <- readFile filePath runError $ cmdToC dconfig language (SourceFile filePath) str - -- Convert a module to LLVM ModeToLLVM filePath -> do language <- languageFromFilePath filePath@@ -129,6 +137,36 @@ str <- readFile filePath runError $ cmdToLlvm dconfig language (SourceFile filePath) str + -- Prepare a Disciple Core Flow program for lowering.+ ModeFlowPrep filePath+ -> do dconfig <- getDriverConfig config (Just filePath)+ str <- readFile filePath+ runError $ cmdFlowPrep dconfig (SourceFile filePath) str++ -- Lower a Disciple Core Flow program to loops.+ ModeFlowLower filePath+ -> do dconfig <- getDriverConfig config (Just filePath)+ str <- readFile filePath+ runError $ cmdFlowLower dconfig (SourceFile filePath) str++ -- Concretize rate type variables in a Disciple Core Flow program.+ ModeFlowConcretize filePath+ -> do dconfig <- getDriverConfig config (Just filePath)+ str <- readFile filePath+ runError $ cmdFlowConcretize dconfig (SourceFile filePath) str++ -- Thread the world token through a Disciple Core Flow program.+ ModeFlowThread filePath+ -> do dconfig <- getDriverConfig config (Just filePath)+ str <- readFile filePath+ runError $ cmdFlowThread dconfig (SourceFile filePath) str++ -- Wind loop primops into tail recursive loops.+ ModeFlowWind filePath+ -> do dconfig <- getDriverConfig config (Just filePath)+ str <- readFile filePath+ runError $ cmdFlowWind dconfig (SourceFile filePath) str+ -- Build the runtime and base libraries. ModeBaseBuild -> do dconfig <- getDriverConfig config Nothing@@ -169,7 +207,8 @@ , Driver.configOutputDir = configOutputDir config , Driver.configKeepLlvmFiles = configKeepLlvmFiles config , Driver.configKeepSeaFiles = configKeepSeaFiles config- , Driver.configKeepAsmFiles = configKeepAsmFiles config }+ , Driver.configKeepAsmFiles = configKeepAsmFiles config + , Driver.configTaintAvoidTypeChecks = configTaintAvoidTypeChecks config } -- | Determine the current language based on the file extension of this path,
src/ddci-core/DDCI/Core/Command.hs view
@@ -12,14 +12,23 @@ import DDCI.Core.Command.TransInteract import DDCI.Core.Command.With import DDCI.Core.State+ import DDC.Driver.Command.Ast import DDC.Driver.Command.Check import DDC.Driver.Command.Load import DDC.Driver.Command.Compile import DDC.Driver.Command.Make+ import DDC.Driver.Command.ToSalt import DDC.Driver.Command.ToC import DDC.Driver.Command.ToLlvm++import DDC.Driver.Command.Flow.Prep+import DDC.Driver.Command.Flow.Lower+import DDC.Driver.Command.Flow.Concretize+import DDC.Driver.Command.Flow.Thread+import DDC.Driver.Command.Flow.Wind+ import System.IO import Control.Monad.Trans.Error import Data.List@@ -46,19 +55,31 @@ | CommandExpClosure -- ^ Check an expression, showing its closure. | CommandExpRecon -- ^ Reconstruct type annotations on binders. | CommandEval -- ^ Evaluate an expression.++ | CommandAst -- ^ Show the AST of an expression.++ -- Generic transformations | CommandTrans -- ^ Transform an expression. | CommandTransEval -- ^ Transform then evaluate an expression. | CommandTransInteract -- ^ Interactively transform an expression. - | CommandAst -- ^ Show the AST of an expression.-+ -- Make and compile | CommandCompile -- ^ Compile a file. | CommandMake -- ^ Compile and link and executable. + -- Conversion to machine code | CommandToSalt -- ^ Convert a module to Disciple Salt. | CommandToC -- ^ Convert a module to C code. | CommandToLlvm -- ^ Convert a module to LLVM code. + -- Core Flow passes + | CommandFlowPrep -- ^ Prepare a Core Flow module for lowering.+ | CommandFlowLower -- ^ Prepare and Lower a Core Flow module.+ | CommandFlowConcretize -- ^ Convert operations on type level rates to concrete ones.+ | CommandFlowThread -- ^ Thread a world token through lowered code.+ | CommandFlowWind -- ^ Wind loop primops into tail recursive loops.++ -- Inline control | CommandWith -- ^ Add a module to the inliner table. | CommandWithLite | CommandWithSalt@@ -75,27 +96,47 @@ , (":set", CommandSet) , (":load", CommandLoad) , (":kind", CommandKind)+ , (":universe1", CommandUniverse1) , (":universe2", CommandUniverse2) , (":universe3", CommandUniverse3) , (":universe", CommandUniverse)+ , (":tequiv", CommandEquivType) , (":wtype", CommandWitType) , (":check", CommandExpCheck) , (":recon", CommandExpRecon)+ , (":type", CommandExpType) , (":effect", CommandExpEffect) , (":closure", CommandExpClosure)+ , (":eval", CommandEval)++ , (":ast", CommandAst) ++ -- Generic transformations , (":trun", CommandTransEval) , (":tinteract", CommandTransInteract) , (":trans", CommandTrans)- , (":ast", CommandAst) - , (":compile", CommandCompile)- , (":make", CommandMake)++ -- Conversion to machine code. , (":to-salt", CommandToSalt) , (":to-c", CommandToC) , (":to-llvm", CommandToLlvm) ++ -- Core Flow passes+ , (":flow-prep", CommandFlowPrep)+ , (":flow-lower", CommandFlowLower)+ , (":flow-concretize", CommandFlowConcretize)+ , (":flow-thread", CommandFlowThread)+ , (":flow-wind", CommandFlowWind)++ -- Make and Compile+ , (":compile", CommandCompile)+ , (":make", CommandMake)++ -- Inliner control , (":with-lite", CommandWithLite) , (":with-salt", CommandWithSalt) , (":with", CommandWith) ]@@ -205,6 +246,11 @@ -> do cmdEval state source line return state + CommandAst+ -> do cmdAstExp (stateLanguage state) source line+ return state++ -- Generic transformations -------------- CommandTrans -> do cmdTrans state source line return state@@ -216,10 +262,8 @@ CommandTransInteract -> do cmdTransInteract state source line - CommandAst- -> do cmdAstExp (stateLanguage state) source line- return state + -- Conversion to machine code ----------- CommandToSalt -> do config <- getDriverConfigOfState state runError $ cmdToSalt config (stateLanguage state) source line@@ -235,6 +279,34 @@ runError $ cmdToLlvm config (stateLanguage state) source line return state ++ -- Core Flow passes ----------------------+ CommandFlowPrep+ -> do config <- getDriverConfigOfState state+ runError $ cmdFlowPrep config source line+ return state++ CommandFlowLower+ -> do config <- getDriverConfigOfState state+ runError $ cmdFlowLower config source line+ return state++ CommandFlowConcretize+ -> do config <- getDriverConfigOfState state+ runError $ cmdFlowConcretize config source line+ return state++ CommandFlowThread+ -> do config <- getDriverConfigOfState state+ runError $ cmdFlowThread config source line+ return state++ CommandFlowWind+ -> do config <- getDriverConfigOfState state+ runError $ cmdFlowWind config source line+ return state++ -- Make and Compile --------------------- CommandCompile -> do config <- getDriverConfigOfState state runError $ cmdCompile config line@@ -245,6 +317,8 @@ runError $ cmdMake config line return state ++ -- Inliner Control ---------------------- CommandWith -> cmdWith state source line
src/ddci-core/DDCI/Core/Command/Eval.hs view
@@ -75,7 +75,8 @@ -- Expression is well-typed. goEval (Just expr)- = evalExp state expr+ = evalExp state + $ reannotate (\a -> a { annotTail = ()} ) expr -- | Evaluate an already parsed and type-checked expression.@@ -85,6 +86,7 @@ = do -- The evaluator doesn't want any annotations let x0_stripped = reannotate (const ()) x0+ let x0_zapped = reannotate (\a -> a { annotTail = ()}) x0 -- Create the initial store. let store = startingStoreForExp x0_stripped@@ -98,7 +100,7 @@ $ do putStrLn $ renderIndent $ ppr store outStr state "\n" - goStep store x0+ goStep store x0_zapped where goStep store x
src/ddci-core/DDCI/Core/Command/Help.hs view
@@ -89,24 +89,30 @@ , " :wtype WITNESS Show the type of a witness expression." , "" , "Expression Commands"- , " :check EXP Show the type, effect and closure of an exp."- , " :type EXP Show the type of an expression."- , " :effect EXP Show the effect of an expression."- , " :closure EXP Show the closure of an expression." - , " :eval EXP Evaluate an expression."- , " :ast EXP Show the abstract syntax tree of a exp." + , " :check EXP Show the type, effect and closure of an exp."+ , " :type EXP Show the type of an expression."+ , " :effect EXP Show the effect of an expression."+ , " :closure EXP Show the closure of an expression." + , " :eval EXP Evaluate an expression."+ , " :ast EXP Show the abstract syntax tree of a exp." , ""- , " :trans EXP Transform the given expression."- , " :trun EXP Transform the given expression then evaluate it."- , " :tinteract EXP Enter interactive transformation mode."+ , " :trans EXP Transform the given expression."+ , " :trun EXP Transform the given expression then evaluate it."+ , " :tinteract EXP Enter interactive transformation mode." , "" , "Module Commands"- , " :compile PATH Compile the module at this path to an object file."- , " :make PATH Make the module at this path into an executable."+ , " :compile PATH Compile the module at this path to an object file."+ , " :make PATH Make the module at this path into an executable." , ""- , " :load MODULE Type check and desugar module source code."- , " :to-salt MODULE Convert module source code to Salt."- , " :to-c MODULE Convert module source code to C."- , " :to-llvm MODULE Convert module source code to LLVM."+ , " :load MODULE Type check and desugar module source code."+ , " :to-salt MODULE Convert module source code to Salt."+ , " :to-c MODULE Convert module source code to C."+ , " :to-llvm MODULE Convert module source code to LLVM."+ , ""+ , "Data Flow Fusion Transforms" + , " :flow-prep MODULE Prepare a module for lowering."+ , " :flow-lower MODULE Lower a module to loop code."+ , " :flow-wind MODULE Wind loop primops into tail recursive loops."+ , " :flow-concretize MODULE Rewrite primops to use concrete series lengths." , "" ]
src/ddci-core/DDCI/Core/Command/Set.hs view
@@ -11,6 +11,8 @@ import DDC.Build.Language import DDC.Core.Fragment import DDC.Core.Simplifier.Parser+import DDC.Core.Transform.Reannotate+import DDC.Core.Check import DDC.Base.Pretty import Control.Monad import Data.Char@@ -87,7 +89,8 @@ = case R.parseRewrite fragment modules rest of Right (R.SetAdd name rule) -> do chatStrLn state $ "ok, added " ++ name- let rules' = Map.insert name rule rules+ let rule' = reannotate (\a -> a { annotTail = ()}) rule+ let rules' = Map.insert name rule' rules let bundle' = bundle { bundleRewriteRules = rules' } return $ state { stateLanguage = Language bundle' }
src/ddci-core/DDCI/Core/Command/Trans.hs view
@@ -50,8 +50,10 @@ = do let kenv = modulesExportKinds modules (profilePrimKinds profile) let tenv = modulesExportTypes modules (profilePrimTypes profile) - tr <- applyTransAndCheck state profile kenv tenv zero simpl x- case tr of+ tr <- applyTransAndCheck state profile kenv tenv zero simpl + $ reannotate (\a -> a { annotTail = ()}) x+ + case tr of Nothing -> return () Just x' -> outDocLn state $ ppr x' @@ -84,7 +86,8 @@ let tenv = modulesExportTypes modules (profilePrimTypes profile) -- Apply the current transform.- tr <- applyTransAndCheck state profile kenv tenv zero simpl xx+ tr <- applyTransAndCheck state profile kenv tenv zero simpl + $ reannotate (\a -> a { annotTail = () }) xx case tr of Nothing -> return ()@@ -109,14 +112,14 @@ -- Trans ---------------------------------------------------------------------- -- | Transform an expression, or display errors applyTransAndCheck - :: (Eq n, Ord n, Pretty n, Show n, Show a)+ :: (Eq n, Ord n, Pretty n, Show n) => State -> Profile n -> Env n -- Kind Environment. -> Env n -- Type Environment. -> s- -> Simplifier s (AnTEC a n) n- -> Exp (AnTEC a n) n+ -> Simplifier s (AnTEC () n) n+ -> Exp (AnTEC () n) n -> IO (Maybe (Exp (AnTEC () n) n)) applyTransAndCheck state profile kenv tenv zero simpl xx
src/ddci-core/DDCI/Core/Command/TransInteract.hs view
@@ -9,6 +9,7 @@ import DDC.Build.Language import DDC.Core.Fragment import DDC.Core.Simplifier.Parser+import DDC.Core.Transform.Reannotate import DDC.Core.Compounds import DDC.Core.Check import DDC.Core.Module@@ -33,13 +34,14 @@ -- Expression is well-typed. goStore bundle (Just xx) = do - let Just annot = takeAnnotOfExp xx+ let xx' = reannotate (\a -> a { annotTail = () }) xx+ let Just annot = takeAnnotOfExp xx' let t1 = annotType annot let eff1 = annotEffect annot let clo1 = annotClosure annot let hist = TransHistory- { historyExp = (xx, t1, eff1, clo1)+ { historyExp = (xx', t1, eff1, clo1) , historySteps = [] , historyBundle = bundle }
src/ddci-core/DDCI/Core/Command/With.hs view
@@ -3,11 +3,12 @@ (cmdWith, cmdWithLite, cmdWithSalt) where import DDCI.Core.State-import DDC.Driver.Source+import DDC.Interface.Source import DDC.Core.Pretty import DDC.Build.Pipeline import DDC.Core.Module import DDC.Data.Canned+import DDC.Core.Check import System.Directory import Control.Monad import Data.IORef@@ -71,8 +72,9 @@ = do ref <- newIORef Nothing errs <- pipeText (nameOfSource source) (lineStartOfSource source) src $ PipeTextLoadCore frag- [ PipeCoreHacks (Canned (\m -> writeIORef ref (Just m) >> return m)) - [PipeCoreOutput SinkDiscard] ]+ [ PipeCoreReannotate (\a -> a { annotTail = ()})+ [ PipeCoreHacks (Canned (\m -> writeIORef ref (Just m) >> return m)) + [PipeCoreOutput SinkDiscard] ]] case errs of [] -> do
src/ddci-core/DDCI/Core/Input.hs view
@@ -8,154 +8,34 @@ import DDCI.Core.State import DDCI.Core.Command import DDCI.Core.Command.TransInteract-import DDC.Data.ListUtils-import System.Directory-import Data.List-import Data.Char----- InputState ------------------------------------------------------------------------- Interpreter input state-data InputState- = InputState- { -- Command that we're still receiving input for,- -- along with the line number it started on.- inputCommand :: Maybe (Command, Int)-- -- Input mode.- , _inputMode :: Input-- -- The current line number in the command stream.- , inputLineNumber :: Int-- -- Accumulation of current input buffer.- , _inputAcc :: String }----- | How we're reading the input 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)+import DDC.Interface.Input --- Eat ------------------------------------------------------------------------ -- Eating input lines.-eatLine :: State -> InputState -> String -> IO (State, InputState)-eatLine state (InputState mCommand inputMode lineNumber acc) line- | Just _ <- stateTransInteract state- = do- state' <- cmdTransInteractLoop state line- return (state', InputState mCommand inputMode (lineNumber+1) acc)-- | otherwise- = 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 readCommand line of- Just (cmd', rest') -> (cmd', lineNumber, readInput rest')- Nothing -> (CommandEval, lineNumber, (InputLine, line))- - -- We've already started a command, and this is more input for it.- Just (cmd', lineStart')- -> (cmd', lineStart', (inputMode, line))-- 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 stateInterface state of- InterfaceArgs -> SourceArgs- InterfaceConsole -> SourceConsole lineStart- InterfaceBatch 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- -> do return ( state- , InputState (Just (cmd, lineStart)) input- (lineNumber + 1)- (acc ++ initRest ++ "\n"))-- | otherwise- -> do state' <- handleCmd state cmd source (acc ++ rest)- return ( state'- , InputState Nothing InputLine- (lineNumber + 1)- [])-+eatLine :: State + -> InputState Command + -> String + -> IO (State, InputState Command) - -- 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- state' <- handleCmd state cmd source (acc ++ rest')- return ( state'- , InputState Nothing InputLine- (lineNumber + 1)- [])+eatLine state inputState chunk+ | Just _ <- stateTransInteract state+ = do state' <- cmdTransInteractLoop state chunk+ return ( state'+ , inputState+ { inputLineNumber = inputLineNumber inputState + 1 })+ | otherwise + = do (inputState', mCmdLine) + <- inputLine (stateInterface state) inputState chunk+ + case mCmdLine of+ Nothing + -> return (state, inputState') - | otherwise- -> return ( state- , InputState (Just (cmd, lineStart)) input- (lineNumber + 1)- (acc ++ rest ++ "\n"))+ Just (source, Nothing, line)+ -> do state' <- handleCmd state CommandEval source line+ return (state', inputState') - -- Read input from a file- InputFile filePath- -> do exists <- doesFileExist filePath- if exists - then do - contents <- readFile filePath- state' <- handleCmd state cmd source contents- return ( state'- , InputState Nothing InputLine- (lineNumber + 1)- [])- else do- putStrLn "No such file."- return ( state- , InputState Nothing InputLine- (lineNumber + 1)- [])+ Just (source, Just cmd, line)+ -> do state' <- handleCmd state cmd source line+ return (state', inputState')
src/ddci-core/DDCI/Core/Interface/Args.hs view
@@ -5,6 +5,7 @@ import DDCI.Core.Command.Help import DDCI.Core.Command import DDCI.Core.State+import DDC.Interface.Input import DDC.Data.ListUtils import Data.List @@ -12,7 +13,7 @@ -- | Run in unix command-line mode, reading commands from a list of arguments. runArgs :: [String] -> IO () runArgs args- = do let state = initState InterfaceArgs+ = do let state = initState InputInterfaceArgs -- If the help command is one of the arguments then just -- display the help and don't do anything else.
src/ddci-core/DDCI/Core/Interface/Batch.hs view
@@ -4,14 +4,25 @@ where import DDCI.Core.State import DDCI.Core.Input+import DDCI.Core.Command+import DDC.Interface.Input import Data.List -- | Run in batch mode, reading commands from the given string. runBatch :: FilePath -> String -> IO () runBatch filePath str- = do let state = initState (InterfaceBatch filePath)- let inputState = InputState Nothing InputLine 1 []+ = do let state = initState (InputInterfaceBatch filePath)+ + let inputState + = InputState + { inputParseCommand = readCommand+ , inputMode = InputLine+ , inputCommand = Nothing+ , inputLineNumber = 1+ , inputAcc = [] }++ loop state inputState (lines str) where -- No more lines, we're done.
src/ddci-core/DDCI/Core/Interface/Interactive.hs view
@@ -4,17 +4,18 @@ where import DDCI.Core.Input import DDCI.Core.State+import DDCI.Core.Command+import DDC.Interface.Input import Data.List import Data.Maybe import qualified System.Console.Haskeline as HL import qualified System.Console.Haskeline.IO as HL --- Interactive ---------------------------------------------------------------- -- | Run an interactive session, reading commands from the console. runInteractive :: IO () runInteractive- = do putStrLn "DDCi-core, version 0.3.1: http://disciple.ouroborus.net."+ = do putStrLn "DDCi-core, version 0.3.2: http://disciple.ouroborus.net." putStrLn "Type :help for help." -- Setup terminal mode.@@ -25,8 +26,16 @@ loopInteractive :: IO () loopInteractive = do hlState <- HL.initializeInput HL.defaultSettings- let state = initState InterfaceConsole- let inputState = InputState Nothing InputLine 1 []+ let state = initState InputInterfaceConsole+ + let inputState + = InputState + { inputParseCommand = readCommand+ , inputMode = InputLine+ , inputCommand = Nothing+ , inputLineNumber = 1+ , inputAcc = [] }+ loop state inputState hlState where loop state inputState hlState
src/ddci-core/DDCI/Core/Mode.hs view
@@ -28,6 +28,11 @@ -- | Display information about each transformation step | TraceTrans++ -- | Avoid type checking if possible.+ -- Helpful when debugging program transformations to see invalid+ -- code instead of an error message.+ | TaintAvoidTypeChecks deriving (Eq, Ord, Show) @@ -42,5 +47,6 @@ "SaltPrelude" -> Just SaltPrelude "Dump" -> Just Dump "TraceTrans" -> Just TraceTrans+ "TaintAvoidTypeChecks" -> Just TaintAvoidTypeChecks _ -> Nothing
src/ddci-core/DDCI/Core/Output.hs view
@@ -5,6 +5,7 @@ , chatStrLn) where import DDCI.Core.State+import DDC.Interface.Input import DDC.Base.Pretty import qualified Data.Set as Set @@ -44,6 +45,6 @@ chatStrLn :: State -> String -> IO () chatStrLn state str = case stateInterface state of- InterfaceConsole -> putStrLn str- InterfaceBatch _ -> putStrLn str+ InputInterfaceConsole -> putStrLn str+ InputInterfaceBatch _ -> putStrLn str _ -> return ()
src/ddci-core/DDCI/Core/Rewrite.hs view
@@ -15,6 +15,7 @@ import DDCI.Core.Output import Data.Char import qualified DDC.Core.Check as C+import qualified DDC.Core.Parser as C import qualified DDC.Base.Parser as BP import DDC.Core.Module@@ -49,7 +50,7 @@ => Fragment n err -> Map ModuleName (Module (C.AnTEC () n) n) -> String - -> Either Error (SetRuleCommand (C.AnTEC () n) n)+ -> Either Error (SetRuleCommand (C.AnTEC BP.SourcePos n) n) parseRewrite fragment modules str = case dropWhile isSpace str of@@ -69,11 +70,12 @@ => Fragment n err -> Map ModuleName (Module (C.AnTEC () n) n) -> String - -> Either Error (SetRuleCommand (C.AnTEC () n) n)+ -> Either Error (SetRuleCommand (C.AnTEC BP.SourcePos n) n) parseAdd fragment modules str | (name, rest) <- parseFirstWord str- = case BP.runTokenParser describeTok "<interactive>" pRule+ = case BP.runTokenParser describeTok "<interactive>" + (pRule (C.contextOfProfile (fragmentProfile fragment))) (fragmentLexExp fragment "interactive" 0 rest) of Left err -> Left $ renderIndent $ ppr err Right rule ->
src/ddci-core/DDCI/Core/State.hs view
@@ -7,7 +7,6 @@ , TransHistory (..) - , Interface (..) , Source (..) , Language (..)@@ -20,7 +19,8 @@ where import DDCI.Core.Mode import DDC.Code.Config-import DDC.Driver.Source+import DDC.Interface.Input+import DDC.Interface.Source import DDC.Build.Builder import DDC.Build.Language import DDC.Core.Check@@ -47,7 +47,7 @@ data State = State { -- | ddci interface state.- stateInterface :: Interface+ stateInterface :: InputInterface -- | ddci mode flags. , stateModes :: Set Mode @@ -92,19 +92,6 @@ , historyBundle :: Bundle s n err } --- | What interface is being used.-data Interface- -- | Read commands from unix command-line args.- = InterfaceArgs-- -- | Read commands interactively from the console.- | InterfaceConsole-- -- | Read commands from the file with this name.- | InterfaceBatch FilePath- deriving (Eq, Show)-- -- | Adjust a mode setting in the state. adjustMode :: Bool -- ^ Whether to enable or disable the mode. @@ -120,7 +107,7 @@ -- | The initial state.-initState :: Interface -> State+initState :: InputInterface -> State initState interface = State { stateInterface = interface@@ -151,16 +138,19 @@ = Runtime.Config { Runtime.configHeapSize = 65536 } - , D.configOutputFile = stateOutputFile state- , D.configOutputDir = stateOutputDir state- , D.configSimplLite = stateSimplLite state- , D.configSimplSalt = stateSimplSalt state- , D.configBuilder = builder- , D.configSuppressCoreImports = Set.member SuppressImports (stateModes state)- , D.configSuppressHashImports = not $ Set.member SaltPrelude (stateModes state) - , D.configKeepLlvmFiles = False- , D.configKeepSeaFiles = False- , D.configKeepAsmFiles = False }+ , D.configOutputFile = stateOutputFile state+ , D.configOutputDir = stateOutputDir state+ , D.configSimplLite = stateSimplLite state+ , D.configSimplSalt = stateSimplSalt state+ , D.configBuilder = builder+ , D.configSuppressCoreImports = Set.member SuppressImports (stateModes state)+ , D.configSuppressHashImports = not $ Set.member SaltPrelude (stateModes state) + , D.configKeepLlvmFiles = False+ , D.configKeepSeaFiles = False+ , D.configKeepAsmFiles = False ++ , D.configTaintAvoidTypeChecks + = Set.member TaintAvoidTypeChecks (stateModes state) } -- | Holds platform independent builder info.
src/ddci-core/DDCI/Core/Stats/Trace.hs view
@@ -50,7 +50,7 @@ traceStoreLs store entered ls = let down = traceStoreX store entered in case ls of- LLet m b x -> LLet m b (down x)+ LLet b x -> LLet b (down x) LRec bxs -> LRec [(b, down x) | (b, x) <- bxs] LLetRegions{} -> ls LWithRegion{} -> ls
src/ddci-core/Main.hs view
@@ -1,13 +1,14 @@ --- | Interactive interface to DDC.--- This also accepts interpreter commands as arguments on the command-line.--- If you want a more unixy inferface then use the ddc-main interface instead.+-- | Interactive interface to DDC for core programs.+-- This also accepts interpreter commands as arguments on the command-line.+-- If you want a more unixy inferface then use the ddc-main interface instead. module Main where import DDCI.Core.Command.Help import DDCI.Core.Interface.Args import DDCI.Core.Interface.Batch import DDCI.Core.Interface.Interactive import DDCI.Core.State+import DDC.Interface.Input import DDC.Driver.Command.Make import System.Environment import System.IO@@ -34,7 +35,7 @@ -- This gets us --make on the command line as well as -make -- so we behave more like GHC. ["--make", filePath]- -> do let state = initState (InterfaceBatch filePath)+ -> do let state = initState (InputInterfaceBatch filePath) config <- getDriverConfigOfState state runError $ cmdMake config filePath