-- 
-- (c) Susumu Katayama
--
\begin{code}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS -cpp #-}
module MagicHaskeller.ProgGen(ProgGen(PG), mkCL, ClassLib(..), mguPrograms) where

import MagicHaskeller.Types
import MagicHaskeller.TyConLib
import Control.Monad
import Data.Monoid
import MagicHaskeller.CoreLang
import Control.Monad.Search.Combinatorial
import MagicHaskeller.PriorSubsts
import Data.List(partition, sortBy, genericLength)
import Data.Ix(inRange)

import MagicHaskeller.ProgramGenerator
import MagicHaskeller.Options(Opt(..))

import MagicHaskeller.Classify
import MagicHaskeller.Instantiate

import MagicHaskeller.Expression

import MagicHaskeller.T10
import qualified Data.Map as Map

import MagicHaskeller.DebMT

import Debug.Trace

import MagicHaskeller.MemoToFiles hiding (freezePS,fps)

traceTy :: p -> a -> a
traceTy p
_    = a -> a
forall a. a -> a
id
-- traceTy fty = trace ("lookup "++ show fty)


type BF = Recomp
-- type BF = DBound

type BFM = Matrix
-- type BFM = DBMemo
fromMemo :: Search m => Matrix a -> m a
fromMemo :: Matrix a -> m a
fromMemo = Matrix a -> m a
forall (m :: * -> *) a. Search m => Matrix a -> m a
fromMx
toMemo :: Search m => m a -> Matrix a
toMemo :: m a -> Matrix a
toMemo = m a -> Matrix a
forall (m :: * -> *) a. Search m => m a -> Matrix a
toMx


-- Memoization table, created from primitive components

-- | The vanilla program generator corresponding to Version 0.7.*
newtype ProgGen = PG (MemoDeb (ClassLib CoreExpr) CoreExpr) -- ^ internal data representation
newtype ClassLib e = CL (MemoDeb (ClassLib e) e)
-- mapStrTyCon :: Search m => MemoDeb c m CoreExpr -> Map.Map String TyCon
-- mapStrTyCon = fst . extractTCL . PG

type MemoTrie a = MapType (BFM (Possibility a))

lmt :: MapType a -> Type -> a
lmt MapType a
mt Type
fty =
       Type -> a -> a
forall p a. p -> a -> a
traceTy Type
fty (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
       MapType a -> Type -> a
forall a. MapType a -> Type -> a
lookupMT MapType a
mt Type
fty

lookupFunsShared :: (Search m) => Generator m CoreExpr -> Generator m CoreExpr
lookupFunsShared :: Generator m CoreExpr -> Generator m CoreExpr
lookupFunsShared Generator m CoreExpr
behalf memodeb :: MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb@(ClassLib CoreExpr
_,MemoTrie CoreExpr
mt,([[Prim]], [[Prim]])
_,Common
cmn) [Type]
avail Type
reqret
    = let annAvails :: [(Int8, Type)]
annAvails = [Int8] -> [Type] -> [(Int8, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int8
0..] [Type]
avail
      in ([(Int8, Type)] -> Int8 -> m (Bag CoreExpr, [(Int8, Type)], Int8))
-> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) a.
([(Int8, Type)] -> Int8 -> m (a, [(Int8, Type)], Int8))
-> PriorSubsts m a
PS (\[(Int8, Type)]
subst Int8
mx -> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *) a. Search m => Recomp a -> m a
fromRc (Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
 -> m (Bag CoreExpr, [(Int8, Type)], Int8))
-> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
forall a b. (a -> b) -> a -> b
$ (Int -> Bag (Bag CoreExpr, [(Int8, Type)], Int8))
-> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
forall a. (Int -> Bag a) -> Recomp a
Rc ((Int -> Bag (Bag CoreExpr, [(Int8, Type)], Int8))
 -> Recomp (Bag CoreExpr, [(Int8, Type)], Int8))
-> (Int -> Bag (Bag CoreExpr, [(Int8, Type)], Int8))
-> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
forall a b. (a -> b) -> a -> b
$ \Int
d ->[Bag (Bag CoreExpr, [(Int8, Type)], Int8)]
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ let (Type
tn, Decoder
decoder) = Type -> Int8 -> (Type, Decoder)
encode ([Type] -> Type -> Type
popArgs [Type]
newavails Type
reqret) Int8
mx in ((Bag CoreExpr, [(Int8, Type)], Int8)
 -> (Bag CoreExpr, [(Int8, Type)], Int8))
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
forall a b. (a -> b) -> [a] -> [b]
map ([Int8]
-> (Bag CoreExpr, [(Int8, Type)], Int8)
-> (Bag CoreExpr, [(Int8, Type)], Int8)
forall b c. [Int8] -> (Bag CoreExpr, b, c) -> (Bag CoreExpr, b, c)
decodeVarsPos [Int8]
ixs) (Bag (Bag CoreExpr, [(Int8, Type)], Int8)
 -> Bag (Bag CoreExpr, [(Int8, Type)], Int8))
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
forall a b. (a -> b) -> a -> b
$ ((Bag CoreExpr, [(Int8, Type)], Int8)
 -> (Bag CoreExpr, [(Int8, Type)], Int8))
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
forall a b. (a -> b) -> [a] -> [b]
map (\ (Bag CoreExpr
exprs, [(Int8, Type)]
sub, Int8
m) -> (Bag CoreExpr
exprs, Decoder -> [(Int8, Type)] -> [(Int8, Type)]
retrieve Decoder
decoder [(Int8, Type)]
sub [(Int8, Type)] -> [(Int8, Type)] -> [(Int8, Type)]
`plusSubst` [(Int8, Type)]
subst, Int8
mxInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
m)) (Bag (Bag CoreExpr, [(Int8, Type)], Int8)
 -> Bag (Bag CoreExpr, [(Int8, Type)], Int8))
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
-> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
forall a b. (a -> b) -> a -> b
$ Matrix (Bag CoreExpr, [(Int8, Type)], Int8)
-> [Bag (Bag CoreExpr, [(Int8, Type)], Int8)]
forall a. Matrix a -> Stream (Bag a)
unMx (MemoTrie CoreExpr
-> Type -> Matrix (Bag CoreExpr, [(Int8, Type)], Int8)
forall a. MapType a -> Type -> a
lmt MemoTrie CoreExpr
mt Type
tn) [Bag (Bag CoreExpr, [(Int8, Type)], Int8)]
-> Int -> Bag (Bag CoreExpr, [(Int8, Type)], Int8)
forall a. [a] -> Int -> a
!! Int
d | [(Int8, Type)]
annAvs <- Int -> [(Int8, Type)] -> [[(Int8, Type)]]
forall t a. (Eq t, Num t) => t -> [a] -> [[a]]
combs (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Int8, Type)]
annAvails, let ([Int8]
ixs, [Type]
newavails) = [(Int8, Type)] -> ([Int8], [Type])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Int8, Type)]
annAvs ] :: [Possibility CoreExpr])

