-- 
-- (c) Susumu Katayama
--
{-# LANGUAGE CPP #-}
module MagicHaskeller.Expression(module MagicHaskeller.Expression, module MagicHaskeller.ExprStaged, CoreExpr) where
import MagicHaskeller.CoreLang
import MagicHaskeller.MyDynamic
import MagicHaskeller.Execute
-- import Reduce
import MagicHaskeller.Types
import MagicHaskeller.ExprStaged
import MagicHaskeller.Combinators

import MagicHaskeller.T10
import Control.Monad
import Data.Array((!), array)
import MagicHaskeller.ReadDynamic
import MagicHaskeller.TyConLib(defaultTCL, TyConLib)
-- import Debug.Trace

import MagicHaskeller.Instantiate(RTrie, uncurryDyn, uncurryTy, mkUncurry, mkCurry, curryDyn)
import MagicHaskeller.DebMT

import qualified Data.Set as S
import qualified Data.IntMap as IM

import Data.List
import Data.Array

-- AnnExpr remembers each Dynamic corresponding to the CoreExpr.
data AnnExpr = AE CoreExpr Dynamic deriving Int -> AnnExpr -> ShowS
[AnnExpr] -> ShowS
AnnExpr -> String
(Int -> AnnExpr -> ShowS)
-> (AnnExpr -> String) -> ([AnnExpr] -> ShowS) -> Show AnnExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnnExpr] -> ShowS
$cshowList :: [AnnExpr] -> ShowS
show :: AnnExpr -> String
$cshow :: AnnExpr -> String
showsPrec :: Int -> AnnExpr -> ShowS
$cshowsPrec :: Int -> AnnExpr -> ShowS
Show
instance Eq AnnExpr where
    AnnExpr
a == :: AnnExpr -> AnnExpr -> Bool
== AnnExpr
b = AnnExpr -> CoreExpr
forall e. Expression e => e -> CoreExpr
toCE AnnExpr
a CoreExpr -> CoreExpr -> Bool
forall a. Eq a => a -> a -> Bool
== AnnExpr -> CoreExpr
forall e. Expression e => e -> CoreExpr
toCE AnnExpr
b
instance Ord AnnExpr where
    compare :: AnnExpr -> AnnExpr -> Ordering
compare AnnExpr
a AnnExpr
b = CoreExpr -> CoreExpr -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AnnExpr -> CoreExpr
forall e. Expression e => e -> CoreExpr
toCE AnnExpr
a) (AnnExpr -> CoreExpr
forall e. Expression e => e -> CoreExpr
toCE AnnExpr
b)

-- MemoExpr further memoizes each dynamic function.
data MemoExpr = ME CoreExpr Dynamic -- memo table
                            Dynamic -- memoized function
aeToME :: TyConLib -> RTrie -> Type -> AnnExpr -> MemoExpr
aeToME :: TyConLib -> RTrie -> Type -> AnnExpr -> MemoExpr
aeToME TyConLib
tcl (CmpMap
_,Maps
_,MemoMap
_,Tries
_,MapType (Dynamic, Dynamic)
mtdd) ty :: Type
ty@(Type
_:->Type
_) (AE CoreExpr
ce Dynamic
dyn)
    = case MapType (Dynamic, Dynamic) -> Type -> (Dynamic, Dynamic)
forall a. MapType a -> Type -> a
lookupMT MapType (Dynamic, Dynamic)
mtdd Type
argty of (Dynamic
m,Dynamic
a) -> let me :: MemoExpr
me@(ME CoreExpr
_ Dynamic
memo Dynamic
_) = CoreExpr -> Dynamic -> Dynamic -> MemoExpr
ME CoreExpr
ce (Dynamic -> Dynamic -> Dynamic
dynApp Dynamic
m Dynamic
udyn) (Dynamic -> Type -> Dynamic -> Dynamic
curryDyn Dynamic
cur Type
ty (Dynamic -> Dynamic) -> Dynamic -> Dynamic
forall a b. (a -> b) -> a -> b
$ Dynamic -> Dynamic -> Dynamic
dynApp Dynamic
a Dynamic
memo)
                                           in MemoExpr
me  -- make sure to use the memo table in the datatype by using letrec, or the table will be recomputed.
    where Type
argty:->Type
_ = TyConLib -> Type -> Type
uncurryTy TyConLib
tcl Type
ty
          unc :: Dynamic
unc   = TyConLib -> Dynamic
mkUncurry TyConLib
tcl
          udyn :: Dynamic
udyn  = Dynamic -> Type -> Dynamic -> Dynamic
uncurryDyn Dynamic
unc Type
ty Dynamic
dyn
          cur :: Dynamic
cur   = TyConLib -> Dynamic
mkCurry TyConLib
tcl
aeToME TyConLib
_   RTrie
_              Type
_          (AE CoreExpr
ce Dynamic
dyn) = CoreExpr -> Dynamic -> Dynamic -> MemoExpr
ME CoreExpr
ce Dynamic
forall a. HasCallStack => a
undefined Dynamic
dyn -- non-functional case

meToAE :: MemoExpr -> AnnExpr
meToAE :: MemoExpr -> AnnExpr
meToAE (ME CoreExpr
ce Dynamic
_ Dynamic
f) = CoreExpr -> Dynamic -> AnnExpr
AE CoreExpr
ce Dynamic
f

