From 6b22216c79d19d76b6aa74c35235a6c39fa37139 Mon Sep 17 00:00:00 2001
From: Francis Russell <francis@unchartedbackwaters.co.uk>
Date: Tue, 18 Dec 2012 11:44:33 +0000
Subject: [PATCH] Clean up top-level validation code.

---
 OFC/TopLevel.hs | 107 ++++++++++++++++++++----------------------------
 1 file changed, 45 insertions(+), 62 deletions(-)

diff --git a/OFC/TopLevel.hs b/OFC/TopLevel.hs
index 0c923ff..b9530c2 100644
--- a/OFC/TopLevel.hs
+++ b/OFC/TopLevel.hs
@@ -36,12 +36,14 @@ module OFC.TopLevel
 
 import OFC.TargetMapping
 import OFC.Common
-import Text.PrettyPrint
-import Data.List (foldl', intersperse, intercalate)
+
+import Control.Monad.Instances ()
+import Data.List (intersperse, intercalate)
 import Data.Map (Map)
-import qualified Data.Map as Map
 import Data.Set (Set)
+import qualified Data.Map as Map
 import qualified Data.Set as Set
+import Text.PrettyPrint
 
 -- The top-level types
 data BaseType 
@@ -288,13 +290,13 @@ validationSuccess :: ValidationResult
 validationSuccess = Right ()
 
 validationFailure :: String -> ValidationResult
-validationFailure = \x -> Left (Message x)
+validationFailure = Left . Message
 
 validateAssignment :: OFL -> Assignment -> ValidationResult
-validateAssignment ofl (Assign lhs rhs) = do
-  validateExpression ofl lhs
-  validateExpression ofl rhs
-  isLValue ofl lhs
+validateAssignment ofl (Assign lhs rhs) =
+  validateExpression ofl lhs >>
+  validateExpression ofl rhs >>
+  isLValue ofl lhs >>
   if (getType ofl lhs) == (getType ofl rhs) 
     then validationSuccess 
     else validationFailure $ "Types of left and right-hand sides of assignment do not match"
@@ -324,58 +326,39 @@ isFunction ofl e = case (getType ofl e) of
   _ -> validationFailure $ "Expression " ++ show e ++ " is not a function"
 
 validateExpression :: OFL -> Expression -> ValidationResult
-
-validateExpression ofl (IndexedIdentifier name indices) = do
-  valueExists ofl name
-  foldl' (>>) validationSuccess $ map (indexExists ofl) indices
-  let indexTypes = map (getIndexType ofl) indices in
-    if indexTypes == (getIndices ofl name)
+validateExpression ofl expr = case expr of
+  IndexedIdentifier name indices -> 
+    valueExists ofl name >>
+    mapM_ (indexExists ofl) indices >>
+    let indexTypes = map (getIndexType ofl) indices in
+      if indexTypes == (getIndices ofl name)
+        then validationSuccess
+        else validationFailure $ "Incorrect number or type of indices used to index " ++ name
+  ConstReal _ -> validationSuccess
+  ConstInteger _ -> validationSuccess
+  Negate e -> validateUnary e
+  Integrate a -> 
+    validateUnary a >>
+    isFunction ofl a
+  Sum e i -> 
+    validateUnary e >>
+    indexExists ofl i
+  Multiply a b -> validateBinary a b
+  Divide a b -> validateBinary a b
+  Add a b -> validateBinary a b
+  Sub a b -> validateBinary a b
+  Power a b -> validateBinary a b
+  PositionComponent i ->
+    indexExists ofl i >>
+    indexIsType ofl i SpatialIndex
+  SpatialDerivative e d n -> 
+    validateUnary e >>
+    isFunction ofl e >>
+    indexExists ofl d >>
+    indexIsType ofl d SpatialIndex >>
+    if n > 0
       then validationSuccess
-      else validationFailure $ "Incorrect number or type of indices used to index " ++ name
-
-validateExpression _ (ConstReal _) = validationSuccess
-
-validateExpression _ (ConstInteger _) = validationSuccess
-
-validateExpression ofl (Negate e) = validateExpression ofl e
-
-validateExpression ofl (Integrate a) = do
-  validateExpression ofl a
-  isFunction ofl a
-
-validateExpression ofl (Sum e i) = do
-  validateExpression ofl e
-  indexExists ofl i
-
-validateExpression ofl (Multiply a b) = do
-  validateExpression ofl a
-  validateExpression ofl b
-
-validateExpression ofl (Divide a b) = do
-  validateExpression ofl a
-  validateExpression ofl b
-
-validateExpression ofl (Add a b) = do
-  validateExpression ofl a
-  validateExpression ofl b
-
-validateExpression ofl (Sub a b) = do
-  validateExpression ofl a
-  validateExpression ofl b
-
-validateExpression ofl (Power a b) = do
-  validateExpression ofl a
-  validateExpression ofl b
-
-validateExpression ofl (PositionComponent i) = do
-  indexExists ofl i
-  indexIsType ofl i SpatialIndex
-
-validateExpression ofl (SpatialDerivative e d n) = do
-  validateExpression ofl e
-  isFunction ofl e
-  indexExists ofl d
-  if n > 0
-    then validationSuccess
-    else validationFailure $ "Degree of derivative of " ++ show e ++ " must be greater than 0."
-  indexIsType ofl d SpatialIndex
+      else validationFailure $ "Degree of derivative of " ++ show e ++ " must be greater than 0."
+  where
+    validateUnary = validateExpression ofl 
+    validateBinary a b = validateUnary a >> validateUnary b
-- 
2.47.3