lookupFunsPoly :: (Search m, Expression e) => Generator m e -> Generator m e
lookupFunsPoly :: Generator m e -> Generator m e
lookupFunsPoly Generator m e
behalf memodeb :: MemoDeb (ClassLib e) e
memodeb@(ClassLib e
_,MemoTrie e
mt,([[Prim]], [[Prim]])
_,Common
cmn) [Type]
avail Type
reqret
    = ([(Int8, Type)] -> Int8 -> m (Bag e, [(Int8, Type)], Int8))
-> PriorSubsts m (Bag e)
forall (m :: * -> *) a.
([(Int8, Type)] -> Int8 -> m (a, [(Int8, Type)], Int8))
-> PriorSubsts m a
PS (\[(Int8, Type)]
subst Int8
mx ->
              let (Type
tn, Decoder
decoder) = Type -> Int8 -> (Type, Decoder)
encode ([Type] -> Type -> Type
popArgs [Type]
avail Type
reqret) Int8
mx
              in (Int -> Bool)
-> m (Bag e, [(Int8, Type)], Int8)
-> m (Bag e, [(Int8, Type)], Int8)
-> m (Bag e, [(Int8, Type)], Int8)
forall (m :: * -> *) a.
Search m =>
(Int -> Bool) -> m a -> m a -> m a
ifDepth (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Opt () -> Int
forall a. Opt a -> Int
memodepth (Common -> Opt ()
opt Common
cmn))
                         (((Bag e, [(Int8, Type)], Int8) -> (Bag e, [(Int8, Type)], Int8))
-> m (Bag e, [(Int8, Type)], Int8)
-> m (Bag e, [(Int8, Type)], Int8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (Bag e
exprs, [(Int8, Type)]
sub, Int8
m) -> (Bag e
exprs, Decoder -> [(Int8, Type)] -> [(Int8, Type)]
retrieve Decoder
decoder [(Int8, Type)]
sub [(Int8, Type)] -> [(Int8, Type)] -> [(Int8, Type)]
`plusSubst` [(Int8, Type)]
subst, Int8
mxInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
m)) (m (Bag e, [(Int8, Type)], Int8)
 -> m (Bag e, [(Int8, Type)], Int8))
-> m (Bag e, [(Int8, Type)], Int8)
-> m (Bag e, [(Int8, Type)], Int8)
forall a b. (a -> b) -> a -> b
$ Matrix (Bag e, [(Int8, Type)], Int8)
-> m (Bag e, [(Int8, Type)], Int8)
forall (m :: * -> *) a. Search m => Matrix a -> m a
fromMemo (Matrix (Bag e, [(Int8, Type)], Int8)
 -> m (Bag e, [(Int8, Type)], Int8))
-> Matrix (Bag e, [(Int8, Type)], Int8)
-> m (Bag e, [(Int8, Type)], Int8)
forall a b. (a -> b) -> a -> b
$ MemoTrie e -> Type -> Matrix (Bag e, [(Int8, Type)], Int8)
forall a. MapType a -> Type -> a
lmt MemoTrie e
mt Type
tn)
                         (PriorSubsts m (Bag e)
-> [(Int8, Type)] -> Int8 -> m (Bag e, [(Int8, Type)], Int8)
forall (m :: * -> *) a.
PriorSubsts m a
-> [(Int8, Type)] -> Int8 -> m (a, [(Int8, Type)], Int8)
unPS (Generator m e
behalf MemoDeb (ClassLib e) e
memodeb [Type]
avail Type
reqret) [(Int8, Type)]
subst Int8
mx) )

instance WithCommon ProgGen where
    extractCommon :: ProgGen -> Common
