From a233b39ae38c2cb5a2328a6ade5e875026a45b1c Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 19 Jun 2018 13:50:56 -0400 Subject: [PATCH] Define builtins & preludes in evaluate. --- src/Data/Abstract/Evaluatable.hs | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index aadc5b1b9..30dacfd6e 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -70,6 +70,8 @@ evaluate :: ( AbstractValue address value (LoopControl address ': Return address , Evaluatable (Base term) , Foldable (Cell address) , FreeVariables term + , HasPrelude lang + , Member Fresh effects , Member (Reader (ModuleTable (NonEmpty (Module (address, Environment address))))) effects , Member (Reader PackageInfo) effects , Member (Reader Span) effects @@ -84,32 +86,37 @@ evaluate :: ( AbstractValue address value (LoopControl address ': Return address , Reducer value (Cell address value) , ValueRoots address value ) - => [NonEmpty (Module term)] + => proxy lang + -> [NonEmpty (Module term)] -> Evaluator address value effects (ModuleTable (NonEmpty (Module (address, Environment address)))) -evaluate [] = ask -evaluate (modules : rest) - = runRest rest +evaluate _ [] = ask +evaluate lang (modules : rest) + = runRest lang rest . runModules' . withPrelude $ \ preludeEnv -> traverse (evalModule preludeEnv) modules where evalModule preludeEnv m = fmap (<$ m) - . runInModule preludeEnv m + . runInModule preludeEnv (moduleInfo m) $ foldSubterms eval (moduleBody m) >>= address - runInModule preludeEnv m - = runReader (moduleInfo m) + runInModule preludeEnv info + = runReader info . runAllocator . runEnv preludeEnv . runReturn . runLoopControl withPrelude f = do - f lowerBound + (_, preludeEnv) <- runInModule lowerBound moduleInfoFromCallStack $ do + defineBuiltins + definePrelude lang + box unit + f preludeEnv - runRest rest action = do + runRest lang rest action = do results <- action - local (<> ModuleTable.fromModules (toList results)) (evaluate rest) + local (<> ModuleTable.fromModules (toList results)) (evaluate lang rest) -- | Evaluate a given package. evaluatePackageWith :: ( AbstractValue address value inner