From: Francis Russell <francis@unchartedbackwaters.co.uk>
Date: Sat, 15 Sep 2012 21:07:49 +0000 (+0100)
Subject: Parse ONETEP mapping entries.
X-Git-Url: https://git.unchartedbackwaters.co.uk/w/?a=commitdiff_plain;h=0769e07c88edc2f7f0f99829f26b6a48e5930619;p=francis%2Fofc.git

Parse ONETEP mapping entries.
---

diff --git a/src/ParsedOFL.hs b/src/ParsedOFL.hs
index 95ee451..aeb0692 100644
--- a/src/ParsedOFL.hs
+++ b/src/ParsedOFL.hs
@@ -1,4 +1,5 @@
 module ParsedOFL where
+import TargetMapping
 import Data.Map as Map (Map, lookup, insertWithKey, empty)
 import Data.List (foldl')
 
@@ -34,9 +35,11 @@ data Assignment = Assign Expression Expression deriving Show
 -- The symbol table
 data SymbolType = ValueTag BaseType [IndexType] | IndexTag IndexType deriving Show
 type SymbolTable = Map String SymbolType
+type MappingTable = Map String TargetType
 data OFL = OFL {
   symbols :: SymbolTable,
-  assignments :: [Assignment]
+  assignments :: [Assignment],
+  targetMappings :: MappingTable
 } deriving Show
 
 -- Symbol table manipulators
@@ -44,6 +47,10 @@ addValueDeclaration :: OFL -> String -> BaseType -> [IndexType] -> OFL
 addValueDeclaration ofl name baseType indices = ofl { symbols = symbols' }
   where symbols' = 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)
+
 addIndexDeclaration :: OFL -> String -> IndexType -> OFL
 addIndexDeclaration ofl name indexType = ofl { symbols = symbols' }
   where symbols' = insertWithKey errorOnDuplicate name (IndexTag indexType) (symbols ofl)
@@ -107,7 +114,7 @@ getType ofl (Power a b) = promoteType (getType ofl a) (getType ofl b)
 getType ofl (Derivative e _) = getType ofl e
 
 emptyOFL :: OFL
-emptyOFL = OFL { assignments = [], symbols = Map.empty }
+emptyOFL = OFL { assignments = [], symbols = Map.empty, targetMappings = Map.empty }
 
 -- Validation
 data ValidationError = Message String deriving Show
diff --git a/src/Parsing.hs b/src/Parsing.hs
index 9cbc284..507f630 100644
--- a/src/Parsing.hs
+++ b/src/Parsing.hs
@@ -1,5 +1,6 @@
 module Parsing where
 import ParsedOFL
+import TargetMapping
 import Data.List (foldl1')
 import Text.Parsec
 import Text.Parsec.Expr
@@ -9,7 +10,7 @@ import Text.Parsec.Language
 oflKeywords :: [String]
 oflKeywords = map show [minBound::IndexType ..] ++ 
   map show [minBound::BaseType ..] ++ 
-  ["^", "+", "-", "*", "/", "laplacian", "inner", "sum", "derivative", "r", "target"]
+  ["^", "+", "-", "*", "/", "=", "laplacian", "inner", "sum", "derivative", "r", "target"]
 
 oflDef = emptyDef { 
   commentStart = "",
@@ -31,7 +32,8 @@ TokenParser {
   brackets = lBrackets,
   symbol = lSymbol,
   parens = lParens,
-  naturalOrFloat = lNaturalOrFloat
+  naturalOrFloat = lNaturalOrFloat,
+  stringLiteral = lStringLiteral
 } = makeTokenParser oflDef
 
 oflOperatorTable = [[Infix  (do _ <- lSymbol "^"; return (\x y -> Power x y)) AssocLeft],
@@ -124,8 +126,62 @@ parseOFL = do
   _ <- many1 parseDeclaration
   _ <- many1 parseAssignment
   target <- parseTarget
-  _ <- many1 anyChar
+  _ <- many parseBinding
+  _ <- many anyChar
   eof
   getState
 
+parseBinding = do
+  _ <- lSymbol "Variable" <|> lSymbol "Parameter"
+  ident <- parseIdentifier
+  _ <- lSymbol "=" 
+  targetType <- (parseFortranParam <|> parsePPDFunctionSet)
+  modifyState(\x -> addTargetMapping x ident targetType)
+
+parseFortranParam = do
+  _ <- lSymbol "fortran_param"
+  _ <- lSymbol "with"
+  properties <- lCommaSep parseFortranParamProperty
+  return $ FortranParameter properties
+
+parseFortranParamProperty = do
+  (parseNameProperty <|> parseTypeProperty <|> parseSpaceProperty <|> parseIndexedProperty) where
+  parseNameProperty = do _ <- lSymbol "name"; name <- lParens lStringLiteral; return $ ParamName name
+  parseTypeProperty = do _ <- lSymbol "type"; fType <- lParens parseFortranType; return $ ParamType fType
+  parseSpaceProperty = do _ <- lSymbol "space"; info <- lParens parseSpaceInfo; return $ Space info
+  parseSpaceInfo = do
+    _ <- lSymbol "psinc_fine_grid"; indices <- lParens $ lCommaSep1 lIdentifier; return $ FinePsinc indices
+    <|> do _ <- lSymbol "psinc_coarse_grid"; indices <- lParens $ lCommaSep1 lIdentifier; return $ CoarsePsinc indices
+  parseIndexedProperty = do _ <- lSymbol "indexed"; indices <- lParens $ lCommaSep1 lIdentifier; return $ Indexed indices
+
+parseFortranType = do
+  baseType <- parseBaseType;
+  maybeIndices <- optionMaybe parseArrayIndices
+  case maybeIndices of
+    Nothing -> return baseType
+    Just indices -> return $ Array baseType indices
+  where 
+    parseArrayIndices = do 
+      indices <- lParens $ lCommaSep1 parseArrayIndex
+      return indices
+    parseArrayIndex = do
+      _ <- lSymbol ":"; return UnnamedIndex
+      <|> do name <- lIdentifier; return $ NamedIndex name
+    parseBaseType = do 
+     _ <- lSymbol "spam3"; return SPAM3 
+     <|> do _ <- lSymbol "integer"; return Integer
+     <|> do _ <- lSymbol "double"; return Double
+     <|> do _ <- lSymbol "func_basis"; return FunctionBasis
+
+parsePPDFunctionSet = do
+  _ <- lSymbol "ppd_function_set"
+  _ <- lSymbol "with"
+  properties <- lCommaSep parsePPDFunctionSetProperty
+  return $ PPDFunctionSet properties
+
+parsePPDFunctionSetProperty = do
+  parseBasisProperty <|> parseDataProperty where
+  parseBasisProperty = do _ <- lSymbol "basis"; ident <- lParens lIdentifier; return $ PPDBasis ident
+  parseDataProperty = do _ <- lSymbol "data"; ident <- lParens lIdentifier; return $ PPDData ident
+
 parseAsOFL inputString = runParser parseOFL emptyOFL "(unknown)" inputString
diff --git a/src/TargetMapping.hs b/src/TargetMapping.hs
new file mode 100644
index 0000000..5669283
--- /dev/null
+++ b/src/TargetMapping.hs
@@ -0,0 +1,36 @@
+module TargetMapping where
+
+data TargetType = 
+  FortranParameter [FortranParameterProperties] |
+  PPDFunctionSet [PPDFunctionSetProperties]
+  deriving Show
+
+data FortranType = 
+  Array FortranType [ArrayIndex] |
+  SPAM3 |
+  FunctionBasis |
+  Double |
+  Integer
+  deriving Show
+
+data ArrayIndex = 
+  UnnamedIndex | 
+  NamedIndex String
+  deriving Show
+
+data SpaceInfo =
+  CoarsePsinc [String] |
+  FinePsinc [String]
+  deriving Show
+
+data FortranParameterProperties =
+  ParamName String |
+  ParamType FortranType |
+  Space SpaceInfo |
+  Indexed [String]
+  deriving Show
+
+data PPDFunctionSetProperties =
+  PPDData String |
+  PPDBasis String
+  deriving Show