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

Modified the lexer and parser to be able to parse PRAGMA EXTERNAL (and added #DEFINE support in the lexer)

Browse Source
This commit is contained in:
Neil Brown 2009-03-25 16:36:59 +00:00
parent 45b22472c3
commit 7cbe98d200
2 changed files with 38 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
frontends/LexOccam.x
View File

@ -36,7 +36,7 @@ $horizSpace = [\ \t]
$vertSpace = [\r\n]
@directive = "COMMENT" | "ELSE" | "ENDIF" | "IF" | "INCLUDE"
| "OPTION" | "PRAGMA" | "RELAX" | "USE"
| "OPTION" | "RELAX" | "USE" | "DEFINE"
@preprocessor = "#" @directive [^\n]*
@ -99,9 +99,15 @@ occam :-
-- In state one, we're reading the first thing on a line.
-- In state two, we're reading the rest of the line.
-- In state three, we're in the middle of a multi-line string.
-- In state four, we're in the middle of a pragma-external string
<0> $horizSpace* { mkState one }
<one> "#PRAGMA" $horizSpace+ "SHARED" { mkToken TokPreprocessor two }
<one> "#PRAGMA" $horizSpace+ "PERMITALIASES" { mkToken TokPreprocessor two }
<one> "#PRAGMA" $horizSpace+ "EXTERNAL" $horizSpace* \" { mkToken TokPreprocessor four }
<four> \" $horizSpace* $vertSpace+ { mkState 0 }
<one> @preprocessor { mkToken TokPreprocessor 0 }
<one, two> "--" [^\n]* { mkState 0 }
<one, two> $vertSpace+ { mkState 0 }
@ -109,6 +115,9 @@ occam :-
<one, two> @reserved { mkToken TokReserved two }
<one, two> @identifier { mkToken TokIdentifier two }
<four> @reserved { mkToken TokReserved four }
<four> @identifier { mkToken TokIdentifier four }
<one, two> @charLiteral { mkToken TokCharLiteral two }
<one, two> @fullString { mkToken TokStringLiteral two }
<one, two> @startString { mkToken TokStringCont three }
@ -121,7 +130,11 @@ occam :-
<one, two> @hexLiteral { mkToken TokHexLiteral two }
<one, two> @realLiteral { mkToken TokRealLiteral two }
<two> $horizSpace+ { mkState two }
<four> @intLiteral { mkToken TokIntLiteral four }
<four> @hexLiteral { mkToken TokHexLiteral four }
<four> @realLiteral { mkToken TokRealLiteral four }
<two, four> $horizSpace+ ;
{
-- | An occam source token and its position.

41
frontends/ParseOccam.hs
View File

@ -1347,8 +1347,11 @@ pragma :: OccParser ()
pragma = do Pragma p <- genToken isPragma
m <- getPosition >>* sourcePosToMeta
case map (flip matchRegex p . mkRegex)
["^SHARED +(.*)", "^PERMITALIASES +(.*)"] of
[Just [varsRaw], _] ->
[ "^SHARED.*"
, "^PERMITALIASES.*"
, "^EXTERNAL.*"] of
[Just _, _, _] -> do
vars <- sepBy1 identifier sComma
mapM_ (\var ->
do st <- get
A.Name _ n <- case lookup var (csLocalNames st) of
@ -1356,8 +1359,9 @@ pragma = do Pragma p <- genToken isPragma
Just def -> return $ fst def
modify $ \st -> st {csNameAttr = Map.insertWith Set.union
n (Set.singleton NameShared) (csNameAttr st)})
(processVarList varsRaw)
[Nothing, Just [varsRaw]] ->
vars
[Nothing, Just _, _] -> do
vars <- sepBy1 identifier sComma
mapM_ (\var ->
do st <- get
A.Name _ n <- case lookup var (csLocalNames st) of
@ -1365,24 +1369,25 @@ pragma = do Pragma p <- genToken isPragma
Just def -> return $ fst def
modify $ \st -> st {csNameAttr = Map.insertWith Set.union
n (Set.singleton NameAliasesPermitted) (csNameAttr st)})
(processVarList varsRaw)
vars
[Nothing, Nothing, Just _] -> do
m <- md
sPROC
n <- newProcName
fs <- formalList >>* map fst
sEq
integer
let on = A.nameName n
sp = A.Proc m (A.PlainSpec, A.PlainRec) fs (A.Skip m)
nd = A.NameDef m on on sp A.Original A.NamePredefined A.Unplaced
modify $ \st -> st
{ csNames = Map.insert on nd (csNames st)
, csLocalNames = (on, (n, ProcName)) : csLocalNames st
}
_ -> warnP m WarnUnknownPreprocessorDirective $
"Unknown PRAGMA: " ++ p
eol
where
processVarList raw = map chopBoth $
splitRegex (mkRegex ",") $ if "--" `isInfixOf` raw
then chopComment [] raw
else raw
chopComment prev ('-':'-':_) = prev
chopComment prev (x:xs) = chopComment (prev++[x]) xs
chopComment prev [] = prev
chopBoth = chopLeadingSpaces . chopTrailingSpaces
chopLeadingSpaces = dropWhile (`elem` " \t")
chopTrailingSpaces = reverse . dropWhile (`elem` " \t") . reverse
isPragma (Token _ p@(Pragma {})) = Just p
isPragma _ = Nothing
--}}}