Add AST and CommentToken targets

src/CompilerOpts.hs

@@ -175,12 +175,14 @@ verbosities = [ ( VerbQuiet , "0", "quiet" )
 -- |Type of the target file
 data TargetType
   = Tokens               -- ^ Source code tokens
+  | CommentTokens        -- ^ Source code comment tokens
   | Parsed               -- ^ Parsed source code
   | FlatCurry            -- ^ FlatCurry
   | TypedFlatCurry       -- ^ Typed FlatCurry
   | AbstractCurry        -- ^ AbstractCurry
   | UntypedAbstractCurry -- ^ Untyped AbstractCurry
   | Html                 -- ^ HTML documentation
+  | AST                  -- ^ Abstract-Syntax-Tree after checks
     deriving (Eq, Show)
 
 -- |Warnings flags
@@ -423,6 +425,8 @@ options =
   -- target types
   , targetOption Tokens               "tokens"
       "generate token stream"
+  , targetOption CommentTokens        "commentTokens"
+      "generate comment token stream"
   , targetOption Parsed               "parse-only"
       "generate source representation"
   , targetOption FlatCurry            "flat"
@@ -435,6 +439,8 @@ options =
       "generate untyped AbstractCurry"
   , targetOption Html                 "html"
       "generate html documentation"
+  , targetOption AST                  "ast"
+      "generate abstract syntax tree"
   , Option "F"  []
       (NoArg (onPrepOpts $ \ opts -> opts { ppPreprocess = True }))
       "use custom preprocessor"

src/CurryBuilder.hs

@@ -166,12 +166,14 @@ process opts idx m fn deps
 
   destFiles = [ gen fn | (t, gen) <- nameGens, t `elem` optTargetTypes opts]
   nameGens  =
-    [ (Tokens              , tgtDir . tokensName   )
-    , (Parsed              , tgtDir . sourceRepName)
-    , (FlatCurry           , tgtDir . flatName     )
-    , (TypedFlatCurry      , tgtDir . typedFlatName)
-    , (AbstractCurry       , tgtDir . acyName      )
-    , (UntypedAbstractCurry, tgtDir . uacyName     )
+    [ (Tokens              , tgtDir . tokensName       )
+    , (CommentTokens       , tgtDir . commentTokensName)
+    , (Parsed              , tgtDir . sourceRepName    )
+    , (FlatCurry           , tgtDir . flatName         )
+    , (TypedFlatCurry      , tgtDir . typedFlatName    )
+    , (AbstractCurry       , tgtDir . acyName          )
+    , (UntypedAbstractCurry, tgtDir . uacyName         )
+    , (AST                 , tgtDir . astName          )
     , (Html                , const (fromMaybe "." (optHtmlDir opts) </> htmlName m))
     ]
 

src/Modules.hs

@@ -43,6 +43,7 @@ import Curry.FlatCurry.InterfaceEquivalence (eqInterface)
 import Curry.Files.Filenames
 import Curry.Files.PathUtils
 import Curry.Syntax.InterfaceEquivalence
+import Curry.Syntax.Lexer (Token(..), Category(..))
 
 import Base.Messages
 import Base.Types
@@ -86,9 +87,11 @@ import Transformations
 compileModule :: Options -> ModuleIdent -> FilePath -> CYIO ()
 compileModule opts m fn = do
   mdl <- loadAndCheckModule opts m fn
-  writeTokens opts (fst mdl)
+  writeTokens        opts (fst mdl)
+  writeCommentTokens opts (fst mdl)
   writeParsed opts mdl
   writeHtml   opts (qual mdl)
+  writeAST    opts (fst mdl, fmap (const ()) (snd mdl))
   mdl' <- expandExports opts mdl
   qmdl <- dumpWith opts CS.showModule CS.ppModule DumpQualified $ qual mdl'
   writeAbstractCurry opts qmdl
@@ -288,6 +291,18 @@ writeTokens opts env = when tokTarget $ liftIO $
   tokTarget  = Tokens `elem` optTargetTypes opts
   useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
 
+writeCommentTokens :: Options -> CompilerEnv -> CYIO ()
+writeCommentTokens opts env = when tokTarget $ liftIO $ (putStrLn "lol" >>
+  writeModule (useSubDir $ commentTokensName (filePath env))
+              (showTokenStream $ filter (isCommentTok . snd) (tokens env)))
+  where
+  tokTarget  = CommentTokens `elem` optTargetTypes opts
+  useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
+
+-- | Check if Token is LineComment or NestedComment
+isCommentTok :: Token -> Bool
+isCommentTok (Token c _) = c == NestedComment || c == LineComment
+
 -- |Output the parsed 'Module' on request
 writeParsed :: Show a => Options -> CompEnv (CS.Module a) -> CYIO ()
 writeParsed opts (env, mdl) = when srcTarget $ liftIO $
@@ -371,6 +386,15 @@ writeAbstractCurry opts (env, mdl) = do
   uacyTarget = UntypedAbstractCurry `elem` optTargetTypes opts
   useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
 
+
+writeAST :: Options -> CompEnv (CS.Module ()) -> CYIO ()
+writeAST opts (env, mdl) = when astTarget $ liftIO $
+  writeModule (useSubDir $ astName (filePath env)) (show mdl)
+  where
+  astTarget  = AST `elem` optTargetTypes opts
+  useSubDir  = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
+
+
 type Dump = (DumpLevel, CompilerEnv, String)
 
 dumpWith :: MonadIO m