Commit cfa7f534 authored by Unknown's avatar Unknown

Add AST and CommentToken targets

parent 72795a31
......@@ -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"
......
......@@ -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))
]
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment