From baf963ba65a9e15e11ff6e8ef3aa982e9a81f836 Mon Sep 17 00:00:00 2001
From: Francis Russell <francis@unchartedbackwaters.co.uk>
Date: Tue, 18 Sep 2012 20:02:24 +0100
Subject: [PATCH] Re-write Laplacian as a sum over spatial derivatives.

---
 src/Parser.hs   | 18 +++++++++++++++---
 src/TopLevel.hs | 27 +++++++++++++++------------
 2 files changed, 30 insertions(+), 15 deletions(-)

diff --git a/src/Parser.hs b/src/Parser.hs
index 12b233b..6a05f64 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -77,8 +77,8 @@ parseAssignment = do
  
 parseExpression = buildExpressionParser oflOperatorTable parseTerm <?> "expression"
  
-parseTerm = do 
-  lReserved "laplacian"; operand <- lParens parseExpression; return $ Laplacian operand 
+parseTerm = 
+  parseLaplacian
   <|> do lReserved "inner"; res <- lParens parseInner; return res
   <|> do lReserved "sum"; res <- lParens parseSum; return res
   <|> do lReserved "derivative"; res <- lParens parseDerivative; return res
@@ -90,6 +90,18 @@ parseTerm = do
   <|> lParens parseExpression 
   <|> parseIdentifierAccess 
   <?> "term"
+
+parseLaplacian = do
+  lReserved "laplacian"; 
+  operand <- lParens parseExpression; 
+  ofl <- getState
+  let 
+    indexName = findUniqueName ofl "laplacian" 
+    secondDerivative = SpatialDerivative operand indexName 2
+    ofl' = addIndexDeclaration ofl indexName SpatialIndex in
+    do 
+      putState ofl';
+      return $ Sum secondDerivative indexName
  
 parseInner = do 
   e1 <- parseExpression
@@ -109,7 +121,7 @@ parseDerivative = do
   e1 <- parseExpression
   _ <- lSymbol ","
   index <- parseIdentifier
-  return $ Derivative e1 index
+  return $ SpatialDerivative e1 index 1
   <?> "derivative"
 
 parseIdentifierAccess = do
diff --git a/src/TopLevel.hs b/src/TopLevel.hs
index 81ad69e..d941519 100644
--- a/src/TopLevel.hs
+++ b/src/TopLevel.hs
@@ -24,7 +24,6 @@ data Expression =
   ConstInteger Integer |
   Negate Expression | 
   Integrate Expression | 
-  Laplacian Expression | 
   Sum Expression String |
   Multiply Expression Expression |
   Divide Expression Expression |
@@ -32,9 +31,9 @@ data Expression =
   Sub Expression Expression |
   Power Expression Expression |
   PositionComponent String |
-  Derivative Expression String 
+  SpatialDerivative Expression String Integer
   deriving Show
-  
+
 data Assignment = Assign Expression Expression deriving Show
 
 class OFLKeyword a where
@@ -87,6 +86,10 @@ addIndexDeclaration :: OFL -> String -> IndexType -> OFL
 addIndexDeclaration ofl name indexType = ofl { symbols = symbols' }
   where symbols' = insertWithKey errorOnDuplicate name (IndexTag indexType) (symbols ofl)
 
+findUniqueName :: OFL -> String -> String
+findUniqueName ofl candidate = head [n | n <- generateSuffixed, not $ hasSymbol ofl n]
+  where generateSuffixed = [candidate ++ "_" ++ show n | n  <- [1::Integer ..]]
+
 addAssignment :: OFL -> Expression -> Expression -> OFL
 addAssignment ofl lhs rhs = 
   let assignment = (Assign lhs rhs) in
@@ -120,6 +123,11 @@ hasIndex ofl name = case Map.lookup name (symbols ofl) of
   Just (IndexTag _) -> True
   _ -> False
 
+hasSymbol :: OFL -> String -> Bool
+hasSymbol ofl name = case Map.lookup name (symbols ofl) of
+  Just _ -> True
+  _ -> False
+
 hasValue :: OFL -> String -> Bool
 hasValue ofl name = case Map.lookup name (symbols ofl) of
   Just (ValueTag _ _) -> True
@@ -136,7 +144,6 @@ getType :: OFL -> Expression -> BaseType
 getType _ (ConstReal _) = RealType
 getType _ (ConstInteger _) = IntegerType
 getType _ (Integrate _) = RealType
-getType _ (Laplacian _) = FunctionType 
 getType _ (PositionComponent _) = FunctionType
 getType ofl (IndexedIdentifier name _) = getValueType ofl name
 getType ofl (Negate e) = getType ofl e 
@@ -146,7 +153,7 @@ getType ofl (Divide a b) = promoteType (getType ofl a) (getType ofl b)
 getType ofl (Add a b) = promoteType (getType ofl a) (getType ofl b)
 getType ofl (Sub a b) = promoteType (getType ofl a) (getType ofl b)
 getType ofl (Power a b) = promoteType (getType ofl a) (getType ofl b)
-getType ofl (Derivative e _) = getType ofl e
+getType ofl (SpatialDerivative e _ _) = getType ofl e
 
 emptyOFL :: OFL
 emptyOFL = OFL { 
@@ -217,10 +224,6 @@ validateExpression ofl (Integrate a) = do
   validateExpression ofl a
   isFunction ofl a
 
-validateExpression ofl (Laplacian e) = do
-  validateExpression ofl e
-  isFunction ofl e
-
 validateExpression ofl (Sum e i) = do
   validateExpression ofl e
   indexExists ofl i
@@ -249,7 +252,7 @@ validateExpression ofl (PositionComponent i) = do
   indexExists ofl i
   indexIsType ofl i SpatialIndex
 
-validateExpression ofl (Derivative e i) = do
+validateExpression ofl (SpatialDerivative e d _) = do
   validateExpression ofl e
-  indexExists ofl i
-  indexIsType ofl i SpatialIndex
+  indexExists ofl d
+  indexIsType ofl d SpatialIndex
-- 
2.47.3