From: Francis Russell <francis@unchartedbackwaters.co.uk>
Date: Wed, 31 Oct 2012 16:47:47 +0000 (+0000)
Subject: Complete translation to second-level AST representation.
X-Git-Url: https://git.unchartedbackwaters.co.uk/w/?a=commitdiff_plain;h=a75441dff99716c8a35b7e32f46d4b7044d37b6f;p=francis%2Fofc.git

Complete translation to second-level AST representation.
---

diff --git a/OFC/SecondLevel.hs b/OFC/SecondLevel.hs
index 79ca072..3f28048 100644
--- a/OFC/SecondLevel.hs
+++ b/OFC/SecondLevel.hs
@@ -58,6 +58,7 @@ data OperatorExpr num terminal =
   OpDiv (OperatorExpr num terminal) (OperatorExpr num terminal) |
   OpPow (OperatorExpr num terminal) (OperatorExpr num terminal) |
   OpNeg (OperatorExpr num terminal) |
+  OpIndexedScalarIdentifier String [String] |
   OpConstant num |
   OpTerminal terminal
   deriving Show
@@ -70,6 +71,9 @@ instance (PrettyPrintable num, PrettyPrintable terminal) => PrettyPrintable (Ope
     OpDiv a b -> binaryToDoc "/" a b
     OpPow a b -> binaryToDoc "^" a b
     OpNeg o -> hcat [text "(-", toDoc o, text ")"]
+    OpIndexedScalarIdentifier name indices -> text name <> case indices of
+      [] -> empty
+      nonNil -> brackets $ hcat $ punctuate comma (map text nonNil)
     OpConstant c -> toDoc c
     OpTerminal t -> toDoc t
     where
@@ -105,6 +109,7 @@ data Expression e where
   Neg :: Expression e -> Expression e
   MulScalar :: Expression e -> Expression ScalarE -> Expression e
   DivScalar :: Expression e -> Expression ScalarE -> Expression e
+  Power :: Expression ScalarE -> Expression ScalarE -> Expression ScalarE
   PsincProduct :: Expression PsincE -> Expression PsincE -> Expression PsincE
   PsincReciprocalProduct :: Expression PsincReciprocalE -> Expression PsincReciprocalE -> Expression PsincReciprocalE
   ConstInteger :: Integer -> Expression ScalarE
@@ -133,6 +138,7 @@ instance PrettyPrintable (Expression e) where
     AnalyticMomentum e -> text "momentum_operator" <> (parens $ toDoc e)
     MulScalar a b -> binaryToDoc "*" a b
     DivScalar a b -> binaryToDoc "/" a b
+    Power a b -> binaryToDoc "^" a b
     PsincProduct a b -> binaryToDoc "*" a b
     PsincReciprocalProduct a b -> binaryToDoc "*" a b
     where
@@ -267,34 +273,90 @@ buildAssignment ofl ofl2 (TopLevel.Assign lhs rhs) = case TopLevel.getType ofl l
   TopLevel.IntegerType -> buildScalarAssign
   TopLevel.RealType -> buildScalarAssign
   TopLevel.FunctionType -> buildFieldAssign
-  where buildScalarAssign = AssignScalar (buildScalarExpression ofl ofl2 lhs) (buildScalarExpression ofl ofl2 rhs)
-        buildFieldAssign = AssignPsinc (buildPsincExpression ofl ofl2 lhs) (buildPsincExpression ofl ofl2 rhs)
+  where buildScalarAssign = AssignScalar (buildScalarExpression' lhs) (buildScalarExpression' rhs)
+        buildFieldAssign = AssignPsinc (buildPsincExpression' lhs) (buildPsincExpression' rhs)
+        buildScalarExpression' = buildScalarExpression ofl ofl2
+        buildPsincExpression' = buildPsincExpression ofl ofl2
 
 buildScalarExpression :: OFL -> OFL2 -> TopLevel.Expression -> Expression ScalarE
-buildScalarExpression _ _ e = error $ "Unimplemented scalar expression: " ++ prettyPrint e
+buildScalarExpression _ _ (TopLevel.IndexedIdentifier name indices) = IndexedScalarIdentifier name indices
+buildScalarExpression _ _ (TopLevel.ConstReal r) = ConstReal r
+buildScalarExpression _ _ (TopLevel.ConstInteger i) = ConstInteger i
+buildScalarExpression ofl ofl2 (TopLevel.Negate e) = Neg $ buildScalarExpression ofl ofl2 e
+buildScalarExpression ofl ofl2 (TopLevel.Integrate e) = Integrate $ buildPsincExpression ofl ofl2 e
+buildScalarExpression ofl ofl2 (TopLevel.Sum e index) = Sum (buildScalarExpression ofl ofl2 e) index
+buildScalarExpression ofl ofl2 (TopLevel.Multiply a b) = MulScalar a' b' where
+  a' = (buildScalarExpression ofl ofl2 a)
+  b' = (buildScalarExpression ofl ofl2 b)
+buildScalarExpression ofl ofl2 (TopLevel.Divide a b) = DivScalar a' b' where
+  a' = (buildScalarExpression ofl ofl2 a)
+  b' = (buildScalarExpression ofl ofl2 b)
+buildScalarExpression ofl ofl2 (TopLevel.Add a b) = Add a' b' where
+  a' = (buildScalarExpression ofl ofl2 a)
+  b' = (buildScalarExpression ofl ofl2 b)
+buildScalarExpression ofl ofl2 (TopLevel.Sub a b) = Sub a' b' where
+  a' = (buildScalarExpression ofl ofl2 a)
+  b' = (buildScalarExpression ofl ofl2 b)
+buildScalarExpression ofl ofl2 (TopLevel.Power a b) = Power a' b' where
+  a' = (buildScalarExpression ofl ofl2 a)
+  b' = (buildScalarExpression ofl ofl2 b)
+buildScalarExpression _ _ (TopLevel.PositionComponent index) = 
+  error $ "Reference to position component " ++ index ++ "should only occur in field expression."
+buildScalarExpression _ _ sd@(TopLevel.SpatialDerivative _ _ _) =
+  error $ "Reference to spatial derivative " ++ (prettyPrint sd) ++ " should only occur in field expression."
 
 buildPsincExpression :: OFL -> OFL2 -> TopLevel.Expression -> Expression PsincE
-buildPsincExpression _ _ e = error $ "Unimplemented psinc expression: " ++ prettyPrint e
-
--- buildAssignment ofl ofl2 (TopLevel.Assign lhs rhs) = 
---   Assign (buildExpression' lhs) (buildExpression' rhs) 
---   where
---   buildExpression' = buildExpression ofl ofl2
--- 
--- buildExpression :: OFL -> OFL2 -> TopLevel.Expression -> Expression
--- buildExpression _ _ (TopLevel.IndexedIdentifier name indices) = IndexedIdentifier name indices
--- buildExpression _ _ (TopLevel.ConstReal r) = ConstReal r
--- buildExpression _ _ (TopLevel.ConstInteger i) = ConstInteger i
--- buildExpression ofl ofl2 (TopLevel.Negate e) = Negate $ buildExpression ofl ofl2 e
--- buildExpression ofl ofl2 (TopLevel.Integrate e) = Integrate $ buildExpression ofl ofl2 e
--- buildExpression ofl ofl2 (TopLevel.Sum e index) = Sum (buildExpression ofl ofl2 e) index
--- buildExpression ofl ofl2 (TopLevel.Multiply e1 e2) = Mul (buildExpression ofl ofl2 e1) (buildExpression ofl ofl2 e2)
--- buildExpression ofl ofl2 (TopLevel.Divide e1 e2) = Div (buildExpression ofl ofl2 e1) (buildExpression ofl ofl2 e2)
--- buildExpression ofl ofl2 (TopLevel.Add e1 e2) = Add (buildExpression ofl ofl2 e1) (buildExpression ofl ofl2 e2)
--- buildExpression ofl ofl2 (TopLevel.Sub e1 e2) = Sub (buildExpression ofl ofl2 e1) (buildExpression ofl ofl2 e2)
--- buildExpression ofl ofl2 (TopLevel.Power e1 e2) = Pow (buildExpression ofl ofl2 e1) (buildExpression ofl ofl2 e2)
--- buildExpression _ _ (TopLevel.PositionComponent i) = PositionComponent i
--- buildExpression ofl ofl2 (TopLevel.SpatialDerivative e index n) = Mul operator $ ToMomentum (buildExpression ofl ofl2 e)
---   where
---   operator = Pow derivative (ConstInteger n)
---   derivative = Mul (MomentumComponent index) (ConstComplex $ 0.0 :+ (-1.0))
+buildPsincExpression _ _ (TopLevel.IndexedIdentifier name indices) = IndexedPsincIdentifier name indices
+buildPsincExpression _ _ (TopLevel.ConstReal r) = error $ "Expected a field, found real: " ++ show r
+buildPsincExpression _ _ (TopLevel.ConstInteger i) = error $ "Expected a field, found integer: " ++ show i
+buildPsincExpression ofl ofl2 (TopLevel.Negate e) = Neg $ buildPsincExpression ofl ofl2 e
+buildPsincExpression _ _ (TopLevel.Integrate e) = 
+  error $ "Expected field-dependent expression for integration: " ++ prettyPrint e
+buildPsincExpression ofl ofl2 (TopLevel.Sum e index) = Sum (buildPsincExpression ofl ofl2 e) index
+buildPsincExpression ofl ofl2 (TopLevel.Multiply a b) = buildPsincMultiplyExpression ofl ofl2 a b
+buildPsincExpression ofl ofl2 (TopLevel.Divide a b) = DivScalar a' b' where
+  a' = buildPsincExpression ofl ofl2 a
+  b' = buildScalarExpression ofl ofl2 b
+buildPsincExpression ofl ofl2 (TopLevel.Add a b) = Add a' b' where
+  a' = buildPsincExpression ofl ofl2 a
+  b' = buildPsincExpression ofl ofl2 b
+buildPsincExpression ofl ofl2 (TopLevel.Sub a b) = Sub a' b' where
+  a' = buildPsincExpression ofl ofl2 a
+  b' = buildPsincExpression ofl ofl2 b
+buildPsincExpression ofl ofl2 pc@(TopLevel.PositionComponent _) = 
+  AnalyticPosition $ buildPositionOperator ofl ofl2 pc
+buildPsincExpression ofl ofl2 e@(TopLevel.Power _ _) = 
+  AnalyticPosition $ buildPositionOperator ofl ofl2 e
+buildPsincExpression ofl ofl2 (TopLevel.SpatialDerivative e index degree) = 
+  ToPosition derivativeInMomentumSpace
+  where
+  derivativeInMomentumSpace = 
+    PsincReciprocalProduct operandInMomentumSpace (AnalyticMomentum raisedDerivativeOperator)
+  operandInMomentumSpace = ToMomentum operand
+  operand = buildPsincExpression ofl ofl2 e
+  raisedDerivativeOperator = 
+    derivativeOperator `OpPow` OpConstant (fromInteger degree :+ 0.0)
+  derivativeOperator = 
+    (OpTerminal $ MomentumComponent index) `OpMul` (OpConstant $ 0.0 :+ (-1.0))
+
+buildPsincMultiplyExpression :: OFL -> OFL2 -> TopLevel.Expression -> TopLevel.Expression -> Expression PsincE
+buildPsincMultiplyExpression ofl ofl2 e1 e2 = let getGeneralType = TopLevel.baseToGeneralType . TopLevel.getType ofl in
+  case (getGeneralType e1, getGeneralType e2) of
+  (TopLevel.FieldType, TopLevel.FieldType) -> PsincProduct e1AsField e2AsField
+  (TopLevel.FieldType, TopLevel.ScalarType) -> MulScalar e1AsField e2AsScalar
+  (TopLevel.ScalarType, TopLevel.FieldType) -> MulScalar e2AsField e1AsScalar
+  _ -> error $ "Couldn't work out how to evaluate product of " ++ 
+       (prettyPrint e1) ++ " and " ++ (prettyPrint e2) ++ " as a field."
+  where
+  e1AsField = buildPsincExpression ofl ofl2 e1
+  e2AsField = buildPsincExpression ofl ofl2 e2
+  e1AsScalar = buildScalarExpression ofl ofl2 e1
+  e2AsScalar = buildScalarExpression ofl ofl2 e2
+
+buildPositionOperator :: OFL -> OFL2 -> TopLevel.Expression -> OperatorExpr Double PositionTerminal
+buildPositionOperator _ _ (TopLevel.ConstReal r) = OpConstant r
+buildPositionOperator _ _ (TopLevel.ConstInteger i) = OpConstant $ fromInteger i
+buildPositionOperator ofl ofl2 (TopLevel.Power a b) = (buildPositionOperator ofl ofl2 a) `OpPow` (buildPositionOperator ofl ofl2 b)
+buildPositionOperator _ _ (TopLevel.IndexedIdentifier name indices) = OpIndexedScalarIdentifier name indices
+buildPositionOperator _ _ (TopLevel.PositionComponent index) = OpTerminal $ PositionComponent index
+buildPositionOperator _ _ e = error $ "Unhandled expression: " ++ prettyPrint e
diff --git a/OFC/TopLevel.hs b/OFC/TopLevel.hs
index a7711fa..850e89d 100644
--- a/OFC/TopLevel.hs
+++ b/OFC/TopLevel.hs
@@ -1,5 +1,6 @@
 module OFC.TopLevel 
   ( BaseType(..)
+  , GeneralType(..)
   , Expression(..)
   , Assignment(..)
   , SymbolTable
@@ -30,6 +31,7 @@ module OFC.TopLevel
   , promoteType
   , getType
   , emptyOFL
+  , baseToGeneralType
   ) where
 
 import OFC.TargetMapping
@@ -48,6 +50,16 @@ data BaseType =
   IntegerType 
   deriving (Show, Eq, Enum, Bounded)
 
+data GeneralType =
+  FieldType |
+  ScalarType
+  deriving Show
+
+baseToGeneralType :: BaseType -> GeneralType
+baseToGeneralType RealType = ScalarType
+baseToGeneralType FunctionType = FieldType
+baseToGeneralType IntegerType = ScalarType
+
 -- Expressions
 data Expression = 
   IndexedIdentifier String [String] |