diff options
| author | krasimir <krasimir@chalmers.se> | 2009-07-05 16:07:34 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-07-05 16:07:34 +0000 |
| commit | bb3040e2c47d7203a05dd41ff512ae0ee03382d1 (patch) | |
| tree | 96e0e667c7fd0b10b6d0b66738a08ca5d046ea02 | |
| parent | 279ff9a6d28c87e1a6c105d9d33df2511fb8f132 (diff) | |
bugfix in PGF.Expr.apply
| -rw-r--r-- | src/PGF/Expr.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/src/PGF/Expr.hs b/src/PGF/Expr.hs index 23baef67c..c22fa8a08 100644 --- a/src/PGF/Expr.hs +++ b/src/PGF/Expr.hs @@ -290,13 +290,7 @@ eval funs env (EPi x e1 e2)= VClosure env (EPi x e1 e2) apply :: Funs -> Env -> Expr -> [Value] -> Value
apply funs env e [] = eval funs env e
apply funs env (EVar x) vs = case Map.lookup x env of
- Just v -> case (v,vs) of
- (VApp f vs0 , vs) -> apply funs env (EVar f) (vs0++vs)
- (VLit _ , vs) -> error "literal of function type"
- (VMeta i vs0 , vs) -> VMeta i (vs0++vs)
- (VGen i vs0 , vs) -> VGen i (vs0++vs)
- (VSusp i vs0 k , vs) -> VSusp i (vs0++vs) k
- (VClosure env (EAbs x e),v:vs) -> apply funs (Map.insert x v env) e vs
+ Just v -> applyValue funs env v vs
Nothing -> case Map.lookup x funs of
Just (_,a,eqs) -> if a <= length vs
then let (as,vs') = splitAt a vs
@@ -308,6 +302,12 @@ apply funs env (EAbs x e) (v:vs) = apply funs (Map.insert x v env) e vs apply funs env (EMeta k) vs = VMeta k vs
apply funs env (ELit l) vs = error "literal of function type"
+applyValue funs env (VApp f vs0) vs = apply funs env (EVar f) (vs0++vs)
+applyValue funs env (VLit _) vs = error "literal of function type"
+applyValue funs env (VMeta i vs0) vs = VMeta i (vs0++vs)
+applyValue funs env (VGen i vs0) vs = VGen i (vs0++vs)
+applyValue funs env (VSusp i vs0 k) vs = VSusp i vs0 (\v -> applyValue funs env (k v) vs)
+applyValue funs _ (VClosure env (EAbs x e)) (v:vs) = apply funs (Map.insert x v env) e vs
-----------------------------------------------------
-- Pattern matching
|