diff options
| author | krasimir <krasimir@chalmers.se> | 2010-03-14 12:21:00 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2010-03-14 12:21:00 +0000 |
| commit | 828fc440291f107b6bf2ec5d5dcc8bc58e987a48 (patch) | |
| tree | 0304d92adea1b2f1124754de12f7290f89bc28b1 /src | |
| parent | db2d9a323820ce793b92adc4cd067949cd598774 (diff) | |
bugfix in PGF.TypeCheck
Diffstat (limited to 'src')
| -rw-r--r-- | src/runtime/haskell/PGF/TypeCheck.hs | 20 |
1 files changed, 12 insertions, 8 deletions
diff --git a/src/runtime/haskell/PGF/TypeCheck.hs b/src/runtime/haskell/PGF/TypeCheck.hs index 3996deef3..2e34bc31c 100644 --- a/src/runtime/haskell/PGF/TypeCheck.hs +++ b/src/runtime/haskell/PGF/TypeCheck.hs @@ -406,14 +406,18 @@ eqType scope k i0 tty1@(TTyp delta1 ty1@(DTyp hyps1 cat1 es1)) tty2@(TTyp delta2 eqValue' k (VSusp i env vs1 c) v2 = addConstraint i0 i env vs1 (\v1 -> eqValue k (c v1) v2) eqValue' k v1 (VSusp i env vs2 c) = addConstraint i0 i env vs2 (\v2 -> eqValue k v1 (c v2)) eqValue' k (VMeta i env1 vs1) (VMeta j env2 vs2) | i == j = zipWithM_ (eqValue k) vs1 vs2 - eqValue' k (VMeta i env1 vs1) v2 = do (MUnbound scopei cs) <- getMeta i - e2 <- mkLam i scopei env1 vs1 v2 - setMeta i (MBound e2) - sequence_ [c e2 | c <- cs] - eqValue' k v1 (VMeta i env2 vs2) = do (MUnbound scopei cs) <- getMeta i - e1 <- mkLam i scopei env2 vs2 v1 - setMeta i (MBound e1) - sequence_ [c e1 | c <- cs] + eqValue' k (VMeta i env1 vs1) v2 = do mv <- getMeta i + case mv of + MUnbound scopei cs -> do e2 <- mkLam i scopei env1 vs1 v2 + setMeta i (MBound e2) + sequence_ [c e2 | c <- cs] + MGuarded e cs x -> setMeta i (MGuarded e ((\e -> apply env1 e vs1 >>= \v1 -> eqValue' k v1 v2) : cs) x) + eqValue' k v1 (VMeta i env2 vs2) = do mv <- getMeta i + case mv of + MUnbound scopei cs -> do e1 <- mkLam i scopei env2 vs2 v1 + setMeta i (MBound e1) + sequence_ [c e1 | c <- cs] + MGuarded e cs x -> setMeta i (MGuarded e ((\e -> apply env2 e vs2 >>= \v2 -> eqValue' k v1 v2) : cs) x) eqValue' k (VApp f1 vs1) (VApp f2 vs2) | f1 == f2 = zipWithM_ (eqValue k) vs1 vs2 eqValue' k (VConst f1 vs1) (VConst f2 vs2) | f1 == f2 = zipWithM_ (eqValue k) vs1 vs2 eqValue' k (VLit l1) (VLit l2 ) | l1 == l2 = return () |