-{-# LANGUAGE FlexibleInstances, GADTs, EmptyDataDecls, StandaloneDeriving #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, GADTs, EmptyDataDecls, StandaloneDeriving #-}
module OFC.SecondLevel
( SymbolTable
import OFC.Common
import OFC.TargetMapping (MappingTable, FortranFunction)
-import qualified OFC.TargetMapping as TM
import OFC.TopLevel (OFL)
+import qualified OFC.TargetMapping as TM
import qualified OFC.TopLevel as TopLevel
+
import Data.Complex
+import Data.List (foldl', intersperse, intercalate, sortBy)
+import Data.Map (Map)
import Data.Monoid (Monoid(..))
+import Data.Ord (comparing)
import Text.PrettyPrint
-import Data.Map (Map)
-import Data.List (foldl', intersperse, intercalate, sortBy)
import qualified Data.Map as Map
minPsincDensity, maxPsincDensity :: Integer
resampled ofl2 e = e : upsampled e ++ downsampled e ++ bandlimited e where
upsampled x = take (fromInteger $ maxPsincDensity - density x) (tail $ iterate Upsample x)
downsampled x = take (fromInteger $ density x - minPsincDensity) (tail $ iterate Downsample x)
- bandlimited x = concatMap upsampled $ downsampled x
+ bandlimited = concatMap upsampled . downsampled
density x = case getImplementationType ofl2 x of
Right (PositionT (Psinc i)) -> i
Right _ -> error $ "Expected xession " ++ prettyPrint x ++ " to be in a non-analytic basis."
binary a b = unary a + unary b
compareByNumFFTs :: OFL2 -> Expression e -> Expression e -> Ordering
-compareByNumFFTs ofl2 a b = compare aFFTs bFFTs
- where
- aFFTs = numFFTs ofl2 a
- bFFTs = numFFTs ofl2 b
+compareByNumFFTs = comparing . numFFTs
-generateVariants :: (Resamplable e, e ~ Expression a1) => OFL2 -> e -> [e]
+generateVariants :: Resamplable (Expression a) => OFL2 -> Expression a -> [Expression a]
generateVariants ofl2 expr = case expr of
IndexedPsincIdentifier _ _ -> resampled ofl2 expr
IndexedScalarIdentifier _ _ -> resampled ofl2 expr
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]]
+ AnalyticPosition _ -> concatMap (resampled ofl2 . AnalyticToPsinc expr) [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
ConstReal _ -> resampled ofl2 expr
ConstComplex _ -> resampled ofl2 expr
where
- unaryOp :: (Resamplable a, Resamplable r, a ~ Expression a1, r ~ Expression a2)
- => (a -> r) -> a -> [r]
+ unaryOp :: (Resamplable (Expression a), Resamplable (Expression r))
+ => (Expression a -> Expression r) -> Expression a -> [Expression r]
unaryOp constructor e = do
variant <- generateVariants ofl2 e
- validResampling <- validResamplings $ constructor variant
- return validResampling
- binaryOp :: (Resamplable a, Resamplable b, Resamplable r, a ~ Expression a1, b ~ Expression a2, r ~ Expression a3)
- => (a -> b -> r) -> a -> b -> [r]
+ validResamplings $ constructor variant
+ binaryOp :: (Resamplable (Expression a), Resamplable (Expression b), Resamplable (Expression r))
+ => (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
- validResampling <- validResamplings $ constructor variant1 variant2
- return validResampling
- validResamplings :: (Resamplable e, e ~ Expression a1) => e -> [e]
+ validResamplings $ constructor variant1 variant2
+ validResamplings :: (Resamplable (Expression e)) => Expression e -> [Expression e]
validResamplings e = case getImplementationType ofl2 e of
Left _ -> []
Right _ -> resampled ofl2 e