From 8f2575819bac3438b717baa2b2a7995bd04f7b32 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Thu, 28 Feb 2008 20:27:30 +0000 Subject: [PATCH] Initial implementation of the occam-pi preprocessor. This implements #DEFINE, #UNDEF, #IF, #ELSE and #ENDIF, macro expansion with ##, and TRUE, FALSE, AND, OR, NOT and DEFINED within #IF expressions, with the same semantics as occ21. The macro COMPILER.TOCK is always defined by default, so you can now say things like "#IF NOT DEFINED (COMPILER.TOCK) ... #ENDIF". --- Makefile.am | 1 + TestMain.hs | 2 + common/PrettyShow.hs | 1 + data/CompState.hs | 14 ++- frontends/LexOccam.x | 1 + frontends/PreprocessOccam.hs | 173 +++++++++++++++++++++++++++--- frontends/PreprocessOccamTest.hs | 176 +++++++++++++++++++++++++++++++ 7 files changed, 354 insertions(+), 14 deletions(-) create mode 100644 frontends/PreprocessOccamTest.hs diff --git a/Makefile.am b/Makefile.am index 954558a..6008835 100644 --- a/Makefile.am +++ b/Makefile.am @@ -152,6 +152,7 @@ tocktest_SOURCES += common/TestHarness.hs tocktest_SOURCES += common/TestUtils.hs tocktest_SOURCES += flow/FlowGraphTest.hs tocktest_SOURCES += frontends/ParseRainTest.hs +tocktest_SOURCES += frontends/PreprocessOccamTest.hs tocktest_SOURCES += frontends/RainPassesTest.hs tocktest_SOURCES += frontends/RainTypesTest.hs tocktest_SOURCES += transformations/PassTest.hs diff --git a/TestMain.hs b/TestMain.hs index 1972c82..1707853 100644 --- a/TestMain.hs +++ b/TestMain.hs @@ -52,6 +52,7 @@ import qualified FlowGraphTest (qcTests) import qualified GenerateCTest (tests) import qualified ParseRainTest (tests) import qualified PassTest (tests) +import qualified PreprocessOccamTest (tests) import qualified RainPassesTest (tests) import qualified RainTypesTest (tests) import qualified UsageCheckTest (tests) @@ -127,6 +128,7 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options ,noqc GenerateCTest.tests ,noqc ParseRainTest.tests ,noqc PassTest.tests + ,noqc PreprocessOccamTest.tests ,noqc RainPassesTest.tests ,noqc RainTypesTest.tests ,noqc UsageCheckTest.tests diff --git a/common/PrettyShow.hs b/common/PrettyShow.hs index ec9f5b5..805f787 100644 --- a/common/PrettyShow.hs +++ b/common/PrettyShow.hs @@ -137,6 +137,7 @@ doPattern p@(Match c ps) = doAny :: (forall a. Data a => (a -> Doc) -> (a -> Doc)) -> GenericQ Doc doAny extFunc = extFunc ( (doGeneral anyFunc) `ext1Q` (doList anyFunc) `extQ` doString `extQ` doMeta `extQ` doPattern + `extQ` (doMap anyFunc :: Map.Map String PreprocDef -> Doc) `extQ` (doMap anyFunc :: Map.Map String String -> Doc) `extQ` (doMap anyFunc :: Map.Map String A.NameDef -> Doc) `extQ` (doMap anyFunc :: Map.Map String [A.Type] -> Doc) diff --git a/data/CompState.hs b/data/CompState.hs index ed255d0..2a1da4b 100644 --- a/data/CompState.hs +++ b/data/CompState.hs @@ -46,6 +46,16 @@ data CompBackend = BackendC | BackendCPPCSP | BackendDumpAST data CompFrontend = FrontendOccam | FrontendRain deriving (Show, Data, Typeable, Eq) +-- | Preprocessor definitions. +data PreprocDef = + PreprocNothing + | PreprocInt String + | PreprocString String + deriving (Show, Data, Typeable, Eq) + +-- | An item that has been pulled up. +type PulledItem = (Meta, Either A.Specification A.Process) -- Either Spec or ProcThen + -- | State necessary for compilation. data CompState = CompState { -- This structure needs to be printable with pshow. @@ -66,6 +76,7 @@ data CompState = CompState { -- Set by preprocessor csCurrentFile :: String, csUsedFiles :: Set String, + csDefinitions :: Map String PreprocDef, -- Set by Parse csLocalNames :: [(String, A.Name)], @@ -84,8 +95,6 @@ data CompState = CompState { } deriving (Data, Typeable) -type PulledItem = (Meta, Either A.Specification A.Process) -- Either Spec or ProcThen - emptyState :: CompState emptyState = CompState { csMode = ModeFull, @@ -99,6 +108,7 @@ emptyState = CompState { csCurrentFile = "none", csUsedFiles = Set.empty, + csDefinitions = Map.insert "COMPILER.TOCK" PreprocNothing Map.empty, csLocalNames = [], csMainLocals = [], diff --git a/frontends/LexOccam.x b/frontends/LexOccam.x index 0e1e88f..365d2f2 100644 --- a/frontends/LexOccam.x +++ b/frontends/LexOccam.x @@ -49,6 +49,7 @@ $vertSpace = [\r\n] | ">=" | "<=" | "<" | ">" | "~" + | "##" | "AFTER" | "ALT" | "AND" | "ANY" | "AT" | "BITAND" | "BITNOT" | "BITOR" | "BOOL" | "BYTE" | "BYTESIN" | "CASE" | "CHAN" diff --git a/frontends/PreprocessOccam.hs b/frontends/PreprocessOccam.hs index 67bfd5d..9896ffc 100644 --- a/frontends/PreprocessOccam.hs +++ b/frontends/PreprocessOccam.hs @@ -1,6 +1,7 @@ {- Tock: a compiler for parallel languages Copyright (C) 2007 University of Kent +Copyright (C) 2008 Adam Sampson This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the @@ -17,12 +18,16 @@ with this program. If not, see . -} -- | Preprocess occam code. -module PreprocessOccam (preprocessOccamProgram, preprocessOccamSource) where +module PreprocessOccam (preprocessOccamProgram, preprocessOccamSource, preprocessOccam) where import Control.Monad.State import Data.List +import qualified Data.Map as Map import qualified Data.Set as Set import System.IO +import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec.Language (haskellDef) +import qualified Text.ParserCombinators.Parsec.Token as P import Text.Regex import CompState @@ -85,9 +90,9 @@ preprocessSource m realFilename s preprocessOccam :: [Token] -> PassM [Token] preprocessOccam [] = return [] preprocessOccam ((m, TokPreprocessor s):(_, EndOfLine):ts) - = do func <- handleDirective m (stripPrefix s) - rest <- preprocessOccam ts - return $ func rest + = do (beforeRest, afterRest) <- handleDirective m (stripPrefix s) + rest <- beforeRest ts >>= preprocessOccam + return $ afterRest rest where stripPrefix :: String -> String stripPrefix (' ':cs) = stripPrefix cs @@ -97,15 +102,28 @@ preprocessOccam ((m, TokPreprocessor s):(_, EndOfLine):ts) -- Check the above case didn't miss something. preprocessOccam ((_, TokPreprocessor _):_) = error "bad TokPreprocessor token" +preprocessOccam ((_, TokReserved "##") : (m, TokIdentifier var) : ts) + = do st <- get + case Map.lookup var (csDefinitions st) of + Just (PreprocInt num) -> toToken $ TokIntLiteral num + Just (PreprocString str) -> toToken $ TokStringLiteral str + Just (PreprocNothing) -> dieP m $ var ++ " is defined, but has no value" + Nothing -> dieP m $ var ++ " is not defined" + where + toToken tt + = do rest <- preprocessOccam ts + return $ (m, tt) : rest +preprocessOccam ((m, TokReserved "##"):_) + = dieP m "Invalid macro expansion syntax" preprocessOccam (t:ts) = do rest <- preprocessOccam ts return $ t : rest --{{{ preprocessor directive handlers -type DirectiveFunc = Meta -> [String] -> PassM ([Token] -> [Token]) +type DirectiveFunc = Meta -> [String] -> PassM ([Token] -> PassM [Token], [Token] -> [Token]) -- | Call the handler for a preprocessor directive. -handleDirective :: Meta -> String -> PassM ([Token] -> [Token]) +handleDirective :: Meta -> String -> PassM ([Token] -> PassM [Token], [Token] -> [Token]) handleDirective m s = lookup s directives where -- FIXME: This should really be an error rather than a warning, but @@ -113,7 +131,7 @@ handleDirective m s = lookup s directives -- useful. lookup s [] = do addWarning m "Unknown preprocessor directive ignored" - return id + return (return, id) lookup s ((re, func):ds) = case matchRegex re s of Just fields -> func m fields @@ -124,16 +142,30 @@ handleDirective m s = lookup s directives -- that matches, then uses the corresponding function. directives :: [(Regex, DirectiveFunc)] directives = - [ (mkRegex "^INCLUDE \"(.*)\"$", handleInclude) - , (mkRegex "^USE \"(.*)\"$", handleUse) - , (mkRegex "^COMMENT .*$", (\_ _ -> return id)) + [ (mkRegex "^INCLUDE +\"(.*)\"$", handleInclude) + , (mkRegex "^USE +\"(.*)\"$", handleUse) + , (mkRegex "^COMMENT +.*$", handleIgnorable) + , (mkRegex "^DEFINE +(.*)$", handleDefine) + , (mkRegex "^UNDEF +([^ ]+)$", handleUndef) + , (mkRegex "^IF +(.*)$", handleIf) + , (mkRegex "^ELSE", handleUnmatched) + , (mkRegex "^ENDIF", handleUnmatched) ] +-- | Handle a directive that can be ignored. +handleIgnorable :: DirectiveFunc +handleIgnorable _ _ = return (return, id) + +-- | Handle a directive that should have been removed as part of handling an +-- earlier directive. +handleUnmatched :: DirectiveFunc +handleUnmatched m _ = dieP m "Unmatched #ELSE/#ENDIF" + -- | Handle the @#INCLUDE@ directive. handleInclude :: DirectiveFunc handleInclude m [incName] = do toks <- preprocessFile m incName - return (\ts -> toks ++ ts) + return (return, \ts -> toks ++ ts) -- | Handle the @#USE@ directive. -- This is a bit of a hack at the moment, since it just includes the file @@ -144,7 +176,7 @@ handleUse m [modName] cs <- get put $ cs { csUsedFiles = Set.insert incName (csUsedFiles cs) } if Set.member incName (csUsedFiles cs) - then return id + then return (return, id) else handleInclude m [incName] where -- | If a module name doesn't already have a suffix, add one. @@ -153,6 +185,123 @@ handleUse m [modName] = if ".occ" `isSuffixOf` mod || ".inc" `isSuffixOf` mod then mod else mod ++ ".occ" + +-- | Handle the @#DEFINE@ directive. +handleDefine :: DirectiveFunc +handleDefine m [definition] + = do (var, value) <- lookup definition definitionTypes + st <- get + when (Map.member var $ csDefinitions st) $ + dieP m $ "Preprocessor symbol is already defined: " ++ var + put $ st { csDefinitions = Map.insert var value $ csDefinitions st } + return (return, id) + where + definitionTypes :: [(Regex, [String] -> (String, PreprocDef))] + definitionTypes = + [ (mkRegex "^([^ ]+)$", (\[name] -> (name, PreprocNothing))) + , (mkRegex "^([^ ]+) +([0-9]+)$", (\[name, num] -> (name, PreprocInt num))) + , (mkRegex "^([^ ]+) \"(.*)\"$", (\[name, str] -> (name, PreprocString str))) + ] + + lookup s [] = dieP m "Invalid definition syntax" + lookup s ((re, func):ds) + = case matchRegex re s of + Just fields -> return $ func fields + Nothing -> lookup s ds + +-- | Handle the @#UNDEF@ directive. +handleUndef :: DirectiveFunc +handleUndef m [var] + = do modify $ \st -> st { csDefinitions = Map.delete var $ csDefinitions st } + return (return, id) + +-- | Handle the @#IF@ directive. +handleIf :: DirectiveFunc +handleIf m [condition] + = do b <- evalExpression m condition + return (skipCondition b 0, id) + where + skipCondition :: Bool -> Int -> [Token] -> PassM [Token] + skipCondition _ _ [] = dieP m "Couldn't find a matching #ENDIF" + + -- At level 0, we flip state on ELSE and finish on ENDIF. + skipCondition b 0 (t1@(_, TokPreprocessor pp) : t2@(_, EndOfLine) : ts) + | "#IF" `isPrefixOf` pp = skipCondition b 1 ts >>* (\ts -> t1 : t2 : ts) + | "#ELSE" `isPrefixOf` pp = skipCondition (not b) 0 ts + | "#ENDIF" `isPrefixOf` pp = return ts + | otherwise = copyThrough b 0 ((t1 :) . (t2 :)) ts + + -- At higher levels, we just count up and down on IF and ENDIF. + skipCondition b n (t1@(_, TokPreprocessor pp) : t2@(_, EndOfLine) : ts) + | "#IF" `isPrefixOf` pp = skipCondition b (n + 1) ts >>* (\ts -> t1 : t2 : ts) + | "#ENDIF" `isPrefixOf` pp = skipCondition b (n - 1) ts >>* (\ts -> t1 : t2 : ts) + | otherwise = copyThrough b n ((t1 :) . (t2 :)) ts + + -- And otherwise we copy through tokens if the condition's true. + skipCondition b n (t:ts) = copyThrough b n (t :) ts + + copyThrough :: Bool -> Int -> ([Token] -> [Token]) -> [Token] -> PassM [Token] + copyThrough True n f ts = skipCondition True n ts >>* f + copyThrough False n _ ts = skipCondition False n ts +--}}} + +--{{{ parser for preprocessor expressions +type PreprocParser = GenParser Char (Map.Map String PreprocDef) + +--{{{ lexer +ppLexer :: P.TokenParser (Map.Map String PreprocDef) +ppLexer = P.makeTokenParser (haskellDef + { P.identStart = letter <|> digit + , P.identLetter = letter <|> digit <|> char '.' + }) + +parens :: PreprocParser a -> PreprocParser a +parens = P.parens ppLexer + +symbol :: String -> PreprocParser String +symbol = P.symbol ppLexer +--}}} + +tryVX :: PreprocParser a -> PreprocParser b -> PreprocParser a +tryVX a b = try (do { av <- a; b; return av }) + +defined :: PreprocParser Bool +defined + = do symbol "DEFINED" + i <- parens $ P.identifier ppLexer + definitions <- getState + return $ Map.member i definitions + +operand :: PreprocParser Bool +operand + = do { try $ symbol "NOT"; e <- expression; return $ not e } + <|> do { try $ symbol "TRUE"; return True } + <|> do { try $ symbol "FALSE"; return False } + <|> defined + <|> parens expression + "preprocessor operand" + +expression :: PreprocParser Bool +expression + = do { l <- tryVX operand (symbol "AND"); r <- operand; return $ l && r } + <|> do { l <- tryVX operand (symbol "OR"); r <- operand; return $ l || r } + <|> operand + "preprocessor expression" + +fullExpression :: PreprocParser Bool +fullExpression + = do P.whiteSpace ppLexer + e <- expression + eof + return e + +-- | Evaluate a preprocessor expression. +evalExpression :: Meta -> String -> PassM Bool +evalExpression m s + = do st <- get + case runParser fullExpression (csDefinitions st) (show m) s of + Left err -> dieP m $ "Error parsing expression: " ++ show err + Right b -> return b --}}} -- | Load and preprocess an occam program. diff --git a/frontends/PreprocessOccamTest.hs b/frontends/PreprocessOccamTest.hs new file mode 100644 index 0000000..7d55ca6 --- /dev/null +++ b/frontends/PreprocessOccamTest.hs @@ -0,0 +1,176 @@ +{- +Tock: a compiler for parallel languages +Copyright (C) 2008 Adam Sampson + +This program is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation, either version 2 of the License, or (at your +option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program. If not, see . +-} + +-- | Tests for the occam preprocessor. +module PreprocessOccamTest (tests) where + +import Test.HUnit + +import LexOccam +import Metadata +import PreprocessOccam +import TestUtils + +-- | Test 'preprocessOccam' when we're expecting it to succeed. +testPP :: Int -> [TokenType] -> [TokenType] -> Test +testPP n itts etts = TestCase $ testPass ("testPP " ++ show n) (makeTokens etts) pass (return ()) + where + makeTokens = zip (repeat emptyMeta) + pass = preprocessOccam (makeTokens itts) + +-- | Test a preprocessor condition string after a series of tokens. +testPPCondAfter :: Int -> [TokenType] -> String -> Bool -> Test +testPPCondAfter n tts condition exp + = testPP n (tts ++ [TokPreprocessor $ "#IF " ++ condition, EndOfLine, + TokIdentifier "abc", + TokPreprocessor $ "#ENDIF", EndOfLine]) + (if exp then [TokIdentifier "abc"] else []) + +-- | Test a preprocessor condition string. +testPPCond :: Int -> String -> Bool -> Test +testPPCond n = testPPCondAfter n [] + +-- | Test 'preprocessOccam' when we're expecting it to fail. +testPPFail :: Int -> [TokenType] -> Test +testPPFail n itts = TestCase $ testPassShouldFail ("testPPFail " ++ show n) pass (return ()) + where + makeTokens = zip (repeat emptyMeta) + pass = preprocessOccam (makeTokens itts) + +--{{{ 0xxx simple stuff +testSimple :: Test +testSimple = TestLabel "testSimple" $ TestList + [ testPP 0 [] [] + , testPP 10 [tp "#COMMENT blah", eol] [] + , testPP 20 arbitrary arbitrary + , testPPFail 900 [tp "#INCLUDE \"this-should-not-exist.inc\"", eol] + ] + where + tp = TokPreprocessor + eol = EndOfLine + arbitrary = [Indent, Outdent, EndOfLine, TokReserved "blah", TokIdentifier "bleh"] +--}}} +--{{{ 1xxx #IF/#ELSE/#ENDIF +testIf :: Test +testIf = TestLabel "testIf" $ TestList + -- Simple conditionals + [ testPP 1000 [tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol] [ti "abc"] + , testPP 1010 [tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol] [] + , testPP 1020 [tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol] [ti "abc"] + , testPP 1030 [tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol] [ti "def"] + , testPP 1040 [tp "#IF FALSE", eol, tp "#INCLUDE \"does-not-exist.inc\"", eol, tp "#ENDIF", eol] [] + + -- Nested conditionals + , testPP 1100 [tp "#IF FALSE", eol, tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [] + , testPP 1110 [tp "#IF FALSE", eol, tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [] + , testPP 1120 [tp "#IF TRUE", eol, tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [] + , testPP 1130 [tp "#IF TRUE", eol, tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [ti "abc"] + , testPP 1140 [tp "#IF FALSE", eol, + tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol, + tp "#ELSE", eol, + ti "ghi", + tp "#ENDIF", eol] [ti "ghi"] + , testPP 1150 [tp "#IF FALSE", eol, + tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol, + tp "#ELSE", eol, + ti "ghi", + tp "#ENDIF", eol] [ti "ghi"] + , testPP 1160 [tp "#IF TRUE", eol, + tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol, + tp "#ELSE", eol, + ti "ghi", + tp "#ENDIF", eol] [ti "def"] + , testPP 1170 [tp "#IF TRUE", eol, + tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol, + tp "#ELSE", eol, + ti "ghi", + tp "#ENDIF", eol] [ti "abc"] + + -- Expressions + , testPPCond 1200 "FALSE AND FALSE" False + , testPPCond 1210 "FALSE AND TRUE" False + , testPPCond 1220 "TRUE AND FALSE" False + , testPPCond 1230 "TRUE AND TRUE" True + , testPPCond 1240 "FALSE OR FALSE" False + , testPPCond 1250 "FALSE OR TRUE" True + , testPPCond 1260 "NOT FALSE" True + , testPPCond 1270 "NOT TRUE" False + , testPPCond 1280 "(TRUE AND FALSE) OR (FALSE AND TRUE)" False + , testPPCond 1290 "(TRUE OR FALSE) AND (FALSE OR TRUE)" True + , testPPCond 1300 "NOT (FALSE AND TRUE)" True + + -- Invalid conditionals + , testPPFail 1900 [tp "#IF you can keep your head when all about you...", eol] + , testPPFail 1910 [tp "#IF TRUE", eol] + , testPPFail 1920 [tp "#IF TRUE love comes but once in a lifetime...", eol] + , testPPFail 1930 [tp "#IF TRUE", eol, tp "#IF FALSE", eol, tp "#ENDIF", eol] + , testPPFail 1940 [tp "#IF (TRUE", eol, tp "#ENDIF", eol] + , testPPFail 1950 [tp "#ELSE", eol] + , testPPFail 1960 [tp "#ENDIF", eol] + ] + where + ti = TokIdentifier + tp = TokPreprocessor + eol = EndOfLine +--}}} +--{{{ 2xxx #DEFINE/#UNDEF/## +testDefine :: Test +testDefine = TestLabel "testDefine" $ TestList + -- Basic defining + [ testPP 2000 [tp "#DEFINE FOO", eol] [] + , testPP 2010 [tp "#DEFINE FOO \"bar\"", eol] [] + , testPP 2020 [tp "#DEFINE FOO 42", eol] [] + , testPP 2030 [tp "#UNDEF BAR", eol] [] + , testPP 2040 [tp "#DEFINE FOO", eol, tp "#UNDEF FOO", eol] [] + + -- DEFINED + , testPPCondAfter 2100 [tp "#DEFINE FOO", eol] "DEFINED (FOO)" True + , testPPCondAfter 2110 [tp "#UNDEF FOO", eol] "DEFINED (FOO)" False + , testPPCondAfter 2120 [tp "#DEFINE FOO", eol, tp "#UNDEF FOO", eol] + "DEFINED (FOO)" False + , testPPCondAfter 2130 [tp "#UNDEF FOO", eol, tp "#DEFINE FOO", eol] + "DEFINED (FOO)" True + , testPPCond 2140 "DEFINED (COMPILER.TOCK)" True + , testPPCond 2150 "NOT DEFINED (COMPILER.TOCK)" False + + -- Expansion + , testPP 2200 [tp "#DEFINE FOO \"bar\"", eol, hh, ti "FOO"] [TokStringLiteral "bar"] + , testPP 2210 [tp "#DEFINE FOO 1234", eol, hh, ti "FOO"] [TokIntLiteral "1234"] + + -- Invalid definitions + , testPPFail 2900 [tp "#DEFINE FOO", eol, tp "#DEFINE FOO", eol] + , testPPFail 2910 [tp "#DEFINE FOO !!*!%*!", eol] + + -- Invalid expansions + , testPPFail 2950 [tp "#DEFINE FOO", eol, hh, ti "FOO"] + , testPPFail 2960 [hh, ti "FOO"] + , testPPFail 2970 [hh, hh] + ] + where + tp = TokPreprocessor + ti = TokIdentifier + hh = TokReserved "##" + eol = EndOfLine +--}}} + +tests :: Test +tests = TestLabel "PreprocessOccamTest" $ TestList + [ testSimple + , testIf + , testDefine + ]