diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- The Disciplined Disciple Compiler License (MIT style) -Copyrite (K) 2007-2014 The Disciplined Disciple Compiler Strike Force +Copyrite (K) 2007-2016 The Disciplined Disciple Compiler Strike Force All rights reversed. Permission is hereby granted, free of charge, to any person obtaining a copy diff --git a/ddc-tools.cabal b/ddc-tools.cabal --- a/ddc-tools.cabal +++ b/ddc-tools.cabal @@ -1,5 +1,5 @@ Name: ddc-tools -Version: 0.4.2.2 +Version: 0.4.3.1 License: MIT License-file: LICENSE Author: The Disciplined Disciple Compiler Strike Force @@ -18,8 +18,8 @@ src/ddc-check Build-depends: - base >= 4.6 && < 4.9, - ddc-core == 0.4.2.* + base >= 4.6 && < 4.10, + ddc-core == 0.4.3.* Main-is: Main.hs @@ -35,23 +35,22 @@ src/ddc-main Build-depends: - base >= 4.6 && < 4.9, - process >= 1.1 && < 1.3, + base >= 4.6 && < 4.10, + process >= 1.4 && < 1.5, containers == 0.5.*, filepath >= 1.3 && < 1.5, haskeline == 0.7.*, directory == 1.2.*, mtl == 2.2.1.*, - transformers == 0.4.*, - 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.2 && < 0.4.3, - ddc-core-tetra == 0.4.2.*, - ddc-code == 0.4.2.*, - ddc-build >= 0.4.2.2 && < 0.4.3, - ddc-driver >= 0.4.2.2 && < 0.4.3 + transformers == 0.5.*, + ddc-core == 0.4.3.*, + ddc-core-simpl == 0.4.3.*, + ddc-core-salt == 0.4.3.*, + ddc-core-llvm == 0.4.3.*, + ddc-core-tetra == 0.4.3.*, + ddc-code == 0.4.3.*, + ddc-build == 0.4.3.*, + ddc-driver == 0.4.3.* Main-is: Main.hs @@ -70,23 +69,22 @@ src/ddci-core Build-depends: - base >= 4.6 && < 4.9, - process >= 1.1 && < 1.3, + base >= 4.6 && < 4.10, + process >= 1.4 && < 1.5, containers == 0.5.*, filepath >= 1.3 && < 1.5, haskeline == 0.7.*, directory == 1.2.*, mtl == 2.2.1.*, - 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-code == 0.4.2.*, - ddc-build == 0.4.2.*, - ddc-driver == 0.4.2.* + ddc-core == 0.4.3.*, + ddc-core-simpl == 0.4.3.*, + ddc-core-salt == 0.4.3.*, + ddc-core-llvm == 0.4.3.*, + ddc-core-flow == 0.4.3.*, + ddc-core-tetra == 0.4.3.*, + ddc-code == 0.4.3.*, + ddc-build == 0.4.3.*, + ddc-driver == 0.4.3.* Main-is: Main.hs @@ -135,24 +133,23 @@ src/ddci-tetra Build-depends: - base >= 4.6 && < 4.9, - process >= 1.1 && < 1.3, - containers == 0.5.*, + base >= 4.6 && < 4.10, + process >= 1.4 && < 1.5, filepath >= 1.3 && < 1.5, + containers == 0.5.*, haskeline == 0.7.*, directory == 1.2.*, mtl == 2.2.1.*, - 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-code == 0.4.2.*, - ddc-build == 0.4.2.*, - ddc-driver == 0.4.2.* + ddc-core == 0.4.3.*, + ddc-core-simpl == 0.4.3.*, + ddc-core-salt == 0.4.3.*, + ddc-core-llvm == 0.4.3.*, + ddc-core-flow == 0.4.3.*, + ddc-core-tetra == 0.4.3.*, + ddc-source-tetra == 0.4.3.*, + ddc-code == 0.4.3.*, + ddc-build == 0.4.3.*, + ddc-driver == 0.4.3.* Main-is: Main.hs diff --git a/src/ddc-main/DDC/Main/Args.hs b/src/ddc-main/DDC/Main/Args.hs --- a/src/ddc-main/DDC/Main/Args.hs +++ b/src/ddc-main/DDC/Main/Args.hs @@ -1,4 +1,9 @@ +-- In GHC 8 we need to turn of the pattern match checker because the new algorithm +-- runs out of stack space when checking this module. +-- https://ghc.haskell.org/trac/ghc/ticket/11822 +{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns #-} + -- | Parsing of command line configuation arguments. module DDC.Main.Args ( parseArgs @@ -115,6 +120,14 @@ $ config { configRuntimeLinkStrategy = LinkStatic } -- Parsing ------------------------------ + | "-scan" : file : rest <- args + = parseArgs rest + $ config { configMode = ModeScan file True } + + | "-scan-no-locations" : file : rest <- args + = parseArgs rest + $ config { configMode = ModeScan file False } + | "-parse" : file : rest <- args = parseArgs rest $ config { configMode = ModeParse file } @@ -262,6 +275,8 @@ ModeVersion{} -> Just "-version" ModeHelp{} -> Just "-help" ModeParse{} -> Just "-parse" + ModeScan _ True -> Just "-scan" + ModeScan _ False -> Just "-scan-no-locations" ModeCheck{} -> Just "-check" ModeLoad{} -> Just "-load" ModeCompile{} -> Just "-compile" diff --git a/src/ddc-main/DDC/Main/Config.hs b/src/ddc-main/DDC/Main/Config.hs --- a/src/ddc-main/DDC/Main/Config.hs +++ b/src/ddc-main/DDC/Main/Config.hs @@ -28,6 +28,10 @@ -- | Display the help page. | ModeHelp + -- | Scan a module, producing tokens. + -- The flag says whether to produce source locations. + | ModeScan FilePath Bool + -- | Parse a module. | ModeParse FilePath diff --git a/src/ddc-main/Main.hs b/src/ddc-main/Main.hs --- a/src/ddc-main/Main.hs +++ b/src/ddc-main/Main.hs @@ -8,6 +8,7 @@ import DDC.Main.Args import DDC.Main.OptLevels +import DDC.Driver.Command.Scan import DDC.Driver.Command.Parse import DDC.Driver.Command.Check import DDC.Driver.Command.Load @@ -33,7 +34,7 @@ import DDC.Driver.Interface.Source import DDC.Build.Builder -import DDC.Base.Pretty +import DDC.Data.Pretty import System.Environment import System.IO import System.Exit @@ -82,6 +83,11 @@ -- Display the help page. ModeHelp -> putStrLn help + + -- Scan a module. + ModeScan filePath bPrintLocs + -> do dconfig <- getDriverConfig config (Just filePath) + runError $ cmdScanFromFile dconfig filePath bPrintLocs -- Parse a module. ModeParse filePath diff --git a/src/ddci-core/DDCI/Core/Command/Set.hs b/src/ddci-core/DDCI/Core/Command/Set.hs --- a/src/ddci-core/DDCI/Core/Command/Set.hs +++ b/src/ddci-core/DDCI/Core/Command/Set.hs @@ -10,7 +10,7 @@ import DDC.Core.Fragment import DDC.Core.Simplifier.Parser import DDC.Core.Transform.Reannotate -import DDC.Base.Pretty +import DDC.Data.Pretty import Control.Monad import Data.Char import Data.List diff --git a/src/ddci-core/DDCI/Core/Command/TransInteract.hs b/src/ddci-core/DDCI/Core/Command/TransInteract.hs --- a/src/ddci-core/DDCI/Core/Command/TransInteract.hs +++ b/src/ddci-core/DDCI/Core/Command/TransInteract.hs @@ -13,9 +13,9 @@ import DDC.Core.Exp.Annot import DDC.Core.Check import DDC.Core.Module -import DDC.Base.Pretty -import qualified Data.Map as Map -import qualified Data.Set as Set +import DDC.Data.Pretty +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set -- TransInteract -------------------------------------------------------------- @@ -97,17 +97,15 @@ return state Right tr' -> do - let kenv = modulesExportTypes - (bundleModules bundle) - (profilePrimKinds profile) - - let tenv = modulesExportValues - (bundleModules bundle) - (profilePrimTypes profile) + let env = modulesEnvX + (profilePrimKinds profile) + (profilePrimTypes profile) + (profilePrimDataDefs profile) + (Map.elems $ bundleModules bundle) x_trans <- transExp (Set.member TraceTrans $ stateModes state) - profile kenv tenv + profile env (bundleStateInit bundle) tr' x' case x_trans of diff --git a/src/ddci-core/DDCI/Core/Interface/Interactive.hs b/src/ddci-core/DDCI/Core/Interface/Interactive.hs --- a/src/ddci-core/DDCI/Core/Interface/Interactive.hs +++ b/src/ddci-core/DDCI/Core/Interface/Interactive.hs @@ -15,7 +15,7 @@ -- | Run an interactive session, reading commands from the console. runInteractive :: IO () runInteractive - = do putStrLn "DDCi-core, version 0.4.2: http://disciple.ouroborus.net." + = do putStrLn "DDCi-core, version 0.4.3: http://disciple.ouroborus.net." putStrLn "Type :help for help." -- Setup terminal mode. diff --git a/src/ddci-core/DDCI/Core/Output.hs b/src/ddci-core/DDCI/Core/Output.hs --- a/src/ddci-core/DDCI/Core/Output.hs +++ b/src/ddci-core/DDCI/Core/Output.hs @@ -6,7 +6,7 @@ where import DDCI.Core.State import DDC.Driver.Interface.Input -import DDC.Base.Pretty +import DDC.Data.Pretty import qualified Data.Set as Set diff --git a/src/ddci-core/DDCI/Core/Rewrite.hs b/src/ddci-core/DDCI/Core/Rewrite.hs --- a/src/ddci-core/DDCI/Core/Rewrite.hs +++ b/src/ddci-core/DDCI/Core/Rewrite.hs @@ -5,7 +5,7 @@ , parseRewrite , showRule ) where -import DDC.Base.Pretty +import DDC.Data.Pretty import DDC.Build.Language import DDC.Core.Lexer import DDC.Core.Fragment hiding (Error) @@ -16,7 +16,8 @@ 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 qualified DDC.Control.Parser as BP +import qualified Data.Map.Strict as Map import DDC.Core.Module import Data.Map (Map) @@ -74,21 +75,22 @@ parseAdd fragment modules str | (name, rest) <- parseFirstWord str - = case BP.runTokenParser describeTok "" + = case BP.runTokenParser describeToken "" (pRule (C.contextOfProfile (fragmentProfile fragment))) (fragmentLexExp fragment "interactive" 0 rest) of Left err -> Left $ renderIndent $ ppr err Right rule -> - case checkRewriteRule config kinds' types' rule of + case checkRewriteRule config env rule of Left err -> Left $ renderIndent $ ppr err Right rule' -> Right $ SetAdd name rule' where config = C.configOfProfile (fragmentProfile fragment) - kinds = profilePrimKinds (fragmentProfile fragment) - types = profilePrimTypes (fragmentProfile fragment) - - kinds' = modulesExportTypes modules kinds - types' = modulesExportValues modules types + profile = fragmentProfile fragment + env = modulesEnvX + (profilePrimKinds profile) + (profilePrimTypes profile) + (profilePrimDataDefs profile) + (Map.elems modules) -- | Display rule diff --git a/src/ddci-core/DDCI/Core/State.hs b/src/ddci-core/DDCI/Core/State.hs --- a/src/ddci-core/DDCI/Core/State.hs +++ b/src/ddci-core/DDCI/Core/State.hs @@ -28,8 +28,8 @@ import DDC.Core.Exp import DDC.Core.Module import DDC.Core.Simplifier -import DDC.Base.Pretty hiding (()) -import DDC.Base.Name +import DDC.Data.Pretty hiding (()) +import DDC.Data.Name import Data.Typeable import System.FilePath import Data.Map (Map) diff --git a/src/ddci-tetra/DDCI/Tetra/Command/Desugar.hs b/src/ddci-tetra/DDCI/Tetra/Command/Desugar.hs --- a/src/ddci-tetra/DDCI/Tetra/Command/Desugar.hs +++ b/src/ddci-tetra/DDCI/Tetra/Command/Desugar.hs @@ -4,13 +4,13 @@ where import DDC.Driver.Interface.Source import DDCI.Tetra.State -import DDC.Base.Pretty +import DDC.Data.Pretty import DDC.Source.Tetra.Lexer import DDC.Source.Tetra.Parser import DDC.Source.Tetra.Pretty () import DDC.Source.Tetra.Transform.Defix import qualified DDC.Core.Lexer as C -import qualified DDC.Base.Parser as BP +import qualified DDC.Control.Parser as BP cmdDesugar :: State -> Source -> String -> IO () @@ -21,8 +21,9 @@ in goParse tokens goParse tokens - = case BP.runTokenParser C.describeTok (nameOfSource source) - (pModule context) tokens of + = case BP.runTokenParser + C.describeToken (nameOfSource source) + pModule tokens of Left err -> error $ show err Right mm -> goDesugar mm diff --git a/src/ddci-tetra/DDCI/Tetra/Command/Infer.hs b/src/ddci-tetra/DDCI/Tetra/Command/Infer.hs --- a/src/ddci-tetra/DDCI/Tetra/Command/Infer.hs +++ b/src/ddci-tetra/DDCI/Tetra/Command/Infer.hs @@ -4,15 +4,13 @@ where import DDCI.Tetra.State import DDC.Driver.Interface.Source -import DDC.Base.Pretty -import DDC.Source.Tetra.Env +import DDC.Data.Pretty import DDC.Source.Tetra.Lexer import DDC.Source.Tetra.Parser import DDC.Source.Tetra.Pretty () import DDC.Source.Tetra.Transform.Defix -import DDC.Source.Tetra.Transform.Expand as Expand import qualified DDC.Core.Lexer as C -import qualified DDC.Base.Parser as BP +import qualified DDC.Control.Parser as BP cmdInfer :: State -> Source -> String -> IO () @@ -23,8 +21,7 @@ in goParse tokens goParse tokens - = case BP.runTokenParser C.describeTok (nameOfSource source) - (pModule context) tokens of + = case BP.runTokenParser C.describeToken (nameOfSource source) pModule tokens of Left err -> error $ show err Right mm -> goDesugar mm @@ -34,7 +31,5 @@ Right mm' -> goExpand mm' goExpand mm - = do let mm' = Expand.expand Expand.configDefault - primKindEnv primTypeEnv mm - putStrLn (renderIndent $ ppr mm') + = do putStrLn (renderIndent $ ppr mm) diff --git a/src/ddci-tetra/DDCI/Tetra/Command/Parse.hs b/src/ddci-tetra/DDCI/Tetra/Command/Parse.hs --- a/src/ddci-tetra/DDCI/Tetra/Command/Parse.hs +++ b/src/ddci-tetra/DDCI/Tetra/Command/Parse.hs @@ -2,14 +2,14 @@ module DDCI.Tetra.Command.Parse (cmdParse) where -import DDC.Driver.Interface.Source import DDCI.Tetra.State -import DDC.Base.Pretty +import DDC.Driver.Interface.Source +import DDC.Data.Pretty import DDC.Source.Tetra.Lexer import DDC.Source.Tetra.Parser import DDC.Source.Tetra.Pretty () import qualified DDC.Core.Lexer as C -import qualified DDC.Base.Parser as BP +import qualified DDC.Control.Parser as BP cmdParse :: State -> Source -> String -> IO () @@ -21,10 +21,8 @@ goParse tokens = case BP.runTokenParser - C.describeTok - (nameOfSource source) - (pModule context) - tokens of + C.describeToken (nameOfSource source) + pModule tokens of Left err -> error $ show err Right mm -> do putStrLn (renderIndent $ ppr mm) diff --git a/src/ddci-tetra/DDCI/Tetra/Command/Set.hs b/src/ddci-tetra/DDCI/Tetra/Command/Set.hs --- a/src/ddci-tetra/DDCI/Tetra/Command/Set.hs +++ b/src/ddci-tetra/DDCI/Tetra/Command/Set.hs @@ -4,7 +4,7 @@ where import DDCI.Tetra.State import DDCI.Tetra.Mode -import DDC.Base.Pretty +import DDC.Data.Pretty import Data.Char import Data.List import qualified DDC.Build.Builder as Build diff --git a/src/ddci-tetra/DDCI/Tetra/Command/ToCore.hs b/src/ddci-tetra/DDCI/Tetra/Command/ToCore.hs --- a/src/ddci-tetra/DDCI/Tetra/Command/ToCore.hs +++ b/src/ddci-tetra/DDCI/Tetra/Command/ToCore.hs @@ -5,7 +5,7 @@ import DDC.Driver.Interface.Source import DDC.Driver.Stage import DDC.Build.Pipeline -import DDC.Base.Pretty +import DDC.Data.Pretty import qualified DDC.Driver.Config as D import DDC.Build.Interface.Store (Store) diff --git a/src/ddci-tetra/DDCI/Tetra/Interface/Interactive.hs b/src/ddci-tetra/DDCI/Tetra/Interface/Interactive.hs --- a/src/ddci-tetra/DDCI/Tetra/Interface/Interactive.hs +++ b/src/ddci-tetra/DDCI/Tetra/Interface/Interactive.hs @@ -15,7 +15,7 @@ -- | Run an interactive session, reading commands from the console. runInteractive :: IO () runInteractive - = do putStrLn "DDCi-tetra, version 0.4.2: http://disciple.ouroborus.net." + = do putStrLn "DDCi-tetra, version 0.4.3: http://disciple.ouroborus.net." putStrLn "Type :help for help." -- Setup terminal mode. diff --git a/src/ddci-tetra/DDCI/Tetra/Output.hs b/src/ddci-tetra/DDCI/Tetra/Output.hs --- a/src/ddci-tetra/DDCI/Tetra/Output.hs +++ b/src/ddci-tetra/DDCI/Tetra/Output.hs @@ -6,7 +6,7 @@ where import DDCI.Tetra.State import DDC.Driver.Interface.Input -import DDC.Base.Pretty +import DDC.Data.Pretty -- | Output a document to the console.