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
} 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,
}
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."
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
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