Commit 48cd8de8 authored by Kai-Oliver Prott's avatar Kai-Oliver Prott

Add short-ast target and change comment target

parent c70b59da
......@@ -175,7 +175,7 @@ verbosities = [ ( VerbQuiet , "0", "quiet" )
-- |Type of the target file
data TargetType
= Tokens -- ^ Source code tokens
| CommentTokens -- ^ Source code comment tokens
| Comments -- ^ Source code comments
| Parsed -- ^ Parsed source code
| FlatCurry -- ^ FlatCurry
| TypedFlatCurry -- ^ Typed FlatCurry
......@@ -183,6 +183,7 @@ data TargetType
| UntypedAbstractCurry -- ^ Untyped AbstractCurry
| Html -- ^ HTML documentation
| AST -- ^ Abstract-Syntax-Tree after checks
| ShortAST -- ^ Abstract-Syntax-Tree with shortened decls
deriving (Eq, Show)
-- |Warnings flags
......@@ -425,8 +426,8 @@ options =
-- target types
, targetOption Tokens "tokens"
"generate token stream"
, targetOption CommentTokens "commentTokens"
"generate comment token stream"
, targetOption Comments "comments"
"generate comments stream"
, targetOption Parsed "parse-only"
"generate source representation"
, targetOption FlatCurry "flat"
......@@ -441,6 +442,8 @@ options =
"generate html documentation"
, targetOption AST "ast"
"generate abstract syntax tree"
, targetOption ShortAST "short-ast"
"generate shortened abstract syntax tree for documentation"
, Option "F" []
(NoArg (onPrepOpts $ \ opts -> opts { ppPreprocess = True }))
"use custom preprocessor"
......
......@@ -167,13 +167,14 @@ process opts idx m fn deps
destFiles = [ gen fn | (t, gen) <- nameGens, t `elem` optTargetTypes opts]
nameGens =
[ (Tokens , tgtDir . tokensName )
, (CommentTokens , tgtDir . commentTokensName)
, (Comments , tgtDir . commentsName)
, (Parsed , tgtDir . sourceRepName )
, (FlatCurry , tgtDir . flatName )
, (TypedFlatCurry , tgtDir . typedFlatName )
, (AbstractCurry , tgtDir . acyName )
, (UntypedAbstractCurry, tgtDir . uacyName )
, (AST , tgtDir . astName )
, (ShortAST , tgtDir . shortASTName )
, (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.Utils (shortenModuleAST)
import Curry.Syntax.Lexer (Token(..), Category(..))
import Base.Messages
......@@ -65,7 +66,7 @@ import Generators
import Html.CurryHtml (source2html)
import Imports
import Interfaces (loadInterfaces)
import TokenStream (showTokenStream)
import TokenStream (showTokenStream, showCommentTokenStream)
import Transformations
-- The function 'compileModule' is the main entry-point of this
......@@ -87,11 +88,13 @@ import Transformations
compileModule :: Options -> ModuleIdent -> FilePath -> CYIO ()
compileModule opts m fn = do
mdl <- loadAndCheckModule opts m fn
writeTokens opts (fst mdl)
writeCommentTokens opts (fst mdl)
writeParsed opts mdl
writeHtml opts (qual mdl)
writeAST opts (fst mdl, fmap (const ()) (snd mdl))
writeTokens opts (fst mdl)
writeComments opts (fst mdl)
writeParsed opts mdl
writeHtml opts (qual mdl)
let umdl = (fst mdl, fmap (const ()) (snd mdl))
writeAST opts umdl
writeShortAST opts umdl
mdl' <- expandExports opts mdl
qmdl <- dumpWith opts CS.showModule CS.ppModule DumpQualified $ qual mdl'
writeAbstractCurry opts qmdl
......@@ -291,18 +294,14 @@ 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)))
writeComments :: Options -> CompilerEnv -> CYIO ()
writeComments opts env = when tokTarget $ liftIO $
writeModule (useSubDir $ commentsName (filePath env))
(showCommentTokenStream $ tokens env)
where
tokTarget = CommentTokens `elem` optTargetTypes opts
tokTarget = Comments `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 $
......@@ -395,6 +394,15 @@ writeAST opts (env, mdl) = when astTarget $ liftIO $
useSubDir = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
writeShortAST :: Options -> CompEnv (CS.Module ()) -> CYIO ()
writeShortAST opts (env, mdl) = when astTarget $ liftIO $
writeModule (useSubDir $ shortASTName (filePath env))
(CS.showModule $ shortenModuleAST mdl)
where
astTarget = ShortAST `elem` optTargetTypes opts
useSubDir = addCurrySubdirModule (optUseSubdir opts) (moduleIdent env)
type Dump = (DumpLevel, CompilerEnv, String)
dumpWith :: MonadIO m
......
......@@ -9,7 +9,7 @@
and spans of a Curry source module into a separate file.
-}
module TokenStream (showTokenStream) where
module TokenStream (showTokenStream, showCommentTokenStream) where
import Data.List (intercalate)
......@@ -21,20 +21,46 @@ import Curry.Syntax (Token (..), Category (..), Attributes (..))
-- The list is split into one tuple on each line to increase readability.
showTokenStream :: [(Span, Token)] -> String
showTokenStream [] = "[]\n"
showTokenStream ts = "[ " ++ intercalate "\n, " (map showST filteredTs) ++ "\n]\n"
showTokenStream ts =
"[ " ++ intercalate "\n, " (map showST filteredTs) ++ "\n]\n"
where filteredTs = filter (not . isVirtual) ts
showST (sp, t) = "(" ++ showSpanAsPair sp ++ ", " ++ showToken t ++ ")"
-- |Show a list of 'Span' and 'Token' tuples filtered by CommentTokens.
-- The list is split into one tuple on each line to increase readability.
showCommentTokenStream :: [(Span, Token)] -> String
showCommentTokenStream [] = "[]\n"
showCommentTokenStream ts =
"[ " ++ intercalate "\n, " (map showST filteredTs) ++ "\n]\n"
where filteredTs = filter isComment ts
showST (sp, t) = "(" ++ showSpan sp ++ ", " ++ showToken t ++ ")"
isVirtual :: (Span, Token) -> Bool
isVirtual (_, Token cat _) = cat `elem` [EOF, VRightBrace, VSemicolon]
isComment :: (Span, Token) -> Bool
isComment (_, Token cat _) = cat `elem` [LineComment, NestedComment]
-- show 'span' as "((startLine, startColumn), (endLine, endColumn))"
showSpanAsPair :: Span -> String
showSpanAsPair sp =
"(" ++ showPosAsPair (start sp) ++ ", " ++ showPos (end sp) ++ ")"
-- show 'span' as "(Span startPos endPos)"
showSpan :: Span -> String
showSpan sp = "(" ++ showPos (start sp) ++ ", " ++ showPos (end sp) ++ ")"
showSpan NoSpan = "NoSpan"
showSpan Span { start = s, end = e } =
"(Span " ++ showPos s ++ " " ++ showPos e ++ ")"
-- show 'Position' as "(line, column)"
-- show 'position' as "(Position line column)"
showPos :: Position -> String
showPos p = "(" ++ show (line p) ++ ", " ++ show (column p) ++ ")"
showPos NoPos = "NoPos"
showPos Position { line = l, column = c } =
"(Position " ++ show l++ " " ++ show c ++ ")"
-- show 'Position' as "(line, column)"
showPosAsPair :: Position -> String
showPosAsPair p = "(" ++ show (line p) ++ ", " ++ show (column p) ++ ")"
-- |Show tokens and their value if needed
showToken :: Token -> String
......
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