extractCommon     (PG (ClassLib CoreExpr
_,MemoTrie CoreExpr
_,([[Prim]], [[Prim]])
_,Common
cmn)) = Common
cmn
instance ProgramGenerator ProgGen where
    mkTrie :: Common
-> [Typed (Bag CoreExpr)] -> [[Typed (Bag CoreExpr)]] -> ProgGen
mkTrie Common
cmn [Typed (Bag CoreExpr)]
classes [[Typed (Bag CoreExpr)]]
tces = Common
-> [Typed (Bag CoreExpr)] -> [[Typed (Bag CoreExpr)]] -> ProgGen
mkTriePG Common
cmn [Typed (Bag CoreExpr)]
classes [[Typed (Bag CoreExpr)]]
tces
    unifyingPrograms :: Type -> ProgGen -> m AnnExpr
unifyingPrograms   Type
ty (PG x :: MemoDeb (ClassLib CoreExpr) CoreExpr
x@(ClassLib CoreExpr
_,MemoTrie CoreExpr
_,([[Prim]], [[Prim]])
_,Common
cmn)) = Recomp AnnExpr -> m AnnExpr
forall (m :: * -> *) a. Search m => Recomp a -> m a
fromRc (Recomp AnnExpr -> m AnnExpr) -> Recomp AnnExpr -> m AnnExpr
forall a b. (a -> b) -> a -> b
$ (CoreExpr -> AnnExpr) -> Recomp CoreExpr -> Recomp AnnExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr
forall e. Expression e => (CoreExpr -> Dynamic) -> e -> AnnExpr
toAnnExpr ((CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr)
-> (CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr
forall a b. (a -> b) -> a -> b
$ Common -> CoreExpr -> Dynamic
reducer Common
cmn) (Recomp CoreExpr -> Recomp AnnExpr)
-> Recomp CoreExpr -> Recomp AnnExpr
forall a b. (a -> b) -> a -> b
$ Recomp (Bag CoreExpr) -> Recomp CoreExpr
forall (m :: * -> *) a. Search m => m (Bag a) -> m a
catBags (Recomp (Bag CoreExpr) -> Recomp CoreExpr)
-> Recomp (Bag CoreExpr) -> Recomp CoreExpr
forall a b. (a -> b) -> a -> b
$ ((Bag CoreExpr, [(Int8, Type)], Int8) -> Bag CoreExpr)
-> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
-> Recomp (Bag CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (Bag CoreExpr
es,[(Int8, Type)]
_,Int8
_) -> Bag CoreExpr
es) (Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
 -> Recomp (Bag CoreExpr))
-> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
-> Recomp (Bag CoreExpr)
forall a b. (a -> b) -> a -> b
$ Type
-> MemoDeb (ClassLib CoreExpr) CoreExpr
-> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *).
Search m =>
Type
-> MemoDeb (ClassLib CoreExpr) CoreExpr
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
unifyingPossibilities   Type
ty MemoDeb (ClassLib CoreExpr) CoreExpr
x
instance ProgramGeneratorIO ProgGen where
    mkTrieIO :: Common
-> [Typed (Bag CoreExpr)] -> [[Typed (Bag CoreExpr)]] -> IO ProgGen
mkTrieIO Common
cmn [Typed (Bag CoreExpr)]
classes [[Typed (Bag CoreExpr)]]
tces = ProgGen -> IO ProgGen
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgGen -> IO ProgGen) -> ProgGen -> IO ProgGen
forall a b. (a -> b) -> a -> b
$ Common
-> [Typed (Bag CoreExpr)] -> [[Typed (Bag CoreExpr)]] -> ProgGen
mkTriePG Common
cmn [Typed (Bag CoreExpr)]
classes [[Typed (Bag CoreExpr)]]
tces
    unifyingProgramsIO :: Type -> ProgGen -> RecompT IO AnnExpr
unifyingProgramsIO Type
ty (PG x :: MemoDeb (ClassLib CoreExpr) CoreExpr
x@(ClassLib CoreExpr
_,MemoTrie CoreExpr
_,([[Prim]], [[Prim]])
_,Common
cmn)) = (CoreExpr -> AnnExpr) -> RecompT IO CoreExpr -> RecompT IO AnnExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr
forall e. Expression e => (CoreExpr -> Dynamic) -> e -> AnnExpr
toAnnExpr ((CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr)
-> (CoreExpr -> Dynamic) -> CoreExpr -> AnnExpr
forall a b. (a -> b) -> a -> b
$ Common -> CoreExpr -> Dynamic
reducer Common
cmn) (RecompT IO CoreExpr -> RecompT IO AnnExpr)
-> RecompT IO CoreExpr -> RecompT IO AnnExpr
forall a b. (a -> b) -> a -> b
$ RecompT IO (Bag CoreExpr) -> RecompT IO CoreExpr
forall (m :: * -> *) a. Search m => m (Bag a) -> m a
catBags (RecompT IO (Bag CoreExpr) -> RecompT IO CoreExpr)
-> RecompT IO (Bag CoreExpr) -> RecompT IO CoreExpr
forall a b. (a -> b) -> a -> b
$ ((Bag CoreExpr, [(Int8, Type)], Int8) -> Bag CoreExpr)
-> RecompT IO (Bag CoreExpr, [(Int8, Type)], Int8)
-> RecompT IO (Bag CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (Bag CoreExpr
es,[(Int8, Type)]
_,Int8
_) -> Bag CoreExpr
es) (RecompT IO (Bag CoreExpr, [(Int8, Type)], Int8)
 -> RecompT IO (Bag CoreExpr))