{-# SPECIALIZE mkHead :: (CoreExpr->Dynamic) -> Int -> Int -> CoreExpr -> e #-}
{-# SPECIALIZE mkHead :: (CoreExpr->Dynamic) -> Int8 -> Int8 -> CoreExpr -> e #-}
class (Ord e, Show e) => Expression e where
    mkHead         :: (Integral i, Integral j) => (CoreExpr->Dynamic) -> i -> j -> j -> CoreExpr -> e
    toCE           :: e -> CoreExpr
    fromCE         :: (CoreExpr -> Dynamic) -> CoreExpr -> e
    mapCE          :: (CoreExpr -> CoreExpr) -> e -> e  -- $B$3$l$bJQ!%(B
    aeAppErr       :: String -> e -> e -> e
    appEnv         :: Int8 -> e -> e -> e
    toAnnExpr      :: (CoreExpr->Dynamic) -> e -> AnnExpr
    toAnnExprWind  :: (CoreExpr->Dynamic) -> Type -> e -> AnnExpr
    toAnnExprWindWind :: (CoreExpr->Dynamic) -> Type -> e -> AnnExpr
    fromAnnExpr    :: AnnExpr -> e
    reorganize     :: Monad m => ([Type] -> m [e]) -> [Type] -> m [e] -- with uniq
    reorganize'    :: Monad m => ([Type] -> m [e]) -> [Type] -> m [e] -- without uniq
    reorganizeId   ::  ([Type] -> [e]) -> [Type] -> [e] -- reorganize for Id monad
    replaceVars' :: Int8 -> e -> [Int8] -> e -- @replaceVars@ without uniq
    reorganizeId' :: (Functor m) => ([Type] -> m e) -> [Type] -> m e
    reorganizeId' [Type] -> m e
fun [Type]
avail = case [Type] -> ([Int8], [Type])
cvtAvails' [Type]
avail of
                                ([Int8]
args, [Type]
newavail) ->
                                  (e -> e) -> m e -> m e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e
e -> Int8 -> e -> [Int8] -> e
forall e. Expression e => Int8 -> e -> [Int8] -> e
replaceVars' Int8
0 e
e [Int8]
args) (m e -> m e) -> m e -> m e
forall a b. (a -> b) -> a -> b
$ [Type] -> m e
fun [Type]
newavail
    decodeVars :: Int -> [Int8] -> e -> e

instance Expression CoreExpr where
    mkHead :: (CoreExpr -> Dynamic) -> i -> j -> j -> CoreExpr -> CoreExpr
mkHead CoreExpr -> Dynamic
_ i
_ j
_ j
_        = CoreExpr -> CoreExpr
forall a. a -> a
id
    toCE :: CoreExpr -> CoreExpr
toCE                  = CoreExpr -> CoreExpr
forall a. a -> a
id
    fromCE :: (CoreExpr -> Dynamic) -> CoreExpr -> CoreExpr
fromCE CoreExpr -> Dynamic
_              = CoreExpr -> CoreExpr
forall a. a -> a
id
    mapCE :: (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
mapCE                 = (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall a. a -> a
id
    aeAppErr :: String -> CoreExpr -> CoreExpr -> CoreExpr
aeAppErr String
_msg         = CoreExpr -> CoreExpr -> CoreExpr
(:$)
    appEnv :: Int8 -> CoreExpr -> CoreExpr -> CoreExpr
appEnv Int8
_              = CoreExpr -> CoreExpr -> CoreExpr
(:$)
    toAnnExpr :: (CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr
toAnnExpr CoreExpr -> Dynamic
reduce CoreExpr
e           = CoreExpr -> Dynamic -> AnnExpr
AE CoreExpr
e (CoreExpr -> Dynamic
reduce CoreExpr
e)
    toAnnExprWind :: (CoreExpr -> Dynamic) -> Type -> CoreExpr -> AnnExpr
toAnnExprWind CoreExpr -> Dynamic
reduce Type
ty CoreExpr
e    = CoreExpr -> Dynamic -> AnnExpr
AE CoreExpr
e (CoreExpr -> Dynamic
reduce (CoreExpr -> Dynamic) -> CoreExpr -> Dynamic
forall a b. (a -> b) -> a -> b
$ Type -> CoreExpr -> CoreExpr
windType Type
ty CoreExpr
e)
    toAnnExprWindWind :: (CoreExpr -> Dynamic) -> Type -> CoreExpr -> AnnExpr
toAnnExprWindWind CoreExpr -> Dynamic
reduce Type
ty CoreExpr
e = let we :: CoreExpr
we = Type -> CoreExpr -> CoreExpr
windType Type
ty CoreExpr
e in CoreExpr -> Dynamic -> AnnExpr
AE CoreExpr
we (CoreExpr -> Dynamic
reduce CoreExpr
we)
    fromAnnExpr :: AnnExpr -> CoreExpr
fromAnnExpr (AE CoreExpr
ce Dynamic
_) = CoreExpr
ce
    reorganize :: ([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
reorganize = ([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
forall (m :: * -> *).
Monad m =>
([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
reorganizer
    reorganize' :: ([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
reorganize' = ([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
forall (m :: * -> *).
Monad m =>
([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
reorganizeCE'
    reorganizeId :: ([Type] -> [CoreExpr]) -> [Type] -> [CoreExpr]
reorganizeId = ([Type] -> [CoreExpr]) -> [Type] -> [CoreExpr]
reorganizerId
    replaceVars' :: Int8 -> CoreExpr -> [Int8] -> CoreExpr
replaceVars' = Int8 -> CoreExpr -> [Int8] -> CoreExpr
replaceVarsCE'
    decodeVars :: Int -> [Int8] -> CoreExpr -> CoreExpr
decodeVars = ([Int8] -> CoreExpr -> CoreExpr)
-> Int -> [Int8] -> CoreExpr -> CoreExpr
forall a b. a -> b -> a
const [Int8] -> CoreExpr -> CoreExpr
decodeVarsCE
instance Expression AnnExpr where
    mkHead :: (CoreExpr -> Dynamic) -> i -> j -> j -> CoreExpr -> AnnExpr
mkHead CoreExpr -> Dynamic
reduce i
lenavails j
numcxts j
arity CoreExpr
ce = (CoreExpr -> Dynamic) -> Int8 -> Int -> Int8 -> CoreExpr -> AnnExpr
mkHeadAE CoreExpr -> Dynamic
reduce (i -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
lenavails) (j -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral j
numcxts) (j -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral j
arity) CoreExpr
ce
    toCE :: AnnExpr -> CoreExpr
toCE ae :: AnnExpr
ae@(AE CoreExpr
ce Dynamic
_)                  = CoreExpr
ce
    fromCE :: (CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr
fromCE                          = (CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr
forall e. Expression e => (CoreExpr -> Dynamic) -> e -> AnnExpr
toAnnExpr
    mapCE :: (CoreExpr -> CoreExpr) -> AnnExpr -> AnnExpr
mapCE CoreExpr -> CoreExpr
f (AE CoreExpr
ce Dynamic
d)               = CoreExpr -> Dynamic -> AnnExpr
AE (CoreExpr -> CoreExpr
f CoreExpr
ce) Dynamic
d
#ifdef REALDYNAMIC
    aeAppErr msg (AE e1 h1) (AE e2 h2) = AE (e1:$e2) (dynAppErr (" while applying "++show e1 ++" to "++show e2 ++ '\n':msg) h1 h2)
#else
    aeAppErr :: String -> AnnExpr -> AnnExpr -> AnnExpr
aeAppErr String
_msg (AE CoreExpr
e1 Dynamic
h1) (AE CoreExpr
e2 Dynamic
h2) = CoreExpr -> Dynamic -> AnnExpr
AE (CoreExpr
e1CoreExpr -> CoreExpr -> CoreExpr
:$CoreExpr
e2) (Dynamic -> Dynamic -> Dynamic
dynApp Dynamic
h1 Dynamic
h2)
#endif
    appEnv :: Int8 -> AnnExpr -> AnnExpr -> AnnExpr
appEnv Int8
lenavails (AE CoreExpr
e1 Dynamic
h1) (AE CoreExpr
e2 Dynamic
h2) = CoreExpr -> Dynamic -> AnnExpr
AE (CoreExpr
e1CoreExpr -> CoreExpr -> CoreExpr
:$CoreExpr
e2) (Dynamic -> Dynamic -> Dynamic
dynApp (Dynamic -> Dynamic -> Dynamic
dynApp (Int8 -> Dynamic
dynSn Int8
lenavails) Dynamic
h1) Dynamic
h2)
    toAnnExpr :: (CoreExpr -> Dynamic) -> AnnExpr -> AnnExpr
toAnnExpr     CoreExpr -> Dynamic
_                 = AnnExpr -> AnnExpr
forall a. a -> a
id
    toAnnExprWind :: (CoreExpr -> Dynamic) -> Type -> AnnExpr -> AnnExpr
toAnnExprWind CoreExpr -> Dynamic
_ Type
_               = AnnExpr -> AnnExpr
forall a. a -> a
id
    toAnnExprWindWind :: (CoreExpr -> Dynamic) -> Type -> AnnExpr -> AnnExpr
toAnnExprWindWind CoreExpr -> Dynamic
_ Type
ty (AE CoreExpr
ce Dynamic
d) = CoreExpr -> Dynamic -> AnnExpr
AE (Type -> CoreExpr -> CoreExpr
windType Type
ty CoreExpr
ce) Dynamic
d
    fromAnnExpr :: AnnExpr -> AnnExpr
fromAnnExpr                     = AnnExpr -> AnnExpr
forall a. a -> a
id
    reorganize :: ([Type] -> m [AnnExpr]) -> [Type] -> m [AnnExpr]
reorganize = ([Type] -> m [AnnExpr]) -> [Type] -> m [AnnExpr]
forall a. a -> a
id
    reorganize' :: ([Type] -> m [AnnExpr]) -> [Type] -> m [AnnExpr]
reorganize' = ([Type] -> m [AnnExpr]) -> [Type] -> m [AnnExpr]
forall a. a -> a
id
    reorganizeId :: ([Type] -> [AnnExpr]) -> [Type] -> [AnnExpr]
reorganizeId = ([Type] -> [AnnExpr]) -> [Type] -> [AnnExpr]
forall a. a -> a
id
    reorganizeId' :: ([Type] -> m AnnExpr) -> [Type] -> m AnnExpr
reorganizeId' = ([Type] -> m AnnExpr) -> [Type] -> m AnnExpr
forall a. a -> a
id -- Well, this is overridden to id because replaceVars' for AnnExpr is not yet implemented.
                    -- $B$F$JLu$G!%<BAu$9$Y$7!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*(B
    decodeVars :: Int -> [Int8] -> AnnExpr -> AnnExpr
decodeVars = Int -> [Int8] -> AnnExpr -> AnnExpr
decodeVarsAE

mapFst3 :: (t -> a) -> (t, b, c) -> (a, b, c)
mapFst3 t -> a
f (t
ces, b
s, c
i) = (t -> a
f t
ces, b
s, c
i)
decodeVarsPos :: [Int8] -> ([CoreExpr], b, c) -> ([CoreExpr], b, c)
decodeVarsPos [Int8]
vs = ([CoreExpr] -> [CoreExpr])
-> ([CoreExpr], b, c) -> ([CoreExpr], b, c)
forall t a b c. (t -> a) -> (t, b, c) -> (a, b, c)
mapFst3 ((CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map ([Int8] -> CoreExpr -> CoreExpr
decodeVarsCE [Int8]
vs))

decodeVarsCE :: [Int8] -> CoreExpr -> CoreExpr
decodeVarsCE :: [Int8] -> CoreExpr -> CoreExpr
decodeVarsCE [Int8]
vs = Int8 -> Array Int8 Int8 -> CoreExpr -> CoreExpr
decodeVarsCE' Int8
0 ((Int8, Int8) -> [Int8] -> Array Int8 Int8
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int8
0, [Int8] -> Int8
forall i a. Num i => [a] -> i
genericLength [Int8]
vsInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
-Int8
1) [Int8]
vs)
decodeVarsCE' :: Int8 -> Array Int8 Int8 -> CoreExpr -> CoreExpr
decodeVarsCE' :: Int8 -> Array Int8 Int8 -> CoreExpr -> CoreExpr
decodeVarsCE' Int8
offset Array Int8 Int8
ar e :: CoreExpr
e@(X Int8
n) = let nn :: Int8
nn = Int8
n Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
offset
                                  in if (Int8, Int8) -> Int8 -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Int8 Int8 -> (Int8, Int8)
forall i e. Array i e -> (i, i)
bounds Array Int8 Int8
ar) Int8
nn then Int8 -> CoreExpr
X (Int8 -> CoreExpr) -> Int8 -> CoreExpr
forall a b. (a -> b) -> a -> b
$ (Array Int8 Int8
ar Array Int8 Int8 -> Int8 -> Int8
forall i e. Ix i => Array i e -> i -> e
! Int8
nn) Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+ Int8
offset else CoreExpr
e
decodeVarsCE' Int8
offset Array Int8 Int8
ar (Lambda CoreExpr
e) = CoreExpr -> CoreExpr
Lambda (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall a b. (a -> b) -> a -> b
$ Int8 -> Array Int8 Int8 -> CoreExpr -> CoreExpr
decodeVarsCE' (Int8
offset Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+ Int8
1) Array Int8 Int8
ar CoreExpr
e
decodeVarsCE' Int8
offset Array Int8 Int8
ar (CoreExpr
f :$ CoreExpr
e)   = Int8 -> Array Int8 Int8 -> CoreExpr -> CoreExpr
decodeVarsCE' Int8
offset Array Int8 Int8
ar CoreExpr
f CoreExpr -> CoreExpr -> CoreExpr
:$ Int8 -> Array Int8 Int8 -> CoreExpr -> CoreExpr
decodeVarsCE' Int8
offset Array Int8 Int8
ar CoreExpr
e
decodeVarsCE' Int8
offset Array Int8 Int8
ar CoreExpr
e          = CoreExpr
e

decodeVarsAE :: Int -> [Int8] -> AnnExpr -> AnnExpr
decodeVarsAE :: Int -> [Int8] -> AnnExpr -> AnnExpr
decodeVarsAE Int
lenav [Int8]
vs (AE CoreExpr
ce Dynamic
dyn) = CoreExpr -> Dynamic -> AnnExpr
AE ([Int8] -> CoreExpr -> CoreExpr
decodeVarsCE [Int8]
vs CoreExpr
ce) (Int -> [Int8] -> Dynamic -> Dynamic
decodeVarsDyn Int
lenav [Int8]
vs Dynamic
dyn)

decodeVarsDyn :: Int -> [Int8] -> Dynamic -> Dynamic
decodeVarsDyn :: Int -> [Int8] -> Dynamic -> Dynamic
decodeVarsDyn Int
lenav [Int8]
vs Dynamic
dyn = Int8 -> [Int8] -> Dynamic
insAbsents (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenav) ((Int8 -> Int8) -> [Int8] -> [Int8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenavInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
-Int8
1Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
-) ([Int8] -> [Int8]) -> [Int8] -> [Int8]
forall a b. (a -> b) -> a -> b
$ [Int8] -> [Int8]
forall a. [a] -> [a]
reverse [Int8]
vs) Dynamic -> Dynamic -> Dynamic
`dynApp` Dynamic
dyn

insAbsents :: Int8 -> [Int8] -> Dynamic
insAbsents :: Int8 -> [Int8] -> Dynamic
insAbsents Int8
lenav [Int8]
ns = -- trace ("insAbsents "++show lenav ++ ' ':show ns) 
                      Int8 -> [Int8] -> Dynamic
ia Int8
0 [Int8]
ns where
  ia :: Int8 -> [Int8] -> Dynamic
ia Int8
i []     | Int8
i Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
==Int8
lenav = Dynamic
dynI
  ia Int8
i (Int8
n:[Int8]
ns) | Int8
i Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
n    = Dynamic
dynB  Dynamic -> Dynamic -> Dynamic
`dynApp` Int8 -> [Int8] -> Dynamic
ia (Int8 -> Int8
forall a. Enum a => a -> a
succ Int8
i) [Int8]
ns 
  ia Int8
i [Int8]
ms                 = Dynamic
dynBK Dynamic -> Dynamic -> Dynamic
`dynApp` Int8 -> [Int8] -> Dynamic
ia (Int8 -> Int8
forall a. Enum a => a -> a
succ Int8
i) [Int8]
ms



(<$>) :: Expression e => e -> e -> e
<$> :: e -> e -> e
(<$>) = String -> e -> e -> e
forall e. Expression e => String -> e -> e -> e
aeAppErr String
""

mkHeadAE :: (CoreExpr -> Dynamic) -> Int8 -> Int -> Int8 -> CoreExpr -> AnnExpr
mkHeadAE CoreExpr -> Dynamic
_      Int8
lenavails Int
_       Int8
arity ce :: CoreExpr
ce@(X Int8
i) = CoreExpr -> Dynamic -> AnnExpr
AE CoreExpr
ce (Int8 -> Int8 -> Int8 -> Dynamic
getDyn_LambdaBoundHead Int8
i Int8
lenavails Int8
arity)    -- Note that 'dynss' and 'dynsss' uses
mkHeadAE CoreExpr -> Dynamic
reduce Int8
lenavails Int
numcxts Int8
arity CoreExpr
ce       = CoreExpr -> Dynamic -> AnnExpr
AE CoreExpr
ce (((Dynamic -> Dynamic) -> Dynamic -> [Dynamic]
forall a. (a -> a) -> a -> [a]
iterate (Dynamic
dynB Dynamic -> Dynamic -> Dynamic
`dynApp`) (Int8 -> Int8 -> Dynamic
getDyn Int8
lenavails Int8
arity) [Dynamic] -> Int -> Dynamic
forall a. [a] -> Int -> a
!! Int
numcxts) Dynamic -> Dynamic -> Dynamic
`dynApp` CoreExpr -> Dynamic
reduce CoreExpr
ce) -- 'unsafeExecute' instead of 'reduce'.

windType :: Type -> CoreExpr -> CoreExpr
windType :: Type -> CoreExpr -> CoreExpr
windType (Type
a:->Type
b) CoreExpr
e = CoreExpr -> CoreExpr
Lambda (Type -> CoreExpr -> CoreExpr
windType Type
b CoreExpr
e)
windType Type
_       CoreExpr
e = CoreExpr
e

-- Sn = \f g x1 .. xn -> f x1 .. xn (g x1 .. xn)
dynSn :: Int8 -> Dynamic
dynSn Int8
lenavails = Dynamic -> Dynamic -> Dynamic
dynApp (Int8 -> Int8 -> Dynamic
getDyn Int8
lenavails Int8
2) Dynamic
dynI

getDyn, mkDyn :: Int8 -> Int8 -> Dynamic
getDyn :: Int8 -> Int8 -> Dynamic
getDyn Int8
lenavails Int8
arity
--    | arity<=maxArity = case lenavails `divMod` maxLenavails of (d,m) -> napply d (dynApp (dynApp dynB (finiteDynar!(maxLenavails,arity)))) (finiteDynar!(m,arity)) -- $B$J$s$+0c$&$_$?$$!%(B
    | Int8
lenavailsInt8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<=Int8
maxLenavails Bool -> Bool -> Bool
&& Int8
arityInt8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<=Int8
maxArity = -- trace (show (lenavails,arity)++show (maxLenavails,maxArity)) $
                                                   Array (Int8, Int8) Dynamic
finiteDynar Array (Int8, Int8) Dynamic -> (Int8, Int8) -> Dynamic
forall i e. Ix i => Array i e -> i -> e
! (Int8
lenavails,Int8
arity)
    | Bool
otherwise                                  = [[Dynamic]]
dynss [[Dynamic]] -> Int8 -> [Dynamic]
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
lenavails [Dynamic] -> Int8 -> Dynamic
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
arity

dynss :: [[Dynamic]]
dynss :: [[Dynamic]]
dynss = [ [ Int8 -> Int8 -> Dynamic
mkDyn Int8
i Int8
j | Int8
j <- [Int8
0..] ] | Int8
i <- [Int8
0..] ]
mkDyn :: Int8 -> Int8 -> Dynamic
mkDyn Int8
0         Int8
_ = Dynamic
dynI
{-
mkDyn lenavails 0 = unsafeExecute (B :$ K) `dynApp` mkDyn (lenavails-1) 0 
mkDyn lenavails arity = unsafeExecute $ mkCE lenavails arity 
-}
-- mkDyn lenavails arity = napply lenavails (dynApp (dynB `dynApp` x arity)) dynI
mkDyn Int8
lenavails Int8
arity = Dynamic -> Dynamic -> Dynamic
dynApp (Dynamic
dynB Dynamic -> Dynamic -> Dynamic
`dynApp` Int8 -> Dynamic
forall t. Integral t => t -> Dynamic
x Int8
arity) (Int8 -> Int8 -> Dynamic
getDyn (Int8
lenavailsInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
-Int8
1) Int8
arity)

-- #ifdef TEMPLATE_HASKELL
-- x n | n<=maxArity = finiteDynar ! (1,n) -- $B$J$s$+0c$&$_$?$$!%(B
-- #else
x :: t -> Dynamic
x t
0 = Dynamic
dynK
x t
1 = Dynamic
dynB
x t
2 = Dynamic
dynS'
-- x 3 = unsafeToDyn (readType "(a->b->c->r)->(x->a)->(x->b)->(x->c)->x->r")    x3      ()
-- #endif
x t
n = t -> (Dynamic -> Dynamic) -> Dynamic -> Dynamic
forall i a. Integral i => i -> (a -> a) -> a -> a
napply t
n (Dynamic -> Dynamic -> Dynamic
dynApp Dynamic
dynB) Dynamic
dynS Dynamic -> Dynamic -> Dynamic
`dynApp` t -> Dynamic
x (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)

finiteDynar :: Array (Int8, Int8) Dynamic
finiteDynar  = ((Int8, Int8), (Int8, Int8))
-> [((Int8, Int8), Dynamic)] -> Array (Int8, Int8) Dynamic
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int8
0,Int8
0),(Int8
maxLenavails,Int8
maxArity)) [ ((Int8
lenavails,Int8
arity), [[Dynamic]]
finiteDynss [[Dynamic]] -> Int8 -> [Dynamic]
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
lenavails [Dynamic] -> Int8 -> Dynamic
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
arity) | Int8
arity<-[Int8
0..Int8
maxArity], Int8
lenavails<-[Int8
0..Int8
maxLenavails] ]
finiteDynarr :: Array (Int8, Int8, Int8) Dynamic
finiteDynarr = ((Int8, Int8, Int8), (Int8, Int8, Int8))
-> [((Int8, Int8, Int8), Dynamic)]
-> Array (Int8, Int8, Int8) Dynamic
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int8
0,Int8
0,Int8
0),(Int8
maxDebindex,Int8
maxLenavails,Int8
maxArity)) [ ((Int8
debindex,Int8
lenavails,Int8
arity), [[[Dynamic]]]
finiteDynsss [[[Dynamic]]] -> Int8 -> [[Dynamic]]
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
debindex [[Dynamic]] -> Int8 -> [Dynamic]
forall i a. Integral i => [a] -> i -> a
`genericIndex` (Int8
lenavailsInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
-Int8
debindexInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
-Int8
1) [Dynamic] -> Int8 -> Dynamic
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
arity) | Int8
arity<-[Int8
0..Int8
maxArity], Int8
debindex<-[Int8
0..Int8
maxDebindex], Int8
lenavails<-[Int8
debindexInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1..Int8
maxLenavails] ]

finiteDynss :: [[Dynamic]]
finiteDynss = ([Type] -> [Any] -> [Exp] -> [Dynamic])
-> [[Type]] -> [[Any]] -> [[Exp]] -> [[Dynamic]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 ((Type -> Any -> Exp -> Dynamic)
-> [Type] -> [Any] -> [Exp] -> [Dynamic]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (TyConLib -> Type -> Any -> Exp -> Dynamic
forall a e. TyConLib -> Type -> a -> e -> Dynamic
unsafeToDyn TyConLib
defaultTCL)) [ [ Int8 -> Int8 -> Type
hdmnty  Int8
arity Int8
lenavails | Int8
arity <- [Int8
0..Int8
maxArity] ] | Int8
lenavails <- [Int8
0..Int8
maxLenavails] ]
                                              [[Any]]
forall a. [[a]]
finiteHVss
                                              [ [ Int8 -> Int8 -> Exp
hdmnTHE Int8
arity Int8
lenavails | Int8
arity <- [Int8
0..Int8
maxArity] ] | Int8
lenavails <- [Int8
0..Int8
maxLenavails] ]
finiteDynsss :: [[[Dynamic]]]
finiteDynsss = ([[Type]] -> [[Any]] -> [[Exp]] -> [[Dynamic]])
-> [[[Type]]] -> [[[Any]]] -> [[[Exp]]] -> [[[Dynamic]]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (([Type] -> [Any] -> [Exp] -> [Dynamic])
-> [[Type]] -> [[Any]] -> [[Exp]] -> [[Dynamic]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 ((Type -> Any -> Exp -> Dynamic)
-> [Type] -> [Any] -> [Exp] -> [Dynamic]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (TyConLib -> Type -> Any -> Exp -> Dynamic
forall a e. TyConLib -> Type -> a -> e -> Dynamic
unsafeToDyn TyConLib
defaultTCL)))
                        [ [ [ Int8 -> Int8 -> Int8 -> Type
aimnty  Int8
debindex Int8
arity Int8
lenavails | Int8
arity <- [Int8
0..Int8
maxArity] ] | Int8
lenavails <- [Int8
debindexInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1..Int8
maxLenavails] ] | Int8
debindex <- [Int8
0..Int8
maxDebindex] ]
                        [[[Any]]]
forall a. [[[a]]]
finiteHVsss
                        [ [ [ Int8 -> Int8 -> Int8 -> Exp
aimnTHE Int8
debindex Int8
arity Int8
lenavails | Int8
arity <- [Int8
0..Int8
maxArity] ] | Int8
lenavails <- [Int8
debindexInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1..Int8
maxLenavails] ] | Int8
debindex <- [Int8
0..Int8
maxDebindex] ]

getDyn_LambdaBoundHead, mkDyn_LambdaBoundHead :: Int8 -> Int8 -> Int8 -> Dynamic
getDyn_LambdaBoundHead :: Int8 -> Int8 -> Int8 -> Dynamic
getDyn_LambdaBoundHead Int8
debindex Int8
lenavails Int8
arity
    | Int8
debindexInt8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<=Int8
maxDebindex Bool -> Bool -> Bool
&& Int8
lenavailsInt8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<=Int8
maxLenavails Bool -> Bool -> Bool
&& Int8
arityInt8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<=Int8
maxArity = -- trace (show (debindex,lenavails,arity)++show (maxDebindex,maxLenavails,maxArity)) $
                                                                            Array (Int8, Int8, Int8) Dynamic
finiteDynarr Array (Int8, Int8, Int8) Dynamic -> (Int8, Int8, Int8) -> Dynamic
forall i e. Ix i => Array i e -> i -> e
! (Int8
debindex,Int8
lenavails,Int8
arity) -- $B$3$C$A$NJ}$,8zN(E*$J$s$@$1$I!$%G%P%C%0Cf$@$10l;~E*$K!%(B
                                                                            -- finiteDynsss !! debindex !! (lenavails-debindex-1) !! arity
    | Bool
otherwise                                  = [[[Dynamic]]]
dynsss [[[Dynamic]]] -> Int8 -> [[Dynamic]]
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
debindex [[Dynamic]] -> Int8 -> [Dynamic]
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
lenavails [Dynamic] -> Int8 -> Dynamic
forall i a. Integral i => [a] -> i -> a
`genericIndex` Int8
arity

dynsss :: [[[Dynamic]]]
dynsss :: [[[Dynamic]]]
dynsss = [ [ [ Int8 -> Int8 -> Int8 -> Dynamic
mkDyn_LambdaBoundHead Int8
i Int8
j Int8
k | Int8
k <- [Int8
0..] ] | Int8
j <- [Int8
0..] ] | Int8
i <- [Int8
0..] ]

mkDyn_LambdaBoundHead :: Int8 -> Int8 -> Int8 -> Dynamic
mkDyn_LambdaBoundHead Int8
debindex Int8
lenavails Int8
arity = (Int8 -> Int8 -> Dynamic
getDyn Int8
lenavails (Int8
arityInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1) Dynamic -> Dynamic -> Dynamic
`dynApp` Dynamic
dynI) Dynamic -> Dynamic -> Dynamic
`dynApp` Int8 -> Int8 -> Dynamic
forall i. Integral i => i -> i -> Dynamic
select Int8
lenavails Int8
debindex
    where
      -- select lenavails debindex = unsafeExecute (napply lenavails Lambda $ X debindex)
      select :: i -> i -> Dynamic
select i
lenavails i
debindex = i -> (Dynamic -> Dynamic) -> Dynamic -> Dynamic
forall i a. Integral i => i -> (a -> a) -> a -> a
napply (i
lenavailsi -> i -> i
forall a. Num a => a -> a -> a
-i
1i -> i -> i
forall a. Num a => a -> a -> a
-i
debindex) (Dynamic -> Dynamic -> Dynamic
dynApp Dynamic
dynK) (Dynamic -> Dynamic) -> Dynamic -> Dynamic
forall a b. (a -> b) -> a -> b
$ i -> (Dynamic -> Dynamic) -> Dynamic -> Dynamic
forall i a. Integral i => i -> (a -> a) -> a -> a
napply i
debindex (Dynamic -> Dynamic -> Dynamic
dynApp Dynamic
dynBK) Dynamic
dynI
dynBK :: Dynamic
dynBK = Dynamic -> Dynamic -> Dynamic
dynApp Dynamic
dynB Dynamic
dynK

-- dynF = dynApp dynC dynK

-- moved from ProgramGenerator.lhs

-- reorganize :: ([Type] -> PriorSubsts BF [CoreExpr]) -> [Type] -> PriorSubsts BF [CoreExpr]
-- $B$H$7$F;H$o$l$k$N$@$,!$FC$K(Bexport$B$5$l$kLu$G$b$J$$$N$G$$$A$$$A(Bspecialize$B$7$J$$!%(B
reorganizer :: Monad m => ([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
reorganizer :: ([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
reorganizer [Type] -> m [CoreExpr]
fun [Type]
avail
    = case [Type] -> ([Type], [[Int8]])
cvtAvails [Type]
avail of
       ([Type]
newavail, [[Int8]]
argss) ->
         do [CoreExpr]
agentExprs <- [Type] -> m [CoreExpr]
fun [Type]
newavail
            [CoreExpr] -> m [CoreExpr]
forall (m :: * -> *) a. Monad m => a -> m a
return [ CoreExpr
result | CoreExpr
e <- [CoreExpr]
agentExprs, CoreExpr
result <- Int8 -> CoreExpr -> [[Int8]] -> [CoreExpr]
replaceVars Int8
0 CoreExpr
e [[Int8]]
argss ]

reorganizerId :: ([Type] -> [CoreExpr]) -> [Type] -> [CoreExpr]
reorganizerId :: ([Type] -> [CoreExpr]) -> [Type] -> [CoreExpr]
reorganizerId [Type] -> [CoreExpr]
fun [Type]
avail
    = case [Type] -> ([Type], [[Int8]])
cvtAvails [Type]
avail of
       ([Type]
newavail, [[Int8]]
argss) ->
           [ CoreExpr
result | CoreExpr
e <- [Type] -> [CoreExpr]
fun [Type]
newavail, CoreExpr
result <- Int8 -> CoreExpr -> [[Int8]] -> [CoreExpr]
replaceVars Int8
0 CoreExpr
e [[Int8]]
argss ]
replaceVars :: Int8 -> CoreExpr -> [[Int8]] -> [CoreExpr]
replaceVars :: Int8 -> CoreExpr -> [[Int8]] -> [CoreExpr]
replaceVars Int8
dep e :: CoreExpr
e@(X Int8
n)    [[Int8]]
argss = case [[Int8]]
argss [[Int8]] -> Int8 -> Maybe [Int8]
forall t a. (Eq t, Num t) => [a] -> t -> Maybe a
!? (Int8
n Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
dep) of Maybe [Int8]
Nothing -> [CoreExpr
e]
                                                              Just [Int8]
xs -> (Int8 -> CoreExpr) -> [Int8] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int8
m -> Int8 -> CoreExpr
X (Int8
m Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+ Int8
dep)) [Int8]
xs
replaceVars Int8
dep (Lambda CoreExpr
e) [[Int8]]
argss = (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> CoreExpr
Lambda (Int8 -> CoreExpr -> [[Int8]] -> [CoreExpr]
replaceVars (Int8
depInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1) CoreExpr
e [[Int8]]
argss)
replaceVars Int8
dep (CoreExpr
f :$ CoreExpr
e)   [[Int8]]
argss = (CoreExpr -> CoreExpr -> CoreExpr)
-> [CoreExpr] -> [CoreExpr] -> [CoreExpr]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 CoreExpr -> CoreExpr -> CoreExpr
(:$) (Int8 -> CoreExpr -> [[Int8]] -> [CoreExpr]
replaceVars Int8
dep CoreExpr
f [[Int8]]
argss) (Int8 -> CoreExpr -> [[Int8]] -> [CoreExpr]
replaceVars Int8
dep CoreExpr
e [[Int8]]
argss)
replaceVars Int8
dep CoreExpr
e          [[Int8]]
argss = [CoreExpr
e]

cvtAvails :: [Type] -> ([Type], [[Int8]])
cvtAvails = [(Type, [Int8])] -> ([Type], [[Int8]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Type, [Int8])] -> ([Type], [[Int8]]))
-> ([Type] -> [(Type, [Int8])]) -> [Type] -> ([Type], [[Int8]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Type, Int8)] -> [(Type, [Int8])]
forall a. [(Type, a)] -> [(Type, [a])]
tkr10 ([(Type, Int8)] -> [(Type, [Int8])])
-> ([Type] -> [(Type, Int8)]) -> [Type] -> [(Type, [Int8])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type] -> [(Type, Int8)]
annotate

tkr10 :: [(Type,a)] -> [(Type,[a])]
tkr10 :: [(Type, a)] -> [(Type, [a])]
tkr10 = ((Type, [a]) -> (Type, [a]) -> (Type, [a]))
-> ((Type, [a]) -> (Type, [a]) -> Ordering)
-> [(Type, [a])]
-> [(Type, [a])]
forall k. (k -> k -> k) -> (k -> k -> Ordering) -> [k] -> [k]
mergesortWithBy (\ (Type
k,[a]
is) (Type
_,[a]
js) -> (Type
k,[a]
is[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
js)) (\ (Type
k,[a]
_) (Type
l,[a]
_) -> Type
k Type -> Type -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Type
l) ([(Type, [a])] -> [(Type, [a])])
-> ([(Type, a)] -> [(Type, [a])]) -> [(Type, a)] -> [(Type, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Type, a) -> (Type, [a])) -> [(Type, a)] -> [(Type, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Type
k,a
i)->(Type
k,[a
i]))


-- annotate$B$O(BsplitAvails$B$NA0=hM}$H$7$F$b;H$($k!%(B
annotate :: [Type] -> [(Type,Int8)]
annotate :: [Type] -> [(Type, Int8)]
annotate [Type]
ts = (Type -> Int8 -> (Type, Int8))
-> [Type] -> [Int8] -> [(Type, Int8)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (,) [Type]
ts [Int8
0..]
{-
annotate ts = an 0 ts
    where an n []     = []
          an n (t:ts) = (t,n) : an (n+1) ts
prop_annotate = \ts -> annotate ts == zipWith (,) ts [0..]
-}




-- @reorganize@ without uniq
reorganizeCE' :: Monad m => ([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
reorganizeCE' :: ([Type] -> m [CoreExpr]) -> [Type] -> m [CoreExpr]
reorganizeCE' [Type] -> m [CoreExpr]
fun [Type]
avail
    = case [Type] -> ([Int8], [Type])
cvtAvails' [Type]
avail of
       ([Int8]
args, [Type]
newavail) ->
         do [CoreExpr]
agentExprs <- [Type] -> m [CoreExpr]
fun [Type]
newavail
            [CoreExpr] -> m [CoreExpr]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Int8 -> CoreExpr -> [Int8] -> CoreExpr
forall e. Expression e => Int8 -> e -> [Int8] -> e
replaceVars' Int8
0 CoreExpr
e [Int8]
args | CoreExpr
e <- [CoreExpr]
agentExprs ]

replaceVarsCE' :: Int8 -> CoreExpr -> [Int8] -> CoreExpr
replaceVarsCE' :: Int8 -> CoreExpr -> [Int8] -> CoreExpr
replaceVarsCE' Int8
dep e :: CoreExpr
e@(X Int8
n)    [Int8]
args = case [Int8]
args [Int8] -> Int8 -> Maybe Int8
forall t a. (Eq t, Num t) => [a] -> t -> Maybe a
!? (Int8
n Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
dep) of Maybe Int8
Nothing -> CoreExpr
e
                                                               Just Int8
m  -> Int8 -> CoreExpr
X (Int8
m Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+ Int8
dep)
replaceVarsCE' Int8
dep (Lambda CoreExpr
e) [Int8]
args = CoreExpr -> CoreExpr
Lambda (Int8 -> CoreExpr -> [Int8] -> CoreExpr
replaceVarsCE' (Int8
depInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1) CoreExpr
e [Int8]
args)
replaceVarsCE' Int8
dep (CoreExpr
f :$ CoreExpr
e)   [Int8]
args = Int8 -> CoreExpr -> [Int8] -> CoreExpr
replaceVarsCE' Int8
dep CoreExpr
f [Int8]
args CoreExpr -> CoreExpr -> CoreExpr
:$ Int8 -> CoreExpr -> [Int8] -> CoreExpr
replaceVarsCE' Int8
dep CoreExpr
e [Int8]
args
replaceVarsCE' Int8
dep CoreExpr
e          [Int8]
args = CoreExpr
e

cvtAvails' :: [Type] -> ([Int8], [Type])
cvtAvails' = [(Int8, Type)] -> ([Int8], [Type])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int8, Type)] -> ([Int8], [Type]))
-> ([Type] -> [(Int8, Type)]) -> [Type] -> ([Int8], [Type])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int8, Type) -> (Int8, Type) -> Ordering)
-> [(Int8, Type)] -> [(Int8, Type)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int8
_,Type
k) (Int8
_,Type
l) -> Type -> Type -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Type
k Type
l) ([(Int8, Type)] -> [(Int8, Type)])
-> ([Type] -> [(Int8, Type)]) -> [Type] -> [(Int8, Type)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int8] -> [Type] -> [(Int8, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int8
0..]





-- Moved from T10
-- uniqSorter :: (Ord e) => [(e,Int)] -> [(e,Int)]
uniqSorter, uniqSortPatAVL :: (Expression e) => [(e,Int)] -> [(e,Int)]
uniqSorter :: [(e, Int)] -> [(e, Int)]
uniqSorter = [(e, Int)] -> [(e, Int)]
forall a b. (Ord a, Ord b) => [(a, b)] -> [(a, b)]
swapUniqSort -- uniqSortPatAVL -- swapUniqSort -- id -- uniqSort

uniqSort, uniqSortAVL :: Ord a => [a] -> [a]
uniqSort :: [a] -> [a]
uniqSort = (a -> a -> a) -> (a -> a -> Ordering) -> [a] -> [a]
forall k. (k -> k -> k) -> (k -> k -> Ordering) -> [k] -> [k]
mergesortWithBy a -> a -> a
forall a b. a -> b -> a
const a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
swapUniqSort :: (Ord a, Ord b) => [(a,b)] -> [(a,b)]
swapUniqSort :: [(a, b)] -> [(a, b)]
swapUniqSort = ((a, b) -> (a, b) -> (a, b))
-> ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall k. (k -> k -> k) -> (k -> k -> Ordering) -> [k] -> [k]
mergesortWithBy (a, b) -> (a, b) -> (a, b)
forall a b. a -> b -> a
const (\(a
a,b
b) (a
c,b
d) -> (b, a) -> (b, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b
b,a
a) (b
d,a
c))

uniqSortAVL :: [a] -> [a]
uniqSortAVL = Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList

--  $B$^$:$O8e$m$N(BInt$B$GJ,$1$k$N$G!$(BIntMap$B$H$N(B2$BCJ9=$((B
-- causes `Stack space overflow' error when used by SimpleServer
uniqSortPatAVL :: [(e, Int)] -> [(e, Int)]
uniqSortPatAVL [(e, Int)]
ts = [ (e
x,Int
j) | (Int
j, Set e
set) <- IntMap (Set e) -> [(Int, Set e)]
forall a. IntMap a -> [(Int, a)]
IM.toList (IntMap (Set e) -> [(Int, Set e)])
-> IntMap (Set e) -> [(Int, Set e)]
forall a b. (a -> b) -> a -> b
$ (Set e -> Set e -> Set e) -> [(Int, Set e)] -> IntMap (Set e)
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith Set e -> Set e -> Set e
forall a. Ord a => Set a -> Set a -> Set a
S.union ([(Int, Set e)] -> IntMap (Set e))
-> [(Int, Set e)] -> IntMap (Set e)
forall a b. (a -> b) -> a -> b
$ ((e, Int) -> (Int, Set e)) -> [(e, Int)] -> [(Int, Set e)]
forall a b. (a -> b) -> [a] -> [b]
map (\(e
x,Int
i) -> (Int
i, e -> Set e
forall a. a -> Set a
S.singleton e
x)) [(e, Int)]
ts
                            , e
x <- Set e -> [e]
forall a. Set a -> [a]
S.toList Set e
set ]

{- The hashing uniqsorters are really problematic. See newnotes on 2012/11/04
annUniqSort :: Expression e => [(e,Int)] -> [(e,Int)]
annUniqSort = map snd  .  mergesortWithBy const (\a b -> compare (fst a) (fst b))  .  map (\t@(ce,_i) -> (fromEnum $ toCE ce, t))
aUS :: Expression e => [e] -> [e]
aUS = map snd  .  mergesortWithBy const (\a b -> compare (fst a) (fst b))  .  map (\e -> (fromEnum $ toCE e, e))
annUniqSortAVL :: (Expression e) => [(e,Int)] -> [(e,Int)]
annUniqSortAVL = IM.elems . IM.fromList . map (\t@(ce,_i) -> (fromEnum $ toCE ce, t))
-- fromEnum$B2?EY$b$d$jD>$9$N$bGO</GO</$7$$5$$b!%(B
-}