mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
refactoring
This commit is contained in:
@@ -503,11 +503,18 @@ susp i env ki = EvalM $ \gr k mt d r msgs -> do
|
|||||||
|
|
||||||
value2term xs (VApp q tnks) =
|
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
|
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
|
value2term xs (VMeta m env vs) = do
|
||||||
res <- zonk xs m tnks
|
s <- getRef m
|
||||||
case res of
|
case s of
|
||||||
Right i -> foldM (\e1 tnk -> fmap (App e1) (tnk2term xs tnk)) (Meta i) tnks
|
Evaluated _ v -> do v <- apply v vs
|
||||||
Left v -> value2term xs v
|
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
|
value2term xs (VSusp j env k vs) = do
|
||||||
v <- k (VGen maxBound vs)
|
v <- k (VGen maxBound vs)
|
||||||
value2term xs v
|
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
|
Narrowing i _ -> k (Meta i) mt d r msgs
|
||||||
|
|
||||||
scopeEnv scope = zipWithM (\x i -> newEvaluatedThunk (VGen i []) >>= \tnk -> return (x,tnk)) (reverse scope) [0..]
|
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
|
|
||||||
|
|||||||
Reference in New Issue
Block a user