-> RecompT IO (Bag CoreExpr, [(Int8, Type)], Int8)
-> RecompT IO (Bag CoreExpr)
forall a b. (a -> b) -> a -> b
$ Type
-> MemoDeb (ClassLib CoreExpr) CoreExpr
-> RecompT IO (Bag CoreExpr, [(Int8, Type)], Int8)
unifyingPossibilitiesIO Type
ty MemoDeb (ClassLib CoreExpr) CoreExpr
x

unifyingPossibilities :: Search m => Type -> MemoDeb (ClassLib CoreExpr) CoreExpr -> m ([CoreExpr],Subst,TyVar)
unifyingPossibilities :: Type
-> MemoDeb (ClassLib CoreExpr) CoreExpr
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
unifyingPossibilities Type
ty MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb = PriorSubsts m (Bag CoreExpr)
-> [(Int8, Type)] -> Int8 -> m (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *) a.
PriorSubsts m a
-> [(Int8, Type)] -> Int8 -> m (a, [(Int8, Type)], Int8)
unPS (Generator m CoreExpr
forall (m :: * -> *). Search m => Generator m CoreExpr
mguProgs MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb [] Type
ty) [(Int8, Type)]
forall a. [a]
emptySubst Int8
0

unifyingPossibilitiesIO :: Type -> MemoDeb (ClassLib CoreExpr) CoreExpr -> RecompT IO ([CoreExpr],Subst,TyVar)
unifyingPossibilitiesIO :: Type
-> MemoDeb (ClassLib CoreExpr) CoreExpr
-> RecompT IO (Bag CoreExpr, [(Int8, Type)], Int8)
unifyingPossibilitiesIO Type
ty MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb = PriorSubsts (RecompT IO) (Bag CoreExpr)
-> [(Int8, Type)]
-> Int8
-> RecompT IO (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *) a.
PriorSubsts m a
-> [(Int8, Type)] -> Int8 -> m (a, [(Int8, Type)], Int8)
unPS (Generator (RecompT IO) CoreExpr
mguProgsIO MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb [] Type
ty) [(Int8, Type)]
forall a. [a]
emptySubst Int8
0

type MemoDeb c a = (c, MemoTrie a, ([[Prim]],[[Prim]]), Common)


mkTriePG :: Common -> [Typed [CoreExpr]] -> [[Typed [CoreExpr]]] -> ProgGen
mkTriePG :: Common
-> [Typed (Bag CoreExpr)] -> [[Typed (Bag CoreExpr)]] -> ProgGen
mkTriePG Common
cmn [Typed (Bag CoreExpr)]
classes [[Typed (Bag CoreExpr)]]
tces =   let qtl :: ([[Prim]], [[Prim]])
qtl = [[Typed (Bag CoreExpr)]] -> ([[Prim]], [[Prim]])
splitPrimss [[Typed (Bag CoreExpr)]]
tces
                                  trie :: MemoDeb (ClassLib CoreExpr) CoreExpr
trie = ClassLib CoreExpr
-> ([[Prim]], [[Prim]])
-> Common
-> MemoDeb (ClassLib CoreExpr) CoreExpr
mkTrieMD (Common -> [Typed (Bag CoreExpr)] -> ClassLib CoreExpr
mkCL Common
cmn [Typed (Bag CoreExpr)]
classes) ([[Prim]], [[Prim]])
qtl Common
cmn
                              in MemoDeb (ClassLib CoreExpr) CoreExpr -> ProgGen
PG MemoDeb (ClassLib CoreExpr) CoreExpr
trie
mkCL :: Common -> [Typed [CoreExpr]] -> ClassLib CoreExpr
mkCL :: Common -> [Typed (Bag CoreExpr)] -> ClassLib CoreExpr
mkCL Common
cmn [Typed (Bag CoreExpr)]
classes = MemoDeb (ClassLib CoreExpr) CoreExpr -> ClassLib CoreExpr
forall e. MemoDeb (ClassLib e) e -> ClassLib e
CL (MemoDeb (ClassLib CoreExpr) CoreExpr -> ClassLib CoreExpr)
-> MemoDeb (ClassLib CoreExpr) CoreExpr -> ClassLib CoreExpr
forall a b. (a -> b) -> a -> b
$ ClassLib CoreExpr
-> ([[Prim]], [[Prim]])
-> Common
-> MemoDeb (ClassLib CoreExpr) CoreExpr
mkTrieMD ClassLib CoreExpr
forall a. HasCallStack => a
undefined ([],[(Typed (Bag CoreExpr) -> Prim) -> [Typed (Bag CoreExpr)] -> [Prim]
forall a b. (a -> b) -> [a] -> [b]
map Typed (Bag CoreExpr) -> Prim
annotateTCEs [Typed (Bag CoreExpr)]
classes]) Common
cmn
mkTrieMD :: ClassLib CoreExpr -> ([[Prim]],[[Prim]]) -> Common -> MemoDeb (ClassLib CoreExpr) CoreExpr
mkTrieMD :: ClassLib CoreExpr
-> ([[Prim]], [[Prim]])
-> Common
-> MemoDeb (ClassLib CoreExpr) CoreExpr
mkTrieMD ClassLib CoreExpr
cl ([[Prim]], [[Prim]])
qtl Common
cmn
    = let trie :: MemoTrie CoreExpr
