From e1d618e69bb8c99d4a1f24d2ed87da9ec88272e6 Mon Sep 17 00:00:00 2001
From: Francis Russell <francis@unchartedbackwaters.co.uk>
Date: Thu, 27 Sep 2012 19:18:27 +0100
Subject: [PATCH] Translate indices to entries in second-level symbol table.

---
 OFC/SecondLevel.hs | 34 +++++++++++++++++++++++++++++++---
 OFC/TopLevel.hs    | 23 +++++++++++++++++++----
 2 files changed, 50 insertions(+), 7 deletions(-)

diff --git a/OFC/SecondLevel.hs b/OFC/SecondLevel.hs
index ceef1b7..e32f0d8 100644
--- a/OFC/SecondLevel.hs
+++ b/OFC/SecondLevel.hs
@@ -1,11 +1,13 @@
 module OFC.SecondLevel where
 import OFC.Common
 import OFC.TargetMapping (MappingTable, FortranFunction)
+import qualified OFC.TargetMapping as TargetMapping
 import OFC.TopLevel (OFL)
 import qualified OFC.TopLevel as TopLevel
 import Data.Complex
 import Text.PrettyPrint
 import Data.Map (Map)
+import Data.List (foldl')
 import qualified Data.Map as Map
 
 type SymbolTable = Map String SymbolType
@@ -65,8 +67,13 @@ data OFL2 = OFL2 {
 } deriving Show
 
 instance PrettyPrintable OFL2 where
-  toDoc ofl2 = text $ show ofl2
-
+  toDoc ofl2 = vcat [symbolDoc, assignmentsDoc]
+    where
+    symbolDoc = text "Symbol table:"
+      $$ nest 1 (vcat [text $ show x | x <- Map.assocs $ symbols ofl2])
+    assignmentsDoc = text "Assignments: "
+      $$ nest 1 (vcat [text $ show x | x <- assignments ofl2])
+  
 emptyOFL2 :: OFL2
 emptyOFL2 = OFL2 { 
   symbols = Map.empty, 
@@ -84,4 +91,25 @@ buildSecondLevel ofl =
   }
 
 buildSymbolTable :: OFL -> SymbolTable
-buildSymbolTable _ = error "Building second-level symbol table not yet implemented!"
+buildSymbolTable ofl = table'' where
+  table = Map.empty
+  table' = foldl' (addIndex ofl) table (TopLevel.getIndexSymbols ofl)
+  table'' = foldl' (addValue ofl) table' (TopLevel.getValueSymbols ofl)
+
+addIndex :: OFL -> SymbolTable -> String -> SymbolTable
+addIndex ofl table name = Map.insert name symbolType table where
+  symbolType = IndexTag indexType quantification
+  indexType = TopLevel.getIndexType ofl name
+  quantification = if TopLevel.hasTargetMapping ofl name
+    then Bound
+    else Forall
+
+addValue :: OFL -> SymbolTable -> String -> SymbolTable
+addValue ofl table name = Map.insert name symbolType table where
+  symbolType = ValueTag valueType indexTypes
+  valueType = getTargetValueType $ TopLevel.getTargetType ofl name
+  indexTypes = TopLevel.getIndices ofl name
+
+getTargetValueType :: TargetMapping.TargetType -> ValueType
+getTargetValueType (TargetMapping.PPDFunctionSet _) = Psinc 1
+getTargetValueType t = error $ "Not implemented translation of " ++ show t ++ " to second-level value type."
diff --git a/OFC/TopLevel.hs b/OFC/TopLevel.hs
index ec2a397..68c76e9 100644
--- a/OFC/TopLevel.hs
+++ b/OFC/TopLevel.hs
@@ -88,9 +88,23 @@ addTargetMapping ofl name properties = result where
     then error $ "error: target binding " ++ show name ++ " conflicts with internally generated identifer."
     else ofl'
 
+getSymbols :: OFL -> [String]
+getSymbols = Map.keys . symbols 
+
+getIndexSymbols :: OFL -> [String]
+getIndexSymbols ofl = filter (hasIndex ofl) $ Map.keys $ symbols ofl
+
+getValueSymbols :: OFL -> [String]
+getValueSymbols ofl = filter (hasValue ofl) $ Map.keys $ symbols ofl
+
 getTargetMappings :: OFL -> MappingTable
 getTargetMappings = targetMappings
 
+getTargetType :: OFL -> String -> TargetType
+getTargetType ofl name = case Map.lookup name (targetMappings ofl) of
+  Just targetType -> targetType
+  _ -> error $ "Could not find a target type for symbol " ++ name
+
 getOutputFunction :: OFL -> FortranFunction
 getOutputFunction = outputFunction
 
@@ -141,13 +155,14 @@ hasIndex ofl name = case Map.lookup name (symbols ofl) of
   Just (IndexTag _) -> True
   _ -> False
 
+hasTargetMapping :: OFL -> String -> Bool
+hasTargetMapping ofl name = Map.member name $ targetMappings ofl
+
 hasSymbol :: OFL -> String -> Bool
-hasSymbol ofl name = case Map.lookup name (symbols ofl) of
-  Just _ -> True
-  _ -> False
+hasSymbol ofl name = Map.member name $ symbols ofl
 
 isInternalSymbol :: OFL -> String -> Bool
-isInternalSymbol ofl ident = Set.member ident (internalSymbols ofl)
+isInternalSymbol ofl ident = Set.member ident $ internalSymbols ofl
 
 hasValue :: OFL -> String -> Bool
 hasValue ofl name = case Map.lookup name (symbols ofl) of
-- 
2.47.3