Added support for parsing pragmas, for now just handling the SHARED pragma
This commit is contained in:
parent
f612b99a49
commit
8a36f6e96f
|
@ -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
|
||||||
|
|
|
@ -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 (:=)
|
||||||
|
|
|
@ -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.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user