trie = TyConLib
-> (Type -> Matrix (Bag CoreExpr, [(Int8, Type)], Int8))
-> MemoTrie CoreExpr
forall a. TyConLib -> (Type -> a) -> MapType a
mkMT (Common -> TyConLib
tcl Common
cmn) (\Type
ty -> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
-> Matrix (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *) a. Search m => Recomp a -> m a
fromRc (let ([Type]
avail,Type
t) = Type -> ([Type], Type)
splitArgs Type
ty in Int
-> Type
-> PriorSubsts Recomp (Bag CoreExpr)
-> Recomp (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *).
Search m =>
Int
-> Type
-> PriorSubsts m (Bag CoreExpr)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
freezePS ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
avail) Type
ty (Generator Recomp CoreExpr
forall (m :: * -> *). Search m => Generator m CoreExpr
mguFuns MemoDeb (ClassLib CoreExpr) CoreExpr
memoDeb [Type]
avail Type
t {- :: PriorSubsts BF [e] -})))
          memoDeb :: MemoDeb (ClassLib CoreExpr) CoreExpr
memoDeb = (ClassLib CoreExpr
cl,MemoTrie CoreExpr
trie,([[Prim]], [[Prim]])
qtl,Common
cmn)
      in MemoDeb (ClassLib CoreExpr) CoreExpr
memoDeb

-- moved from DebMT.lhs to avoid cyclic modules.
freezePS :: Search m => Int -> Type -> PriorSubsts m (Bag CoreExpr) -> m (Possibility CoreExpr)
freezePS :: Int
-> Type
-> PriorSubsts m (Bag CoreExpr)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
freezePS Int
arity Type
ty PriorSubsts m (Bag CoreExpr)
ps
    = let mxty :: Int8
mxty = Type -> Int8
maxVarID Type
ty -- `max` maximum (map maxVarID avail)
      in ((Bag CoreExpr, [(Int8, Type)], Int8)
 -> (Bag CoreExpr, [(Int8, Type)], Int8)
 -> (Bag CoreExpr, [(Int8, Type)], Int8))
-> ((Bag CoreExpr, [(Int8, Type)], Int8)
    -> (Bag CoreExpr, [(Int8, Type)], Int8) -> Ordering)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *) k.
