suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Split include file expansion out into a separate pass.

Browse Source 
The order of initial passes is now:
  lex -> preprocess -> structure -> expand-include -> parse
which means that #IFing out structurally-invalid code (like inline VALOF) now
works.  This also cleans up the preprocessor code a bit.
This commit is contained in:
Adam Sampson 2008-02-29 15:01:19 +00:00
parent d7fbd93816
commit a2a15cab64
5 changed files with 137 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
frontends/LexOccam.x
View File

@ -138,6 +138,7 @@ data TokenType =
| TokHexLiteral String | TokHexLiteral String
| TokRealLiteral String | TokRealLiteral String
| TokPreprocessor String | TokPreprocessor String
| IncludeFile String -- ^ Include a file
| Indent -- ^ Indentation increase | Indent -- ^ Indentation increase
| Outdent -- ^ Indentation decrease | Outdent -- ^ Indentation decrease
| EndOfLine -- ^ End of line | EndOfLine -- ^ End of line

72
frontends/PreprocessOccam.hs
View File

@ -18,7 +18,8 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
-} -}
-- | Preprocess occam code. -- | Preprocess occam code.
module PreprocessOccam (preprocessOccamProgram, preprocessOccamSource, preprocessOccam) where module PreprocessOccam (preprocessOccamProgram, preprocessOccamSource,
preprocessOccam, expandIncludes) where
import Control.Monad.State import Control.Monad.State
import Data.List import Data.List
@ -77,32 +78,38 @@ preprocessSource m realFilename s
veryDebug $ "{{{ lexer tokens" veryDebug $ "{{{ lexer tokens"
veryDebug $ pshow toks veryDebug $ pshow toks
veryDebug $ "}}}" veryDebug $ "}}}"
toks' <- structureOccam toks toks' <- preprocessOccam toks
veryDebug $ "{{{ structured tokens" veryDebug $ "{{{ preprocessed tokens"
veryDebug $ pshow toks' veryDebug $ pshow toks'
veryDebug $ "}}}" veryDebug $ "}}}"
toks'' <- preprocessOccam toks' toks'' <- structureOccam toks'
veryDebug $ "{{{ preprocessed tokens" veryDebug $ "{{{ structured tokens"
veryDebug $ pshow toks'' veryDebug $ pshow toks''
veryDebug $ "}}}" veryDebug $ "}}}"
return toks'' expandIncludes toks''
-- | Expand 'IncludeFile' markers in a token stream.
expandIncludes :: [Token] -> PassM [Token]
expandIncludes [] = return []
expandIncludes ((m, IncludeFile filename) : (_, EndOfLine) : ts)
= do contents <- preprocessFile m filename
rest <- expandIncludes ts
return $ contents ++ rest
expandIncludes ((m, IncludeFile _):_) = error "IncludeFile token should be followed by EndOfLine"
expandIncludes (t:ts) = expandIncludes ts >>* (t :)
-- | Preprocess a token stream. -- | Preprocess a token stream.
preprocessOccam :: [Token] -> PassM [Token] preprocessOccam :: [Token] -> PassM [Token]
preprocessOccam [] = return [] preprocessOccam [] = return []
preprocessOccam ((m, TokPreprocessor s):(_, EndOfLine):ts) preprocessOccam ((m, TokPreprocessor s):ts)
= do (beforeRest, afterRest) <- handleDirective m (stripPrefix s) = do beforeRest <- handleDirective m (stripPrefix s)
rest <- beforeRest ts >>= preprocessOccam beforeRest ts >>= preprocessOccam
return $ afterRest rest
where where
stripPrefix :: String -> String stripPrefix :: String -> String
stripPrefix (' ':cs) = stripPrefix cs stripPrefix (' ':cs) = stripPrefix cs
stripPrefix ('\t':cs) = stripPrefix cs stripPrefix ('\t':cs) = stripPrefix cs
stripPrefix ('#':cs) = cs stripPrefix ('#':cs) = cs
stripPrefix _ = error "bad TokPreprocessor prefix" stripPrefix _ = error "bad TokPreprocessor prefix"
-- Check the above case didn't miss something.
preprocessOccam ((_, TokPreprocessor _):_)
= error "bad TokPreprocessor token"
preprocessOccam ((_, TokReserved "##") : (m, TokIdentifier var) : ts) preprocessOccam ((_, TokReserved "##") : (m, TokIdentifier var) : ts)
= do st <- get = do st <- get
case Map.lookup var (csDefinitions st) of case Map.lookup var (csDefinitions st) of
@ -121,10 +128,10 @@ preprocessOccam (t:ts)
return $ t : rest return $ t : rest
--{{{ preprocessor directive handlers --{{{ preprocessor directive handlers
type DirectiveFunc = Meta -> [String] -> PassM ([Token] -> PassM [Token], [Token] -> [Token]) type DirectiveFunc = Meta -> [String] -> PassM ([Token] -> PassM [Token])
-- | Call the handler for a preprocessor directive. -- | Call the handler for a preprocessor directive.
handleDirective :: Meta -> String -> PassM ([Token] -> PassM [Token], [Token] -> [Token]) handleDirective :: Meta -> String -> PassM ([Token] -> PassM [Token])
handleDirective m s = lookup s directives handleDirective m s = lookup s directives
where where
-- FIXME: This should really be an error rather than a warning, but -- FIXME: This should really be an error rather than a warning, but
@ -132,7 +139,7 @@ handleDirective m s = lookup s directives
-- useful. -- useful.
lookup s [] lookup s []
= do addWarning m "Unknown preprocessor directive ignored" = do addWarning m "Unknown preprocessor directive ignored"
return (return, id) return return
lookup s ((re, func):ds) lookup s ((re, func):ds)
= case matchRegex re s of = case matchRegex re s of
Just fields -> func m fields Just fields -> func m fields
@ -155,7 +162,7 @@ directives =
-- | Handle a directive that can be ignored. -- | Handle a directive that can be ignored.
handleIgnorable :: DirectiveFunc handleIgnorable :: DirectiveFunc
handleIgnorable _ _ = return (return, id) handleIgnorable _ _ = return return
-- | Handle a directive that should have been removed as part of handling an -- | Handle a directive that should have been removed as part of handling an
-- earlier directive. -- earlier directive.
@ -165,8 +172,7 @@ handleUnmatched m _ = dieP m "Unmatched #ELSE/#ENDIF"
-- | Handle the @#INCLUDE@ directive. -- | Handle the @#INCLUDE@ directive.
handleInclude :: DirectiveFunc handleInclude :: DirectiveFunc
handleInclude m [incName] handleInclude m [incName]
= do toks <- preprocessFile m incName = return (\ts -> return $ (m, IncludeFile incName) : ts)
return (return, \ts -> toks ++ ts)
-- | Handle the @#USE@ directive. -- | Handle the @#USE@ directive.
-- This is a bit of a hack at the moment, since it just includes the file -- This is a bit of a hack at the moment, since it just includes the file
@ -177,7 +183,7 @@ handleUse m [modName]
cs <- get cs <- get
put $ cs { csUsedFiles = Set.insert incName (csUsedFiles cs) } put $ cs { csUsedFiles = Set.insert incName (csUsedFiles cs) }
if Set.member incName (csUsedFiles cs) if Set.member incName (csUsedFiles cs)
then return (return, id) then return return
else handleInclude m [incName] else handleInclude m [incName]
where where
-- | If a module name doesn't already have a suffix, add one. -- | If a module name doesn't already have a suffix, add one.
@ -195,41 +201,41 @@ handleDefine m [definition]
when (Map.member var $ csDefinitions st) $ when (Map.member var $ csDefinitions st) $
dieP m $ "Preprocessor symbol is already defined: " ++ var dieP m $ "Preprocessor symbol is already defined: " ++ var
put $ st { csDefinitions = Map.insert var value $ csDefinitions st } put $ st { csDefinitions = Map.insert var value $ csDefinitions st }
return (return, id) return return
-- | Handle the @#UNDEF@ directive. -- | Handle the @#UNDEF@ directive.
handleUndef :: DirectiveFunc handleUndef :: DirectiveFunc
handleUndef m [var] handleUndef m [var]
= do modify $ \st -> st { csDefinitions = Map.delete var $ csDefinitions st } = do modify $ \st -> st { csDefinitions = Map.delete var $ csDefinitions st }
return (return, id) return return
-- | Handle the @#IF@ directive. -- | Handle the @#IF@ directive.
handleIf :: DirectiveFunc handleIf :: DirectiveFunc
handleIf m [condition] handleIf m [condition]
= do b <- runPreprocParser m expression condition = do b <- runPreprocParser m expression condition
return (skipCondition b 0, id) return $ skipCondition b 0
where where
skipCondition :: Bool -> Int -> [Token] -> PassM [Token] skipCondition :: Bool -> Int -> [Token] -> PassM [Token]
skipCondition _ _ [] = dieP m "Couldn't find a matching #ENDIF" skipCondition _ _ [] = dieP m "Couldn't find a matching #ENDIF"
-- At level 0, we flip state on ELSE and finish on ENDIF. -- At level 0, we flip state on ELSE and finish on ENDIF.
skipCondition b 0 (t1@(_, TokPreprocessor pp) : t2@(_, EndOfLine) : ts) skipCondition b 0 (t@(_, TokPreprocessor pp):ts)
| "#IF" `isPrefixOf` pp = skipCondition b 1 ts >>* (\ts -> t1 : t2 : ts) | "#IF" `isPrefixOf` pp = skipCondition b 1 ts >>* (t :)
| "#ELSE" `isPrefixOf` pp = skipCondition (not b) 0 ts | "#ELSE" `isPrefixOf` pp = skipCondition (not b) 0 ts
| "#ENDIF" `isPrefixOf` pp = return ts | "#ENDIF" `isPrefixOf` pp = return ts
| otherwise = copyThrough b 0 ((t1 :) . (t2 :)) ts | otherwise = copyThrough b 0 t ts
-- At higher levels, we just count up and down on IF and ENDIF. -- At higher levels, we just count up and down on IF and ENDIF.
skipCondition b n (t1@(_, TokPreprocessor pp) : t2@(_, EndOfLine) : ts) skipCondition b n (t@(_, TokPreprocessor pp):ts)
| "#IF" `isPrefixOf` pp = skipCondition b (n + 1) ts >>* (\ts -> t1 : t2 : ts) | "#IF" `isPrefixOf` pp = skipCondition b (n + 1) ts >>* (t :)
| "#ENDIF" `isPrefixOf` pp = skipCondition b (n - 1) ts >>* (\ts -> t1 : t2 : ts) | "#ENDIF" `isPrefixOf` pp = skipCondition b (n - 1) ts >>* (t :)
| otherwise = copyThrough b n ((t1 :) . (t2 :)) ts | otherwise = copyThrough b n t ts
-- And otherwise we copy through tokens if the condition's true. -- And otherwise we copy through tokens if the condition's true.
skipCondition b n (t:ts) = copyThrough b n (t :) ts skipCondition b n (t:ts) = copyThrough b n t ts
copyThrough :: Bool -> Int -> ([Token] -> [Token]) -> [Token] -> PassM [Token] copyThrough :: Bool -> Int -> Token -> [Token] -> PassM [Token]
copyThrough True n f ts = skipCondition True n ts >>* f copyThrough True n t ts = skipCondition True n ts >>* (t :)
copyThrough False n _ ts = skipCondition False n ts copyThrough False n _ ts = skipCondition False n ts
--}}} --}}}

