diff --git a/src/compiler/GF/Compile/Compute/Concrete.hs b/src/compiler/GF/Compile/Compute/Concrete.hs index 3a25df75f..3dd8f676c 100644 --- a/src/compiler/GF/Compile/Compute/Concrete.hs +++ b/src/compiler/GF/Compile/Compute/Concrete.hs @@ -503,11 +503,18 @@ susp i env ki = EvalM $ \gr k mt d r msgs -> do value2term xs (VApp q tnks) = foldM (\e1 tnk -> fmap (App e1) (tnk2term xs tnk)) (if fst q == cPredef then Q q else QC q) tnks -value2term xs (VMeta m env tnks) = do - res <- zonk xs m tnks - case res of - Right i -> foldM (\e1 tnk -> fmap (App e1) (tnk2term xs tnk)) (Meta i) tnks - Left v -> value2term xs v +value2term xs (VMeta m env vs) = do + s <- getRef m + case s of + Evaluated _ v -> do v <- apply v vs + value2term xs v + Unevaluated env t -> do v <- eval env t vs + value2term xs v + Bound t -> do v <- eval env t vs + value2term xs v + Hole i -> foldM (\e1 tnk -> fmap (App e1) (tnk2term xs tnk)) (Meta i) vs + Residuation i _ _ -> foldM (\e1 tnk -> fmap (App e1) (tnk2term xs tnk)) (Meta i) vs + Narrowing i _ -> foldM (\e1 tnk -> fmap (App e1) (tnk2term xs tnk)) (Meta i) vs value2term xs (VSusp j env k vs) = do v <- k (VGen maxBound vs) value2term xs v @@ -896,16 +903,3 @@ tnk2term xs tnk = EvalM $ \gr k mt d r msgs -> Narrowing i _ -> k (Meta i) mt d r msgs scopeEnv scope = zipWithM (\x i -> newEvaluatedThunk (VGen i []) >>= \tnk -> return (x,tnk)) (reverse scope) [0..] - -zonk scope tnk vs = EvalM $ \gr k mt d r msgs -> do - s <- readSTRef tnk - case s of - Evaluated _ v -> case apply v vs of - EvalM f -> f gr (k . Left) mt d r msgs - Unevaluated env t -> case eval env t vs of - EvalM f -> f gr (k . Left) mt d r msgs - Bound t -> case scopeEnv scope >>= \env -> eval env t vs of - EvalM f -> f gr (k . Left) mt d r msgs - Hole i -> k (Right i) mt d r msgs - Residuation i _ _ -> k (Right i) mt d r msgs - Narrowing i _ -> k (Right i) mt d r msgs