mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
fix: don't type check untyped forms in set! (#1209)
This commit is contained in:
parent
764a61151d
commit
4b4db25984
11
src/Eval.hs
11
src/Eval.hs
@ -1048,16 +1048,19 @@ specialCommandSet ctx [orig@(XObj (Sym path@(SymPath _ _) _) _ _), val] =
|
||||
evalAndSet :: Binder -> (Context -> Env -> Either EvalError XObj -> Binder -> IO (Context, Either EvalError XObj)) -> Env -> IO (Context, Either EvalError XObj)
|
||||
evalAndSet binder setter env =
|
||||
case xobjTy (binderXObj binder) of
|
||||
-- don't type check dynamic bindings
|
||||
Just DynamicTy ->
|
||||
evalDynamic ResolveLocal ctx val
|
||||
>>= \(newCtx, result) -> setter newCtx env result binder
|
||||
-- don't type check dynamic or untyped bindings
|
||||
-- TODO: Figure out why untyped cases are sometimes coming into set!
|
||||
Just DynamicTy -> handleUnTyped
|
||||
Nothing -> handleUnTyped
|
||||
_ ->
|
||||
evalDynamic ResolveLocal ctx val
|
||||
>>= \(newCtx, result) ->
|
||||
case result of
|
||||
Right evald -> typeCheckValueAgainstBinder newCtx evald binder >>= \(nctx, typedVal) -> setter nctx env typedVal binder
|
||||
left -> pure (newCtx, left)
|
||||
where handleUnTyped :: IO (Context, Either EvalError XObj)
|
||||
handleUnTyped = evalDynamic ResolveLocal ctx val
|
||||
>>= \(newCtx, result) -> setter newCtx env result binder
|
||||
setGlobal :: Context -> Env -> Either EvalError XObj -> Binder -> IO (Context, Either EvalError XObj)
|
||||
setGlobal ctx' env value binder =
|
||||
pure $ either (failure ctx' orig) (success ctx') value
|
||||
|
Loading…
Reference in New Issue
Block a user