diff options
| author | krasimir <krasimir@chalmers.se> | 2010-10-11 17:18:28 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2010-10-11 17:18:28 +0000 |
| commit | de0354f991acd4cf559aa432cb60c8fcee682ef0 (patch) | |
| tree | c155688fbcbec7c7ad6174ac03505182ba14710a /src/runtime/haskell/PGF/Forest.hs | |
| parent | 3ac637ddcb976a82dced91b36a7ceb5f0ca2ea84 (diff) | |
the exhaustive/random generator now knows how to handle computable functions in the types
Diffstat (limited to 'src/runtime/haskell/PGF/Forest.hs')
| -rw-r--r-- | src/runtime/haskell/PGF/Forest.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/src/runtime/haskell/PGF/Forest.hs b/src/runtime/haskell/PGF/Forest.hs index 7a80a5ea8..a843e7e1d 100644 --- a/src/runtime/haskell/PGF/Forest.hs +++ b/src/runtime/haskell/PGF/Forest.hs @@ -133,9 +133,9 @@ getAbsTrees (Forest abs cnc forest root) arg@(PArg _ fid) ty = case isLindefCId fn of
Just _ -> do arg <- go (Set.insert fid rec_) scope (head args) mb_tty
return (mkAbs arg)
- Nothing -> do tty_fn <- runTcM abs fid (lookupFunType fn)
+ Nothing -> do ty_fn <- runTcM abs fid (lookupFunType fn)
(e,tty0) <- foldM (\(e1,tty) arg -> goArg (Set.insert fid rec_) scope fid e1 arg tty)
- (EFun fn,tty_fn) args
+ (EFun fn,TTyp [] ty_fn) args
case mb_tty of
Just tty -> runTcM abs fid $ do
i <- newGuardedMeta e
@@ -183,7 +183,7 @@ getAbsTrees (Forest abs cnc forest root) arg@(PArg _ fid) ty = | otherwise = [x | PConst _ (EFun x) _ <- maybe [] Set.toList (IntMap.lookup fid forest)]
-newtype TcFM a = TcFM {unTcFM :: MetaStore -> ([(MetaStore,a)],[(FId,TcError)])}
+newtype TcFM a = TcFM {unTcFM :: MetaStore () -> ([(MetaStore (),a)],[(FId,TcError)])}
instance Functor TcFM where
fmap f g = TcFM (\ms -> let (res_g,err_g) = unTcFM g ms
@@ -201,10 +201,10 @@ instance MonadPlus TcFM where (res_g,err_g) = unTcFM g ms
in (res_f++res_g,err_f++err_g))
-runTcM :: Abstr -> FId -> TcM a -> TcFM a
-runTcM abstr fid f = TcFM (\ms -> case unTcM f abstr ms of
- Ok ms x -> ([(ms,x)],[] )
- Fail err -> ([], [(fid,err)]))
+runTcM :: Abstr -> FId -> TcM () a -> TcFM a
+runTcM abstr fid f = TcFM (\ms -> case unTcM f abstr () ms of
+ Ok _ ms x -> ([(ms,x)],[] )
+ Fail err -> ([], [(fid,err)]))
foldForest :: (FunId -> [PArg] -> b -> b) -> (Expr -> [String] -> b -> b) -> b -> FId -> IntMap.IntMap (Set.Set Production) -> b
foldForest f g b fcat forest =
|