From a8ab32eee7c9a1cf0b9b29c4c85eee5ea09ff937 Mon Sep 17 00:00:00 2001
From: Francis Russell <francis@unchartedbackwaters.co.uk>
Date: Tue, 18 Sep 2012 21:11:09 +0100
Subject: [PATCH] Detect conflicts with internally generated symbols.

---
 src/Parser.hs   |  2 +-
 src/TopLevel.hs | 32 +++++++++++++++++++++++++-------
 2 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/src/Parser.hs b/src/Parser.hs
index 6a05f64..4e0c58a 100644
--- 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 e58c196..8cd8ea2 100644
--- 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"
 }
-- 
2.47.3