141
frontends/PreprocessOccamTest.hs
View File

@ -36,9 +36,9 @@ testPP n itts etts = TestCase $ testPass ("testPP " ++ show n) (makeTokens etts)
-- | Test a preprocessor condition string after a series of tokens. -- | Test a preprocessor condition string after a series of tokens.
testPPCondAfter :: Int -> [TokenType] -> String -> Bool -> Test testPPCondAfter :: Int -> [TokenType] -> String -> Bool -> Test
testPPCondAfter n tts condition exp testPPCondAfter n tts condition exp
= testPP n (tts ++ [TokPreprocessor $ "#IF " ++ condition, EndOfLine, = testPP n (tts ++ [TokPreprocessor $ "#IF " ++ condition,
TokIdentifier "abc", TokIdentifier "abc",
TokPreprocessor $ "#ENDIF", EndOfLine]) TokPreprocessor $ "#ENDIF"])
(if exp then [TokIdentifier "abc"] else []) (if exp then [TokIdentifier "abc"] else [])
-- | Test a preprocessor condition string. -- | Test a preprocessor condition string.
@ -52,54 +52,67 @@ testPPFail n itts = TestCase $ testPassShouldFail ("testPPFail " ++ show n) pass
makeTokens = zip (repeat emptyMeta) makeTokens = zip (repeat emptyMeta)
pass = preprocessOccam (makeTokens itts) pass = preprocessOccam (makeTokens itts)
-- | Test 'expandIncludes' when we're expecting it to succeed.
testEI :: Int -> [TokenType] -> [TokenType] -> Test
testEI n itts etts = TestCase $ testPass ("testEI " ++ show n) (makeTokens etts) pass (return ())
where
makeTokens = zip (repeat emptyMeta)
pass = expandIncludes (makeTokens itts)
-- | Test 'expandIncludes' when we're expecting it to fail.
testEIFail :: Int -> [TokenType] -> Test
testEIFail n itts = TestCase $ testPassShouldFail ("testEIFail " ++ show n) pass (return ())
where
makeTokens = zip (repeat emptyMeta)
pass = expandIncludes (makeTokens itts)
--{{{ 0xxx simple stuff --{{{ 0xxx simple stuff
testSimple :: Test testSimple :: Test
testSimple = TestLabel "testSimple" $ TestList testSimple = TestLabel "testSimple" $ TestList
[ testPP 0 [] [] [ testPP 0 [] []
, testPP 10 [tp "#COMMENT blah", eol] [] , testPP 10 [tp "#COMMENT blah"] []
, testPP 20 arbitrary arbitrary , testPP 20 arbitrary arbitrary
, testPPFail 900 [tp "#INCLUDE \"this-should-not-exist.inc\"", eol] , testPP 30 [tp "#INCLUDE \"foo\""] [IncludeFile "foo"]
] ]
where where
tp = TokPreprocessor tp = TokPreprocessor
eol = EndOfLine
arbitrary = [Indent, Outdent, EndOfLine, TokReserved "blah", TokIdentifier "bleh"] arbitrary = [Indent, Outdent, EndOfLine, TokReserved "blah", TokIdentifier "bleh"]
--}}} --}}}
--{{{ 1xxx #IF/#ELSE/#ENDIF --{{{ 1xxx #IF/#ELSE/#ENDIF
testIf :: Test testIf :: Test
testIf = TestLabel "testIf" $ TestList testIf = TestLabel "testIf" $ TestList
-- Simple conditionals -- Simple conditionals
[ testPP 1000 [tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol] [ti "abc"] [ testPP 1000 [tp "#IF TRUE", ti "abc", tp "#ENDIF"] [ti "abc"]
, testPP 1010 [tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol] [] , testPP 1010 [tp "#IF FALSE", ti "abc", tp "#ENDIF"] []
, testPP 1020 [tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol] [ti "abc"] , testPP 1020 [tp "#IF TRUE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF"] [ti "abc"]
, testPP 1030 [tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol] [ti "def"] , testPP 1030 [tp "#IF FALSE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF"] [ti "def"]
, testPP 1040 [tp "#IF FALSE", eol, tp "#INCLUDE \"does-not-exist.inc\"", eol, tp "#ENDIF", eol] [] , testPP 1040 [tp "#IF FALSE", tp "#INCLUDE \"does-not-exist.inc\"", tp "#ENDIF"] []
-- Nested conditionals -- Nested conditionals
, testPP 1100 [tp "#IF FALSE", eol, tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [] , testPP 1100 [tp "#IF FALSE", tp "#IF FALSE", ti "abc", tp "#ENDIF", tp "#ENDIF"] []
, testPP 1110 [tp "#IF FALSE", eol, tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [] , testPP 1110 [tp "#IF FALSE", tp "#IF TRUE", ti "abc", tp "#ENDIF", tp "#ENDIF"] []
, testPP 1120 [tp "#IF TRUE", eol, tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [] , testPP 1120 [tp "#IF TRUE", tp "#IF FALSE", ti "abc", tp "#ENDIF", tp "#ENDIF"] []
, testPP 1130 [tp "#IF TRUE", eol, tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [ti "abc"] , testPP 1130 [tp "#IF TRUE", tp "#IF TRUE", ti "abc", tp "#ENDIF", tp "#ENDIF"] [ti "abc"]
, testPP 1140 [tp "#IF FALSE", eol, , testPP 1140 [tp "#IF FALSE",
tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol, tp "#IF FALSE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF",
tp "#ELSE", eol, tp "#ELSE",
ti "ghi", ti "ghi",
tp "#ENDIF", eol] [ti "ghi"] tp "#ENDIF"] [ti "ghi"]
, testPP 1150 [tp "#IF FALSE", eol, , testPP 1150 [tp "#IF FALSE",
tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol, tp "#IF TRUE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF",
tp "#ELSE", eol, tp "#ELSE",
ti "ghi", ti "ghi",
tp "#ENDIF", eol] [ti "ghi"] tp "#ENDIF"] [ti "ghi"]
, testPP 1160 [tp "#IF TRUE", eol, , testPP 1160 [tp "#IF TRUE",
tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol, tp "#IF FALSE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF",
tp "#ELSE", eol, tp "#ELSE",
ti "ghi", ti "ghi",
tp "#ENDIF", eol] [ti "def"] tp "#ENDIF"] [ti "def"]
, testPP 1170 [tp "#IF TRUE", eol, , testPP 1170 [tp "#IF TRUE",
tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol, tp "#IF TRUE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF",
tp "#ELSE", eol, tp "#ELSE",
ti "ghi", ti "ghi",
tp "#ENDIF", eol] [ti "abc"] tp "#ENDIF"] [ti "abc"]
-- Expressions -- Expressions
, testPPCond 1200 "FALSE AND FALSE" False , testPPCond 1200 "FALSE AND FALSE" False
@ -128,57 +141,56 @@ testIf = TestLabel "testIf" $ TestList
, testPPCond 1430 "((3 > 4) OR (42 = 24)) AND (1 <= 2)" False , testPPCond 1430 "((3 > 4) OR (42 = 24)) AND (1 <= 2)" False
-- Invalid conditionals -- Invalid conditionals
, testPPFail 1900 [tp "#IF you can keep your head when all about you...", eol] , testPPFail 1900 [tp "#IF you can keep your head when all about you..."]
, testPPFail 1910 [tp "#IF TRUE", eol] , testPPFail 1910 [tp "#IF TRUE"]
, testPPFail 1920 [tp "#IF TRUE love comes but once in a lifetime...", eol] , testPPFail 1920 [tp "#IF TRUE love comes but once in a lifetime..."]
, testPPFail 1930 [tp "#IF TRUE", eol, tp "#IF FALSE", eol, tp "#ENDIF", eol] , testPPFail 1930 [tp "#IF TRUE", tp "#IF FALSE", tp "#ENDIF"]
, testPPFail 1940 [tp "#IF (TRUE", eol, tp "#ENDIF", eol] , testPPFail 1940 [tp "#IF (TRUE", tp "#ENDIF"]
, testPPFail 1950 [tp "#ELSE", eol] , testPPFail 1950 [tp "#ELSE"]
, testPPFail 1960 [tp "#ENDIF", eol] , testPPFail 1960 [tp "#ENDIF"]
, testPPFail 1970 [tp "#IF 3 = \"foo\"", eol, tp "#ENDIF", eol] , testPPFail 1970 [tp "#IF 3 = \"foo\"", tp "#ENDIF"]
, testPPFail 1980 [tp "#IF \"foo\" > \"bar\"", eol, tp "#ENDIF", eol] , testPPFail 1980 [tp "#IF \"foo\" > \"bar\"", tp "#ENDIF"]
] ]
where where
ti = TokIdentifier ti = TokIdentifier
tp = TokPreprocessor tp = TokPreprocessor
eol = EndOfLine
--}}} --}}}
--{{{ 2xxx #DEFINE/#UNDEF/## --{{{ 2xxx #DEFINE/#UNDEF/##
testDefine :: Test testDefine :: Test
testDefine = TestLabel "testDefine" $ TestList testDefine = TestLabel "testDefine" $ TestList
-- Basic defining -- Basic defining
[ testPP 2000 [tp "#DEFINE FOO", eol] [] [ testPP 2000 [tp "#DEFINE FOO"] []
, testPP 2010 [tp "#DEFINE FOO \"bar\"", eol] [] , testPP 2010 [tp "#DEFINE FOO \"bar\""] []
, testPP 2020 [tp "#DEFINE FOO 42", eol] [] , testPP 2020 [tp "#DEFINE FOO 42"] []
, testPP 2030 [tp "#UNDEF BAR", eol] [] , testPP 2030 [tp "#UNDEF BAR"] []
, testPP 2040 [tp "#DEFINE FOO", eol, tp "#UNDEF FOO", eol] [] , testPP 2040 [tp "#DEFINE FOO", tp "#UNDEF FOO"] []
-- DEFINED -- DEFINED
, testPPCondAfter 2100 [tp "#DEFINE FOO", eol] "DEFINED (FOO)" True , testPPCondAfter 2100 [tp "#DEFINE FOO"] "DEFINED (FOO)" True
, testPPCondAfter 2110 [tp "#UNDEF FOO", eol] "DEFINED (FOO)" False , testPPCondAfter 2110 [tp "#UNDEF FOO"] "DEFINED (FOO)" False
, testPPCondAfter 2120 [tp "#DEFINE FOO", eol, tp "#UNDEF FOO", eol] , testPPCondAfter 2120 [tp "#DEFINE FOO", tp "#UNDEF FOO"]
"DEFINED (FOO)" False "DEFINED (FOO)" False
, testPPCondAfter 2130 [tp "#UNDEF FOO", eol, tp "#DEFINE FOO", eol] , testPPCondAfter 2130 [tp "#UNDEF FOO", tp "#DEFINE FOO"]
"DEFINED (FOO)" True "DEFINED (FOO)" True
, testPPCond 2140 "DEFINED (COMPILER.TOCK)" True , testPPCond 2140 "DEFINED (COMPILER.TOCK)" True
, testPPCond 2150 "NOT DEFINED (COMPILER.TOCK)" False , testPPCond 2150 "NOT DEFINED (COMPILER.TOCK)" False
-- Conditions involving macros -- Conditions involving macros
, testPPCondAfter 2200 [tp "#DEFINE FOO 42", eol] "FOO = 42" True , testPPCondAfter 2200 [tp "#DEFINE FOO 42"] "FOO = 42" True
, testPPCondAfter 2210 [tp "#DEFINE FOO 42", eol] "FOO <> 42" False , testPPCondAfter 2210 [tp "#DEFINE FOO 42"] "FOO <> 42" False
, testPPCondAfter 2220 [tp "#DEFINE FOO \"bar\"", eol] "FOO = \"bar\"" True , testPPCondAfter 2220 [tp "#DEFINE FOO \"bar\""] "FOO = \"bar\"" True
, testPPCondAfter 2230 [tp "#DEFINE FOO \"baz\"", eol] "FOO = \"bar\"" False , testPPCondAfter 2230 [tp "#DEFINE FOO \"baz\""] "FOO = \"bar\"" False
-- Expansion -- Expansion
, testPP 2600 [tp "#DEFINE FOO \"bar\"", eol, hh, ti "FOO"] [TokStringLiteral "bar"] , testPP 2600 [tp "#DEFINE FOO \"bar\"", hh, ti "FOO"] [TokStringLiteral "bar"]
, testPP 2610 [tp "#DEFINE FOO 1234", eol, hh, ti "FOO"] [TokIntLiteral "1234"] , testPP 2610 [tp "#DEFINE FOO 1234", hh, ti "FOO"] [TokIntLiteral "1234"]
-- Invalid definitions -- Invalid definitions
, testPPFail 2900 [tp "#DEFINE FOO", eol, tp "#DEFINE FOO", eol] , testPPFail 2900 [tp "#DEFINE FOO", tp "#DEFINE FOO"]
, testPPFail 2910 [tp "#DEFINE FOO !!*!%*!", eol] , testPPFail 2910 [tp "#DEFINE FOO !!*!%*!"]
-- Invalid expansions -- Invalid expansions
, testPPFail 2950 [tp "#DEFINE FOO", eol, hh, ti "FOO"] , testPPFail 2950 [tp "#DEFINE FOO", hh, ti "FOO"]
, testPPFail 2960 [hh, ti "FOO"] , testPPFail 2960 [hh, ti "FOO"]
, testPPFail 2970 [hh, hh] , testPPFail 2970 [hh, hh]
] ]
@ -186,7 +198,17 @@ testDefine = TestLabel "testDefine" $ TestList
tp = TokPreprocessor tp = TokPreprocessor
ti = TokIdentifier ti = TokIdentifier
hh = TokReserved "##" hh = TokReserved "##"
eol = EndOfLine --}}}
--{{{ 3xxx expandIncludes
testExpand :: Test
testExpand = TestLabel "testExpand" $ TestList
[ testEI 3000 [] []
, testEI 3010 arbitrary arbitrary
, testEIFail 3900 [IncludeFile "this-does-not-exist", EndOfLine]
]
where
arbitrary = [Indent, Outdent, EndOfLine, TokReserved "blah", TokIdentifier "bleh"]
--}}} --}}}
tests :: Test tests :: Test
@ -194,4 +216,5 @@ tests = TestLabel "PreprocessOccamTest" $ TestList
[ testSimple [ testSimple
, testIf , testIf
, testDefine , testDefine
, testExpand
] ]

