diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index ba6fe2d43..f4f40774b 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -113,14 +113,13 @@ letrec' name body = do -- | Look up and dereference the given 'Name', throwing an exception for free variables. -variable :: ( Member (Allocator address value) effects - , Member (Reader (Environment address)) effects +variable :: ( Member (Reader (Environment address)) effects , Member (Resumable (EnvironmentError address)) effects , Member (State (Environment address)) effects ) => Name - -> Evaluator address value effects value -variable name = lookupEnv name >>= maybeM (freeVariableError name) >>= deref + -> Evaluator address value effects address +variable name = lookupEnv name >>= maybeM (freeVariableError name) -- Effects diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 01785866c..2aa137fc8 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -53,4 +53,4 @@ defineBuiltins :: ( AbstractValue address value effects ) => Evaluator address value effects () defineBuiltins = - builtin "print" (lambda (\ v -> variable v >>= asString >>= trace . unpack >> box unit)) + builtin "print" (lambda (\ v -> variable v >>= deref >>= asString >>= trace . unpack >> box unit)) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index a5413ebe7..4fbf11402 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -131,7 +131,7 @@ evaluatePackageWith analyzeModule analyzeTerm package evaluateEntryPoint m sym = runInModule (ModuleInfo m) . TermEvaluator $ do reqResult <- require m v <- maybe (box unit) (pure . snd) reqResult - maybe (pure v) ((`call` []) <=< variable) sym + maybe (pure v) ((`call` []) <=< deref <=< variable) sym evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule)) $ do _ <- runInModule moduleInfoFromCallStack (TermEvaluator (defineBuiltins *> (box unit))) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 217456c7b..fb84ec33d 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -54,9 +54,9 @@ instance ToJSONFields1 Send instance Evaluatable Send where eval Send{..} = do let sel = case sendSelector of - Just sel -> subtermValue sel + Just sel -> subtermAddress sel Nothing -> variable (name "call") - func <- maybe sel (deref <=< (flip evaluateInScopedEnv (sel >>= box) . subtermValue)) sendReceiver + func <- deref =<< maybe sel (flip evaluateInScopedEnv sel . subtermValue) sendReceiver Rval <$> call func (map subtermAddress sendArgs) -- TODO pass through sendBlock data Require a = Require { requireRelative :: Bool, requirePath :: !a }