Added support for parsing pragmas, for now just handling the SHARED pragma

This commit is contained in:
Neil Brown 2009-01-19 15:11:09 +00:00
parent f612b99a49
commit 8a36f6e96f
3 changed files with 28 additions and 0 deletions

View File

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

View File

@ -22,8 +22,10 @@ module ParseOccam (parseOccamProgram) where
import Control.Monad (liftM) import Control.Monad (liftM)
import Control.Monad.State (MonadState, modify, get, put) import Control.Monad.State (MonadState, modify, get, put)
import Data.List import Data.List
import qualified Data.Map as Map
import Data.Maybe import Data.Maybe
import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec
import Text.Regex
import qualified AST as A import qualified AST as A
import CompState import CompState
@ -1246,6 +1248,26 @@ structuredTypeField
<?> "structured type field" <?> "structured type field"
--}}} --}}}
--}}} --}}}
--{{{ pragmas
pragma :: OccParser ()
pragma = do Pragma p <- genToken isPragma
m <- getPosition >>* sourcePosToMeta
case matchRegex (mkRegex "^SHARED +(.*)") p of
Just [varsRaw] ->
mapM_ (\var ->
do st <- get
A.Name _ n <- case lookup var (csLocalNames st) of
Nothing -> dieP m $ "name " ++ var ++ " not defined"
Just def -> return $ fst def
modify $ \st -> st {csNameAttr = Map.insert n NameShared (csNameAttr st)})
(splitRegex (mkRegex ",") varsRaw)
Nothing -> warnP m WarnUnknownPreprocessorDirective $
"Unknown PRAGMA: " ++ p
eol
where
isPragma (Token _ p@(Pragma {})) = Just p
isPragma _ = Nothing
--}}}
--{{{ processes --{{{ processes
process :: OccParser A.Process process :: OccParser A.Process
process process
@ -1265,6 +1287,7 @@ process
<|> intrinsicProc <|> intrinsicProc
<|> handleSpecs (allocation <|> specification) process <|> handleSpecs (allocation <|> specification) process
(\m s p -> A.Seq m (A.Spec m s (A.Only m p))) (\m s p -> A.Seq m (A.Spec m s (A.Only m p)))
<|> (pragma >> process)
<?> "process" <?> "process"
--{{{ assignment (:=) --{{{ assignment (:=)

View File

@ -161,6 +161,7 @@ directives =
, (mkRegex "^IF +(.*)$", handleIf) , (mkRegex "^IF +(.*)$", handleIf)
, (mkRegex "^ELSE", handleUnmatched) , (mkRegex "^ELSE", handleUnmatched)
, (mkRegex "^ENDIF", handleUnmatched) , (mkRegex "^ENDIF", handleUnmatched)
, (mkRegex "^PRAGMA +(.*)$", handlePragma)
] ]
-- | Handle a directive that can be ignored. -- | Handle a directive that can be ignored.
@ -177,6 +178,9 @@ handleInclude :: DirectiveFunc
handleInclude m [incName] handleInclude m [incName]
= return (\ts -> return $ Token m (IncludeFile incName) : ts) = return (\ts -> return $ Token m (IncludeFile incName) : ts)
handlePragma :: DirectiveFunc
handlePragma m [pragma] = return (\ts -> return $ Token m (Pragma pragma) : 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
-- textually. -- textually.