7
frontends/StructureOccam.hs
View File

@ -49,10 +49,11 @@ structureOccam ts = analyse 1 firstLine ts (emptyMeta, EndOfLine)
analyse prevCol _ [] _ = return $ (emptyMeta, EndOfLine) : out analyse prevCol _ [] _ = return $ (emptyMeta, EndOfLine) : out
where out = replicate (prevCol `div` 2) (emptyMeta, Outdent) where out = replicate (prevCol `div` 2) (emptyMeta, Outdent)
analyse prevCol prevLine (t@(m, tokType):ts) prevTok analyse prevCol prevLine (t@(m, tokType):ts) prevTok
= if (line /= prevLine) && (not isContinuation) | line /= prevLine && not isContinuation
then do rest <- analyse col line ts t = do rest <- analyse col line ts t
newLine $ t : rest newLine $ t : rest
else do rest <- analyse prevCol line ts t | otherwise
= do rest <- analyse prevCol line ts t
return $ t : rest return $ t : rest
where where
col = metaColumn m col = metaColumn m

4
frontends/StructureOccamTest.hs
View File

@ -51,6 +51,10 @@ testSimple = TestLabel "testSimple" $ TestList
, testS 50 [(m 1 1, foo), (m 2 3, foo), (m 3 3, foo), (m 4 3, foo)] , testS 50 [(m 1 1, foo), (m 2 3, foo), (m 3 3, foo), (m 4 3, foo)]
[fooP, eolP, inP, fooP, eolP, fooP, eolP, fooP, eolP, outP] [fooP, eolP, inP, fooP, eolP, fooP, eolP, fooP, eolP, outP]
-- Ignoring include markers
, testS 100 [(m 1 1, IncludeFile "bar"), (m 2 1, foo)]
[tag1 IncludeFile "bar", eolP, fooP, eolP]
-- Things that should fail -- Things that should fail
, testSFail 900 [(m 1 1, foo), (m 2 2, foo)] , testSFail 900 [(m 1 1, foo), (m 2 2, foo)]
, testSFail 910 [(m 1 1, foo), (m 2 5, foo)] , testSFail 910 [(m 1 1, foo), (m 2 5, foo)]