From 8a36f6e96f790324cb95bdbaa74ed75bf3ccdee4 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Mon, 19 Jan 2009 15:11:09 +0000
Subject: [PATCH] Added support for parsing pragmas, for now just handling the
 SHARED pragma

---
 frontends/LexOccam.x         |  1 +
 frontends/ParseOccam.hs      | 23 +++++++++++++++++++++++
 frontends/PreprocessOccam.hs |  4 ++++
 3 files changed, 28 insertions(+)

diff --git a/frontends/LexOccam.x b/frontends/LexOccam.x
index 3563fa0..d3f048b 100644
--- a/frontends/LexOccam.x
+++ b/frontends/LexOccam.x
@@ -145,6 +145,7 @@ data TokenType =
   | TokRealLiteral String
   | TokPreprocessor String
   | IncludeFile String                 -- ^ Include a file
+  | Pragma String                      -- ^ A pragma
   | Indent                             -- ^ Indentation increase
   | Outdent                            -- ^ Indentation decrease
   | EndOfLine                          -- ^ End of line
diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs
index 69182fd..3bb5ae8 100644
--- a/frontends/ParseOccam.hs
+++ b/frontends/ParseOccam.hs
@@ -22,8 +22,10 @@ module ParseOccam (parseOccamProgram) where
 import Control.Monad (liftM)
 import Control.Monad.State (MonadState, modify, get, put)
 import Data.List
+import qualified Data.Map as Map
 import Data.Maybe
 import Text.ParserCombinators.Parsec
+import Text.Regex
 
 import qualified AST as A
 import CompState
@@ -1246,6 +1248,26 @@ structuredTypeField
     <?> "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
 process :: OccParser A.Process
 process
@@ -1265,6 +1287,7 @@ process
     <|> intrinsicProc
     <|> handleSpecs (allocation <|> specification) process
                     (\m s p -> A.Seq m (A.Spec m s (A.Only m p)))
+    <|> (pragma >> process)
     <?> "process"
 
 --{{{ assignment (:=)
diff --git a/frontends/PreprocessOccam.hs b/frontends/PreprocessOccam.hs
index fbea195..911d656 100644
--- a/frontends/PreprocessOccam.hs
+++ b/frontends/PreprocessOccam.hs
@@ -161,6 +161,7 @@ directives =
   , (mkRegex "^IF +(.*)$", handleIf)
   , (mkRegex "^ELSE", handleUnmatched)
   , (mkRegex "^ENDIF", handleUnmatched)
+  , (mkRegex "^PRAGMA +(.*)$", handlePragma)
   ]
 
 -- | Handle a directive that can be ignored.
@@ -177,6 +178,9 @@ handleInclude :: DirectiveFunc
 handleInclude m [incName]
     = 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.
 -- This is a bit of a hack at the moment, since it just includes the file
 -- textually.