From: Francis Russell <francis@unchartedbackwaters.co.uk>
Date: Fri, 23 Nov 2012 20:18:51 +0000 (+0000)
Subject: Add generation of different resampling variants.
X-Git-Url: https://git.unchartedbackwaters.co.uk/w/?a=commitdiff_plain;h=3ce2ff50a5b0342af43d0c5071eabdfa3957d00c;p=francis%2Fofc.git

Add generation of different resampling variants.
---

diff --git a/OFC/SecondLevel.hs b/OFC/SecondLevel.hs
index d094911..e3178ec 100644
--- a/OFC/SecondLevel.hs
+++ b/OFC/SecondLevel.hs
@@ -22,6 +22,10 @@ import Data.Map (Map)
 import Data.List (foldl', intersperse, intercalate)
 import qualified Data.Map as Map
 
+minPsincDensity, maxPsincDensity :: Integer
+minPsincDensity = 1
+maxPsincDensity = 2
+
 type SymbolTable = Map String SymbolType
 
 data Quantification = 
@@ -171,6 +175,23 @@ instance PrettyPrintable (Expression e) where
     binaryToDoc op lhs rhs = parens $ hcat [toDoc lhs, text op, toDoc rhs]
     functionToDoc name params = text name <> (parens $ hcat (intersperse (text ", ") params))
 
+class Resamplable a where
+  resampled :: OFL2 -> a -> [a]
+
+instance Resamplable (Expression ScalarE) where
+  resampled _ e = [e]
+
+instance Resamplable (Expression PsincReciprocalE) where
+  resampled _ e = [e]
+
+instance Resamplable (Expression PsincE) where
+  resampled ofl2 e = case getImplementationType ofl2 e of
+    Right (PositionT (Psinc i)) -> e : upsampled ++ downsampled where
+      upsampled = take (fromInteger $ maxPsincDensity - i) (tail $ iterate Upsample e)
+      downsampled = take (fromInteger $ i - minPsincDensity) (tail $ iterate Downsample e)
+    Right _ -> error $ "Expected expression " ++ prettyPrint e ++ " to be in a non-analytic basis."
+    Left _ -> error $ "Cannot resample expression with invalid implementation type: " ++ prettyPrint e
+
 getImplementationType :: OFL2 -> Expression e -> Either String ValueType
 getImplementationType ofl2 expr = case expr of
   IndexedPsincIdentifier name _ -> Right $ getIdentType ofl2 name
@@ -268,6 +289,45 @@ getIdentType ofl2 name = case Map.lookup name (symbols ofl2) of
   Just (ValueTag baseType _) -> baseType
   _ -> error $ "Could not find type of symbol " ++ name
 
+generateVariants :: OFL2 -> Expression e -> [Expression e]
+generateVariants ofl2 expr = case expr of
+  IndexedPsincIdentifier _ _ -> resampled ofl2 expr
+  IndexedScalarIdentifier _ _ -> resampled ofl2 expr
+  ToMomentum e -> unaryOp ToMomentum e
+  ToPosition e -> unaryOp ToPosition e
+  Upsample _ -> error "generateVariants should not encounter Upsample node."
+  Downsample _ -> error "generateVariants should not encounter Downsample node."
+  Integrate integrand -> unaryOp Integrate integrand
+  AnalyticMomentum _ -> resampled ofl2 expr
+  AnalyticPosition _ -> concatMap (resampled ofl2) [AnalyticToPsinc expr i | i <- [minPsincDensity..maxPsincDensity]]
+  AnalyticToPsinc _ _ -> error "generateVariants should not encounter AnalyticToPsinc node."
+  Sum e i -> unaryOp (flip Sum i) e
+  Add a b -> binaryOp Add a b
+  Sub a b -> binaryOp Sub a b
+  Neg e -> unaryOp Neg e
+  MulScalar e s -> binaryOp MulScalar e s
+  DivScalar e s -> binaryOp DivScalar e s
+  Power a b -> binaryOp Power a b
+  PsincProduct a b -> binaryOp PsincProduct a b
+  PsincReciprocalProduct a b -> binaryOp PsincReciprocalProduct a b
+  ConstInteger _ -> resampled ofl2 expr
+  ConstReal _ -> resampled ofl2 expr
+  ConstComplex _ -> resampled ofl2 expr
+  where
+    unaryOp :: (Expression a -> Expression c) -> Expression a -> [Expression c]
+    unaryOp constructor e = do
+     variant <- generateVariants ofl2 e
+     returnValid $ constructor variant
+    binaryOp :: (Expression a -> Expression b -> Expression r) -> Expression a  -> Expression b -> [Expression r]
+    binaryOp constructor e1 e2 = do
+     variant1 <- generateVariants ofl2 e1
+     variant2 <- generateVariants ofl2 e2
+     returnValid $ constructor variant1 variant2
+    returnValid :: Expression e -> [Expression e]
+    returnValid e = case getImplementationType ofl2 e of
+      Left _ -> []
+      Right _ -> [e]
+
 data Assignment =
  AssignPsinc (Expression PsincE) (Expression PsincE) |
  AssignScalar (Expression ScalarE) (Expression ScalarE)
@@ -292,7 +352,10 @@ instance PrettyPrintable OFL2 where
     symbolDoc = text "Symbol table:"
       $$ nest 1 (vcat [symAssocToDoc x | x <- Map.assocs $ symbols ofl2])
     assignmentsDoc = text "Assignments: "
-      $$ nest 1 (vcat $ map toDoc $ assignments ofl2)
+      $$ nest 1 (vcat $ map toDoc $ assignments ofl2) 
+      $$ text "Variants:" $$ nest 2 (vcat $ map variantsDoc $ assignments ofl2)
+    variantsDoc (AssignPsinc a b) = vcat $ map toDoc $ generateVariants ofl2 b
+    variantsDoc (AssignScalar a b) = vcat $ map toDoc $ generateVariants ofl2 b
     symAssocToDoc (name, ValueTag baseType indexTypes) = text $
       (show baseType) ++ " " ++ name ++ case indexTypes of
         [] -> ""
@@ -500,26 +563,3 @@ theoreticalFrequency _ (ConstComplex _) = GMaxMultiple 0
 theoreticalFrequency ofl2 (Power a b) = case (theoreticalFrequency ofl2 a, theoreticalFrequency ofl2 b) of
   (GMaxMultiple 0, GMaxMultiple 0) -> GMaxMultiple 0
   _ -> error "Expected power operator to be between scalars."
-
--- fixScalarExpression :: OFL2 -> Expression ScalarE -> Expression ScalarE
--- fixScalarExpression _ e@(IndexedScalarIdentifier _ _) = e
--- fixScalarExpression ofl2 (Integrate f) = Integrate $ fixIntegrand ofl2 f
--- fixScalarExpression ofl2 (Power a b) = Power (fixScalarExpression ofl2 a) (fixScalarExpression ofl2 b)
--- fixScalarExpression ofl2 (Sum e index) = Sum (fixScalarExpression ofl2 e) index
--- fixScalarExpression ofl2 (Add a b) = Add (fixScalarExpression ofl2 a) (fixScalarExpression ofl2 b)
--- fixScalarExpression ofl2 (Sub a b) = Add (fixScalarExpression ofl2 a) (fixScalarExpression ofl2 b)
--- fixScalarExpression ofl2 (Neg e) = Neg (fixScalarExpression ofl2 e)
--- fixScalarExpression ofl2 (MulScalar a b) = Add (fixScalarExpression ofl2 a) (fixScalarExpression ofl2 b)
--- fixScalarExpression ofl2 (DivScalar a b) = Add (fixScalarExpression ofl2 a) (fixScalarExpression ofl2 b)
--- fixScalarExpression _ e@(ConstInteger _) = e
--- fixScalarExpression _ e@(ConstReal _) = e
--- fixScalarExpression _ e@(ConstComplex _) = e
--- 
--- fixIntegrand :: OFL2 -> Expression PsincE -> Expression PsincE
--- fixIntegrand _ _ = error "Unimplemented"
--- 
--- fixPositionExpression :: OFL2 -> Expression PsincE -> Expression PsincE
--- fixPositionExpression _ _  = error "Unimplemented"
--- 
--- fixMomentumExpression :: OFL2 -> Expression PsincReciprocalE -> Expression PsincReciprocalE
--- fixMomentumExpression _ _  = error "Unimplemented"