1
1
mirror of https://github.com/github/semantic.git synced 2024-12-27 00:44:57 +03:00

Use bindAll most places.

This commit is contained in:
Rob Rix 2018-05-30 07:53:54 -04:00
parent d9a0d4dad7
commit d8aa3c9a41
5 changed files with 15 additions and 17 deletions
src/Language

View File

@ -70,7 +70,7 @@ instance Evaluatable Import where
for_ paths $ \path -> do
traceResolve (unPath importPath) path
importedEnv <- maybe emptyEnv fst <$> isolate (require path)
modifyEnv (mergeEnvs importedEnv)
bindAll importedEnv
pure (Rval unit)
@ -94,7 +94,7 @@ instance Evaluatable QualifiedImport where
for_ paths $ \p -> do
traceResolve (unPath importPath) p
importedEnv <- maybe emptyEnv fst <$> isolate (require p)
modifyEnv (mergeEnvs importedEnv)
bindAll importedEnv
makeNamespace alias addr Nothing
pure (Rval unit)

View File

@ -54,11 +54,10 @@ resolvePHPName n = do
include :: ( AbstractValue location value effects
, Member (Allocator location value) effects
, Member (Env location) effects
, Member (Modules location value) effects
, Member (Reader (Environment location)) effects
, Member (Resumable ResolutionError) effects
, Member (Resumable (EnvironmentError location)) effects
, Member (State (Environment location)) effects
, Member (State (Exports location)) effects
, Member Trace effects
)
@ -70,7 +69,7 @@ include pathTerm f = do
path <- resolvePHPName name
traceResolve name path
(importedEnv, v) <- isolate (f path) >>= maybeM (pure (emptyEnv, unit))
modifyEnv (mergeEnvs importedEnv)
bindAll importedEnv
pure (Rval v)
newtype Require a = Require a

View File

@ -117,7 +117,7 @@ instance Evaluatable Import where
-- Last module path is the one we want to import
let path = NonEmpty.last modulePaths
importedEnv <- maybe emptyEnv fst <$> isolate (require path)
modifyEnv (mergeEnvs (select importedEnv))
bindAll (select importedEnv)
pure (Rval unit)
where
select importedEnv
@ -128,9 +128,8 @@ instance Evaluatable Import where
-- Evaluate a qualified import
evalQualifiedImport :: ( AbstractValue location value effects
, Member (Allocator location value) effects
, Member (Env location) effects
, Member (Modules location value) effects
, Member (Reader (Environment location)) effects
, Member (State (Environment location)) effects
, Member (State (Exports location)) effects
, Member (State (Heap location (Cell location) value)) effects
, Ord location
@ -139,7 +138,7 @@ evalQualifiedImport :: ( AbstractValue location value effects
=> Name -> ModulePath -> Evaluator location value effects value
evalQualifiedImport name path = letrec' name $ \addr -> do
importedEnv <- maybe emptyEnv fst <$> isolate (require path)
modifyEnv (mergeEnvs importedEnv)
bindAll importedEnv
unit <$ makeNamespace name addr Nothing
newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName }
@ -188,7 +187,7 @@ instance Evaluatable QualifiedAliasedImport where
Rval <$> letrec' alias (\addr -> do
let path = NonEmpty.last modulePaths
importedEnv <- maybe emptyEnv fst <$> isolate (require path)
modifyEnv (mergeEnvs importedEnv)
bindAll importedEnv
unit <$ makeNamespace alias addr Nothing)
-- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)

View File

@ -109,9 +109,9 @@ instance Evaluatable Load where
eval (Load _) = raiseEff (fail "invalid argument supplied to load, path is required")
doLoad :: ( AbstractValue location value effects
, Member (Env location) effects
, Member (Modules location value) effects
, Member (Resumable ResolutionError) effects
, Member (State (Environment location)) effects
, Member (State (Exports location)) effects
, Member Trace effects
)
@ -122,7 +122,7 @@ doLoad path shouldWrap = do
path' <- resolveRubyPath path
traceResolve path path'
importedEnv <- maybe emptyEnv fst <$> isolate (load path')
unless shouldWrap $ modifyEnv (mergeEnvs importedEnv)
unless shouldWrap $ bindAll importedEnv
pure (boolean Prelude.True) -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
-- TODO: autoload

View File

@ -1,6 +1,7 @@
{-# LANGUAGE DeriveAnyClass #-}
module Language.TypeScript.Syntax where
import Data.Abstract.Address
import qualified Data.Abstract.Environment as Env
import Data.Abstract.Evaluatable
import qualified Data.Abstract.Module as M
@ -134,9 +135,8 @@ javascriptExtensions = ["js"]
evalRequire :: ( AbstractValue location value effects
, Member (Allocator location value) effects
, Member (Env location) effects
, Member (Modules location value) effects
, Member (Reader (Environment location)) effects
, Member (State (Environment location)) effects
, Member (State (Exports location)) effects
, Member (State (Heap location (Cell location) value)) effects
, Ord location
@ -147,7 +147,7 @@ evalRequire :: ( AbstractValue location value effects
-> Evaluator location value effects value
evalRequire modulePath alias = letrec' alias $ \addr -> do
importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath)
modifyEnv (mergeEnvs importedEnv)
bindAll importedEnv
unit <$ makeNamespace alias addr Nothing
data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath }
@ -164,7 +164,7 @@ instance Evaluatable Import where
eval (Import symbols importPath) = do
modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath)
modifyEnv (mergeEnvs (renamed importedEnv)) $> Rval unit
bindAll (renamed importedEnv) $> Rval unit
where
renamed importedEnv
| Prologue.null symbols = importedEnv
@ -252,7 +252,7 @@ instance Evaluatable QualifiedExportFrom where
-- Look up addresses in importedEnv and insert the aliases with addresses into the exports.
for_ exportSymbols $ \(name, alias) -> do
let address = Env.lookup name importedEnv
maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just) address
maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just . Address) address
pure (Rval unit)
newtype DefaultExport a = DefaultExport { defaultExport :: a }