Search m =>
(k -> k -> k) -> (k -> k -> Ordering) -> m k -> m k
mergesortDepthWithBy (\(Bag CoreExpr
xs,[(Int8, Type)]
k,Int8
i) (Bag CoreExpr
ys,[(Int8, Type)]
_,Int8
_) -> (Bag CoreExpr
xs Bag CoreExpr -> Bag CoreExpr -> Bag CoreExpr
forall a. Monoid a => a -> a -> a
`mappend` Bag CoreExpr
ys, [(Int8, Type)]
k, Int8
i)) (\(Bag CoreExpr
_,[(Int8, Type)]
k,Int8
_) (Bag CoreExpr
_,[(Int8, Type)]
l,Int8
_) -> [(Int8, Type)]
k [(Int8, Type)] -> [(Int8, Type)] -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` [(Int8, Type)]
l) (m (Bag CoreExpr, [(Int8, Type)], Int8)
 -> m (Bag CoreExpr, [(Int8, Type)], Int8))
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
forall a b. (a -> b) -> a -> b
$ Int
-> Int8
-> PriorSubsts m (Bag CoreExpr)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *).
Search m =>
Int
-> Int8
-> PriorSubsts m (Bag CoreExpr)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
fps Int
arity Int8
mxty PriorSubsts m (Bag CoreExpr)
ps
fps :: Search m => Int -> TyVar -> PriorSubsts m [CoreExpr] -> m ([CoreExpr],[(TyVar, Type)],TyVar)
fps :: Int
-> Int8
-> PriorSubsts m (Bag CoreExpr)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
fps Int
arity Int8
mxty (PS [(Int8, Type)] -> Int8 -> m (Bag CoreExpr, [(Int8, Type)], Int8)
f) = do
                     (Bag CoreExpr
exprs, [(Int8, Type)]
sub, Int8
m) <- [(Int8, Type)] -> Int8 -> m (Bag CoreExpr, [(Int8, Type)], Int8)
f [(Int8, Type)]
forall a. [a]
emptySubst (Int8
mxtyInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1)
                     let es :: Bag CoreExpr
es = (CoreExpr -> Bool) -> Bag CoreExpr -> Bag CoreExpr
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CoreExpr -> Bool) -> CoreExpr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CoreExpr -> Bool
isAbsent Int
arity) Bag CoreExpr
exprs
                     Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bag CoreExpr -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Bag CoreExpr
es Int -> Bool -> Bool
`seq` Bag CoreExpr -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Bag CoreExpr
es
                     (Bag CoreExpr, [(Int8, Type)], Int8)
-> m (Bag CoreExpr, [(Int8, Type)], Int8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag CoreExpr
es, [(Int8, Type)] -> Int8 -> [(Int8, Type)]
filterSubst [(Int8, Type)]
sub Int8
mxty, Int8
m)
    where filterSubst :: Subst -> TyVar -> [(TyVar, Type)]
          filterSubst :: [(Int8, Type)] -> Int8 -> [(Int8, Type)]
filterSubst [(Int8, Type)]
sub  Int8
mx = [ (Int8, Type)
t | t :: (Int8, Type)
t@(Int8
i,Type
_) <- [(Int8, Type)]
sub, (Int8, Int8) -> Int8 -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Int8
0,Int8
mx) Int8
i ] -- note that the assoc list is NOT sorted.


type Generator m e = MemoDeb (ClassLib e) e -> [Type] -> Type -> PriorSubsts m [e]

mguProgramsIO, mguProgsIO :: Generator (RecompT IO) CoreExpr

mguProgramsIO :: Generator (RecompT IO) CoreExpr
mguProgramsIO MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb = ([Type] -> Type -> PriorSubsts (RecompT IO) (Bag CoreExpr))
-> [Type] -> Type -> PriorSubsts (RecompT IO) (Bag CoreExpr)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
([Type] -> Type -> PriorSubsts m a)
-> [Type] -> Type -> PriorSubsts m a
applyDo (Generator (RecompT IO) CoreExpr
mguProgsIO MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb)

mguProgsIO :: Generator (RecompT IO) CoreExpr
mguProgsIO memodeb :: MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb@(ClassLib CoreExpr
_,MemoTrie CoreExpr
mt,([[Prim]], [[Prim]])
_,Common
cmn) = (PriorSubsts (RecompT IO) (Bag CoreExpr)
 -> PriorSubsts (RecompT IO) (Bag CoreExpr))
-> ([Type] -> Type -> PriorSubsts (RecompT IO) (Bag CoreExpr))
-> [Type]
-> Type
-> PriorSubsts (RecompT IO) (Bag CoreExpr)
forall a. (a -> a) -> ([Type] -> Type -> a) -> [Type] -> Type -> a
wind (PriorSubsts (RecompT IO) (Bag CoreExpr)
-> (Bag CoreExpr -> PriorSubsts (RecompT IO) (Bag CoreExpr))
-> PriorSubsts (RecompT IO) (Bag CoreExpr)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bag CoreExpr -> PriorSubsts (RecompT IO) (Bag CoreExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag CoreExpr -> PriorSubsts (RecompT IO) (Bag CoreExpr))
-> (Bag CoreExpr -> Bag CoreExpr)
-> Bag CoreExpr
-> PriorSubsts (RecompT IO) (Bag CoreExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoreExpr -> CoreExpr) -> Bag CoreExpr -> Bag CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CoreExpr -> CoreExpr
Lambda)) (\[Type]
avail Type
reqret -> ([Type] -> PriorSubsts (RecompT IO) (Bag CoreExpr))
-> [Type] -> PriorSubsts (RecompT IO) (Bag CoreExpr)
forall e (m :: * -> *).
(Expression e, Monad m) =>
([Type] -> m [e]) -> [Type] -> m [e]
reorganize (\[Type]
newavail -> (\MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb [Type]
avail Type
reqr -> MemoCond
-> MemoTrie CoreExpr
-> (Type -> PriorSubsts (RecompT IO) (Bag CoreExpr))
-> Type
-> PriorSubsts (RecompT IO) (Bag CoreExpr)
forall b.
ShortString b =>
MemoCond
-> MapType (Matrix (Possibility b))
-> (Type -> PriorSubsts (RecompT IO) [b])
-> Type
-> PriorSubsts (RecompT IO) [b]
memoPSRTIO (Opt () -> MemoCond
forall a. Opt a -> MemoCond
memoCond (Opt () -> MemoCond) -> Opt () -> MemoCond
forall a b. (a -> b) -> a -> b
$ Common -> Opt ()
opt Common
cmn) -- (\_ty _dep -> return (Disk "/tmp/memo/mlist")  {- とりあえずこれでテスト -})
                                                                                                                                                MemoTrie CoreExpr
mt
                                                                                                                                                (\Type
ty -> let ([Type]
av,Type
rr) = Type -> ([Type], Type)
splitArgs Type
ty in Generator (RecompT IO) CoreExpr -> Generator (RecompT IO) CoreExpr
forall (m :: * -> *).
Search m =>
Generator m CoreExpr -> Generator m CoreExpr
generateFuns Generator (RecompT IO) CoreExpr
mguProgramsIO MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb [Type]
av Type
rr)
                                                                                                                                                ([Type] -> Type -> Type
popArgs [Type]
avail Type
reqr)) MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb [Type]
newavail Type
reqret) [Type]
avail)



mguPrograms, mguProgs :: (Search m) => Generator m CoreExpr
mguFuns :: (Search m) => Generator m CoreExpr

mguPrograms :: Generator m CoreExpr
mguPrograms MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb = ([Type] -> Type -> PriorSubsts m (Bag CoreExpr))
-> [Type] -> Type -> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) a.
(Functor m, Monad m) =>
([Type] -> Type -> PriorSubsts m a)
-> [Type] -> Type -> PriorSubsts m a
applyDo (Generator m CoreExpr
forall (m :: * -> *). Search m => Generator m CoreExpr
mguProgs MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb)


mguProgs :: Generator m CoreExpr
mguProgs MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb = (PriorSubsts m (Bag CoreExpr) -> PriorSubsts m (Bag CoreExpr))
-> ([Type] -> Type -> PriorSubsts m (Bag CoreExpr))
-> [Type]
-> Type
-> PriorSubsts m (Bag CoreExpr)
forall a. (a -> a) -> ([Type] -> Type -> a) -> [Type] -> Type -> a
wind (PriorSubsts m (Bag CoreExpr)
-> (Bag CoreExpr -> PriorSubsts m (Bag CoreExpr))
-> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bag CoreExpr -> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bag CoreExpr -> PriorSubsts m (Bag CoreExpr))
-> (Bag CoreExpr -> Bag CoreExpr)
-> Bag CoreExpr
-> PriorSubsts m (Bag CoreExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoreExpr -> CoreExpr) -> Bag CoreExpr -> Bag CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall e. Expression e => (CoreExpr -> CoreExpr) -> e -> e
mapCE CoreExpr -> CoreExpr
Lambda))) (Generator m CoreExpr -> Generator m CoreExpr
forall (m :: * -> *).
Search m =>
Generator m CoreExpr -> Generator m CoreExpr
lookupFunsShared Generator m CoreExpr
forall (m :: * -> *). Search m => Generator m CoreExpr
mguFuns MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb)
--mguProgs memodeb = wind (>>= (return . fmap Lambda)) (\avail reqret -> reorganize (\newavail -> lookupFunsPoly mguFuns memodeb newavail reqret) avail)
{- どっちがわかりやすいかは不明
mguProgs memodeb avail (t0:->t1) = do result <- mguProgs memodeb (t0 : avail) t1
                                      return (fmap Lambda result)
mguProgs memodeb avail reqret = reorganize (\newavail -> lookupFunsPoly mguFuns memodeb newavail reqret) avail
-}

mguFuns :: Generator m CoreExpr
mguFuns MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb = Generator m CoreExpr -> Generator m CoreExpr
forall (m :: * -> *).
Search m =>
Generator m CoreExpr -> Generator m CoreExpr
generateFuns  Generator m CoreExpr
forall (m :: * -> *). Search m => Generator m CoreExpr
mguPrograms MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb

-- MemoDebの型が違うと使えない．
generateFuns :: (Search m) =>
                Generator m CoreExpr                               -- ^ recursive call
                -> Generator m CoreExpr
generateFuns :: Generator m CoreExpr -> Generator m CoreExpr
generateFuns Generator m CoreExpr
rec memodeb :: MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb@(CL MemoDeb (ClassLib CoreExpr) CoreExpr
classLib, MemoTrie CoreExpr
_mt, ([[Prim]]
primgen,[[Prim]]
primmono),Common
cmn) [Type]
avail Type
reqret
    = let clbehalf :: Type -> PriorSubsts m (Bag CoreExpr)
clbehalf  = Generator m CoreExpr
forall (m :: * -> *). Search m => Generator m CoreExpr
mguPrograms MemoDeb (ClassLib CoreExpr) CoreExpr
classLib []
          behalf :: Type -> PriorSubsts m (Bag CoreExpr)
behalf    = Generator m CoreExpr
rec MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb [Type]
avail
          lltbehalf :: Type -> PriorSubsts m (Bag CoreExpr)
lltbehalf = Opt () -> Generator m CoreExpr -> Generator m CoreExpr
forall (m :: * -> *) a a t t t.
(MonadPlus m, Expression a) =>
Opt a -> (t -> t -> t -> m [a]) -> t -> t -> t -> m [a]
lookupListrie (Common -> Opt ()
opt Common
cmn) Generator m CoreExpr
rec MemoDeb (ClassLib CoreExpr) CoreExpr
memodeb [Type]
avail -- heuristic filtration
          lenavails :: Int
lenavails = [Type] -> Int
forall i a. Num i => [a] -> i
genericLength [Type]
avail
--          fe :: Type -> Type -> [CoreExpr] -> [CoreExpr] -- ^ heuristic filtration
          fe :: Type -> Type -> Bag CoreExpr -> Bag CoreExpr
fe        = Bool -> Type -> Type -> Bag CoreExpr -> Bag CoreExpr
forall e. Expression e => Bool -> Type -> Type -> [e] -> [e]
filtExprs (Opt () -> Bool
forall a. Opt a -> Bool
guess (Opt () -> Bool) -> Opt () -> Bool
forall a b. (a -> b) -> a -> b
$ Common -> Opt ()
opt Common
cmn)
          rg :: Common
-> Int
-> (Type -> Type -> Bag CoreExpr -> Bag CoreExpr)
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> Type
-> Prim
-> PriorSubsts m (Bag CoreExpr)
rg        =    if Opt () -> Bool
forall a. Opt a -> Bool
tv0 (Opt () -> Bool) -> Opt () -> Bool
forall a b. (a -> b) -> a -> b
$ Common -> Opt ()
opt Common
cmn then Common
-> Int
-> (Type -> Type -> Bag CoreExpr -> Bag CoreExpr)
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> Type
-> Prim
-> PriorSubsts m (Bag CoreExpr)
forall (n :: * -> *) e j i b c.
(Search n, Expression e, Integral j, Integral i) =>
Common
-> i
-> (Type -> Type -> [e] -> b)
-> (Type -> PriorSubsts n [e])
-> (Type -> PriorSubsts n [e])
-> (Type -> PriorSubsts n [e])
-> Type
-> (j, j, c, Int8, Typed (Bag CoreExpr))
-> PriorSubsts n b
retGenTV0 else
                      if Opt () -> Bool
forall a. Opt a -> Bool
tv1 (Opt () -> Bool) -> Opt () -> Bool
forall a b. (a -> b) -> a -> b
$ Common -> Opt ()
opt Common
cmn then Common
-> Int
-> (Type -> Type -> Bag CoreExpr -> Bag CoreExpr)
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> Type
-> Prim
-> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) e.
(Search m, Expression e) =>
Common
-> Int
-> (Type -> Type -> [e] -> [e])
-> (Type -> PriorSubsts m [e])
-> (Type -> PriorSubsts m [e])
-> (Type -> PriorSubsts m [e])
-> Type
-> Prim
-> PriorSubsts m [e]
retGenTV1 else Common
-> Int
-> (Type -> Type -> Bag CoreExpr -> Bag CoreExpr)
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> Type
-> Prim
-> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) e.
(Search m, Expression e) =>
Common
-> Int
-> (Type -> Type -> [e] -> [e])
-> (Type -> PriorSubsts m [e])
-> (Type -> PriorSubsts m [e])
-> (Type -> PriorSubsts m [e])
-> Type
-> Prim
-> PriorSubsts m [e]
retGen
      in Common
-> Int
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> Type -> PriorSubsts m ())
-> Type
-> [Type]
-> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) e.
(Search m, Expression e) =>
Common
-> Int
-> (Type -> PriorSubsts m [e])
-> (Type -> Type -> PriorSubsts m ())
-> Type
-> [Type]
-> PriorSubsts m [e]
fromAssumptions Common
cmn Int
lenavails Type -> PriorSubsts m (Bag CoreExpr)
behalf Type -> Type -> PriorSubsts m ()
forall (m :: * -> *).
(Functor m, MonadPlus m) =>
Type -> Type -> PriorSubsts m ()
mguPS Type
reqret [Type]
avail PriorSubsts m (Bag CoreExpr)
-> PriorSubsts m (Bag CoreExpr) -> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Prim -> PriorSubsts m (Bag CoreExpr))
-> [[Prim]] -> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) a b.
(MonadPlus m, Delay m) =>
(a -> m b) -> [[a]] -> m b
mapSum (Common
-> Int
-> (Type -> Type -> Bag CoreExpr -> Bag CoreExpr)
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> Type
-> Prim
-> PriorSubsts m (Bag CoreExpr)
rg Common
cmn Int
lenavails Type -> Type -> Bag CoreExpr -> Bag CoreExpr
fe Type -> PriorSubsts m (Bag CoreExpr)
clbehalf Type -> PriorSubsts m (Bag CoreExpr)
lltbehalf Type -> PriorSubsts m (Bag CoreExpr)
behalf Type
reqret) [[Prim]]
primgen PriorSubsts m (Bag CoreExpr)
-> PriorSubsts m (Bag CoreExpr) -> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Prim -> PriorSubsts m (Bag CoreExpr))
-> [[Prim]] -> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) a b.
(MonadPlus m, Delay m) =>
(a -> m b) -> [[a]] -> m b
mapSum (Common
-> Int
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> PriorSubsts m (Bag CoreExpr))
-> (Type -> Type -> PriorSubsts m ())
-> Type
-> Prim
-> PriorSubsts m (Bag CoreExpr)
forall (m :: * -> *) e.
(Search m, Expression e) =>
Common
-> Int
-> (Type -> PriorSubsts m [e])
-> (Type -> PriorSubsts m [e])
-> (Type -> PriorSubsts m [e])
-> (Type -> Type -> PriorSubsts m ())
-> Type
-> Prim
-> PriorSubsts m [e]
retPrimMono Common
cmn Int
lenavails Type -> PriorSubsts m (Bag CoreExpr)
clbehalf Type -> PriorSubsts m (Bag CoreExpr)
lltbehalf Type -> PriorSubsts m (Bag CoreExpr)
behalf Type -> Type -> PriorSubsts m ()
forall (m :: * -> *).
(Functor m, MonadPlus m) =>
Type -> Type -> PriorSubsts m ()
mguPS Type
reqret) [[Prim]]
primmono

lookupListrie :: Opt a -> (t -> t -> t -> m [a]) -> t -> t -> t -> m [a]
lookupListrie Opt a
opt t -> t -> t -> m [a]
rec t
memodeb t
avail t
t
--                      | constrL opt = mguAssumptions t avail
                      | Opt a -> Bool
forall a. Opt a -> Bool
guess Opt a
opt = do [a]
args <- t -> t -> t -> m [a]
rec t
memodeb t
avail t
t
                                       let args' :: [a]
args' = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CoreExpr -> Bool
isClosed(CoreExpr -> Bool) -> (a -> CoreExpr) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> CoreExpr
forall e. Expression e => e -> CoreExpr
toCE) [a]
args
                                       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
args') m ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                                       [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
args'
                      | Bool
otherwise = do [a]
args <- t -> t -> t -> m [a]
rec t
memodeb t
avail t
t
                                       let args' :: [a]
args' = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CoreExpr -> Bool
isConstrExpr(CoreExpr -> Bool) -> (a -> CoreExpr) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> CoreExpr
forall e. Expression e => e -> CoreExpr
toCE) [a]
args
                                       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
args') m ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                                       [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
args'

\end{code}