Detect conflicts with internally generated symbols.

diff --git a/src/Parser.hs b/src/Parser.hs
index 6a05f64ea2d83dfd8f8e4b961649cbab5174fbe6..4e0c58aa3355fa3b2eb82c3948bc9e8e9c06aa3e 100644 (file)
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -98,7 +98,7 @@ parseLaplacian = do
   let 
     indexName = findUniqueName ofl "laplacian" 
     secondDerivative = SpatialDerivative operand indexName 2
-    ofl' = addIndexDeclaration ofl indexName SpatialIndex in
+    ofl' = addInternalIndexDeclaration ofl indexName SpatialIndex in
     do 
       putState ofl';
       return $ Sum secondDerivative indexName

diff --git a/src/TopLevel.hs b/src/TopLevel.hs
index e58c196e29248bc8d01ae7369cb614b13be7eadc..8cd8ea27571ba680c7ab8a19cd6befbce8061a82 100644 (file)
--- a/src/TopLevel.hs
+++ b/src/TopLevel.hs
@@ -2,7 +2,10 @@ module TopLevel where
 import TargetMapping
 import Text.PrettyPrint
 import Data.List (foldl')
-import Data.Map as Map (Map, lookup, insertWithKey, assocs, empty)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 -- The top-level types
 data BaseType = 
@@ -58,6 +61,7 @@ type MappingTable = Map String TargetType
 
 data OFL = OFL {
   symbols :: SymbolTable,
+  internalSymbols :: Set String,
   assignments :: [Assignment],
   targetMappings :: MappingTable,
   outputFunction :: FortranFunction
@@ -67,11 +71,11 @@ toDoc :: OFL -> Doc
 toDoc ofl = vcat [symbolDoc, assignmentsDoc, targetMappingsDoc, outputFunctionDoc]
   where
   symbolDoc = text "Symbol table:"
-    $$ nest 1 (vcat [text $ show x | x <- assocs $ symbols ofl])
+    $$ nest 1 (vcat [text $ show x | x <- Map.assocs $ symbols ofl])
   assignmentsDoc = text "Assignments: "
     $$ nest 1 (vcat [text $ show x | x <- assignments ofl])
   targetMappingsDoc = text "Target properties: "
-    $$ nest 1 (vcat [text $ show x | x <- assocs $ targetMappings ofl])
+    $$ nest 1 (vcat [text $ show x | x <- Map.assocs $ targetMappings ofl])
   outputFunctionDoc = text "OutputFunction:"
     $$ nest 1 (text $ show $ outputFunction ofl)
 
@@ -81,15 +85,25 @@ prettyPrint ofl = renderStyle Style {mode = PageMode, lineLength=10, ribbonsPerL
 -- Symbol table manipulators
 addValueDeclaration :: OFL -> String -> BaseType -> [IndexType] -> OFL
 addValueDeclaration ofl name baseType indices = ofl { symbols = symbols' }
-  where symbols' = insertWithKey errorOnDuplicate name (ValueTag baseType indices) (symbols ofl)
+  where symbols' = Map.insertWithKey errorOnDuplicate name (ValueTag baseType indices) (symbols ofl)
 
 addTargetMapping :: OFL -> String -> TargetType -> OFL
-addTargetMapping ofl name properties = ofl { targetMappings = targetMappings' }
-  where targetMappings' = insertWithKey errorOnDuplicate name properties (targetMappings ofl)
+addTargetMapping ofl name properties = result where
+  ofl' = ofl { targetMappings = targetMappings' }
+  targetMappings' = Map.insertWithKey errorOnDuplicate name properties (targetMappings ofl)
+  result = if isInternalSymbol ofl name
+    then error $ "error: target binding " ++ show name ++ " conflicts with internally generated identifer."
+    else ofl'
 
 addIndexDeclaration :: OFL -> String -> IndexType -> OFL
 addIndexDeclaration ofl name indexType = ofl { symbols = symbols' }
-  where symbols' = insertWithKey errorOnDuplicate name (IndexTag indexType) (symbols ofl)
+  where symbols' = Map.insertWithKey errorOnDuplicate name (IndexTag indexType) (symbols ofl)
+
+addInternalIndexDeclaration :: OFL -> String -> IndexType -> OFL
+addInternalIndexDeclaration ofl name indexType = ofl'' where 
+  ofl' = addIndexDeclaration ofl name indexType
+  internalSymbols' = Set.insert name (internalSymbols ofl)
+  ofl'' = ofl' { internalSymbols = internalSymbols' }
 
 findUniqueName :: OFL -> String -> String
 findUniqueName ofl candidate = head [n | n <- generateSuffixed, not $ hasSymbol ofl n]
@@ -133,6 +147,9 @@ hasSymbol ofl name = case Map.lookup name (symbols ofl) of
   Just _ -> True
   _ -> False
 
+isInternalSymbol :: OFL -> String -> Bool
+isInternalSymbol ofl ident = Set.member ident (internalSymbols ofl)
+
 hasValue :: OFL -> String -> Bool
 hasValue ofl name = case Map.lookup name (symbols ofl) of
   Just (ValueTag _ _) -> True
@@ -164,6 +181,7 @@ emptyOFL :: OFL
 emptyOFL = OFL { 
   assignments = [], 
   symbols = Map.empty, 
+  internalSymbols = Set.empty,
   targetMappings = Map.empty, 
   outputFunction = error "Output function not defined"
 }