Build complete second-level symbol table.

diff --git a/OFC/Parser.hs b/OFC/Parser.hs
index 903c220aa47fb79bf3aa76c920d511b7561b4b55..86c550443ce29e28a9e62552cd901069206487ed 100644 (file)
--- a/OFC/Parser.hs
+++ b/OFC/Parser.hs
@@ -207,7 +207,7 @@ parseFortranParam = do
   properties <- lCommaSep parseFortranParamProperty
   return $ FortranParameter properties
 
-parseFortranParamProperty :: OFLParser FortranParameterProperty
+parseFortranParamProperty :: OFLParser FortranParamProperty
 parseFortranParamProperty =
   parseNameProperty 
   <|> parseTypeProperty 

diff --git a/OFC/SecondLevel.hs b/OFC/SecondLevel.hs
index e32f0d820ca97b9a7207e05268c49eeefaff6842..e0dd068d99e6bbb4f6ffb1470fc4c4477748d7f7 100644 (file)
--- a/OFC/SecondLevel.hs
+++ b/OFC/SecondLevel.hs
@@ -1,7 +1,7 @@
 module OFC.SecondLevel where
 import OFC.Common
 import OFC.TargetMapping (MappingTable, FortranFunction)
-import qualified OFC.TargetMapping as TargetMapping
+import qualified OFC.TargetMapping as TM
 import OFC.TopLevel (OFL)
 import qualified OFC.TopLevel as TopLevel
 import Data.Complex
@@ -110,6 +110,17 @@ addValue ofl table name = Map.insert name symbolType table where
   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."
+getTargetValueType :: TM.TargetType -> ValueType
+getTargetValueType (TM.PPDFunctionSet _) = Psinc 1
+getTargetValueType (TM.FortranParameter properties) = case TM.findSpace properties of
+  Just (TM.CoarsePsinc _) -> Psinc 1
+  Just (TM.FinePsinc _) -> Psinc 2
+  Nothing -> case TM.findParamType properties of
+    Just fortranType -> fortranToValueType fortranType
+    Nothing -> error $ "Unable to infer type from supplied properties: " ++ show properties
+    where 
+    fortranToValueType TM.SPAM3 = RealType
+    fortranToValueType TM.Double = RealType
+    fortranToValueType TM.FunctionBasis = error "ONETEP function basis cannot be mapped to value types."
+    fortranToValueType TM.Integer = IntegerType
+    fortranToValueType (TM.Array t _) = fortranToValueType t

diff --git a/OFC/TargetMapping.hs b/OFC/TargetMapping.hs
index 2cbe4dccb7f62b2d168d0143fb51b6db0369bcca..feea412896b1f7084d0bbac73b5433af000c19e9 100644 (file)
--- a/OFC/TargetMapping.hs
+++ b/OFC/TargetMapping.hs
@@ -1,10 +1,11 @@
 module OFC.TargetMapping where
 import Data.Map (Map)
+import Data.Maybe (catMaybes)
 
 type MappingTable = Map String TargetType
 
 data TargetType = 
-  FortranParameter [FortranParameterProperty] |
+  FortranParameter [FortranParamProperty] |
   PPDFunctionSet [PPDFunctionSetProperty]
   deriving Show
 
@@ -26,7 +27,7 @@ data SpaceInfo =
   FinePsinc [String]
   deriving Show
 
-data FortranParameterProperty =
+data FortranParamProperty =
   ParamName String |
   ParamType FortranType |
   Space SpaceInfo |
@@ -46,3 +47,23 @@ data FortranFunctionProperty =
   FortranFunctionName String |
   FortranFunctionParams [String]
   deriving Show
+
+findSpace :: [FortranParamProperty] -> Maybe SpaceInfo
+findSpace properties = getProperty toSpaceInfo properties
+  where
+  toSpaceInfo (Space info) = Just info
+  toSpaceInfo _ = Nothing
+
+findParamType :: [FortranParamProperty] -> Maybe FortranType
+findParamType properties = getProperty toFortranType properties
+  where
+  toFortranType (ParamType t) = Just t
+  toFortranType _ = Nothing
+
+
+getProperty :: (Show a) => (FortranParamProperty -> Maybe a) -> [FortranParamProperty] -> Maybe a
+getProperty getter properties = case catMaybes $ map getter properties of
+  [] -> Nothing
+  [x] -> Just x
+  dups -> error $ "Duplicate properties found: " ++ show dups
+