]> git.unchartedbackwaters.co.uk Git - francis/ofc.git/commitdiff
Translate indices to entries in second-level symbol table.
authorFrancis Russell <francis@unchartedbackwaters.co.uk>
Thu, 27 Sep 2012 18:18:27 +0000 (19:18 +0100)
committerFrancis Russell <francis@unchartedbackwaters.co.uk>
Thu, 27 Sep 2012 18:18:27 +0000 (19:18 +0100)
OFC/SecondLevel.hs
OFC/TopLevel.hs

index ceef1b7d83b1a384b60afbc07126538b021a42ea..e32f0d820ca97b9a7207e05268c49eeefaff6842 100644 (file)
@@ -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."
index ec2a3970eb18e1d4f9b1b6efbfcee4a170cd7ba7..68c76e94fed90e1cf3a97b69b8bc87e09c729f6b 100644 (file)
@@ -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