1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +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

View File

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

View File

@ -54,11 +54,10 @@ resolvePHPName n = do
include :: ( AbstractValue location value effects include :: ( AbstractValue location value effects
, Member (Allocator location value) effects , Member (Allocator location value) effects
, Member (Env location) effects
, Member (Modules location value) effects , Member (Modules location value) effects
, Member (Reader (Environment location)) effects
, Member (Resumable ResolutionError) effects , Member (Resumable ResolutionError) effects
, Member (Resumable (EnvironmentError location)) effects , Member (Resumable (EnvironmentError location)) effects
, Member (State (Environment location)) effects
, Member (State (Exports location)) effects , Member (State (Exports location)) effects
, Member Trace effects , Member Trace effects
) )
@ -70,7 +69,7 @@ include pathTerm f = do
path <- resolvePHPName name path <- resolvePHPName name
traceResolve name path traceResolve name path
(importedEnv, v) <- isolate (f path) >>= maybeM (pure (emptyEnv, unit)) (importedEnv, v) <- isolate (f path) >>= maybeM (pure (emptyEnv, unit))
modifyEnv (mergeEnvs importedEnv) bindAll importedEnv
pure (Rval v) pure (Rval v)
newtype Require a = Require a 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 -- Last module path is the one we want to import
let path = NonEmpty.last modulePaths let path = NonEmpty.last modulePaths
importedEnv <- maybe emptyEnv fst <$> isolate (require path) importedEnv <- maybe emptyEnv fst <$> isolate (require path)
modifyEnv (mergeEnvs (select importedEnv)) bindAll (select importedEnv)
pure (Rval unit) pure (Rval unit)
where where
select importedEnv select importedEnv
@ -128,9 +128,8 @@ instance Evaluatable Import where
-- Evaluate a qualified import -- Evaluate a qualified import
evalQualifiedImport :: ( AbstractValue location value effects evalQualifiedImport :: ( AbstractValue location value effects
, Member (Allocator location value) effects , Member (Allocator location value) effects
, Member (Env location) effects
, Member (Modules location value) effects , Member (Modules location value) effects
, Member (Reader (Environment location)) effects
, Member (State (Environment location)) effects
, Member (State (Exports location)) effects , Member (State (Exports location)) effects
, Member (State (Heap location (Cell location) value)) effects , Member (State (Heap location (Cell location) value)) effects
, Ord location , Ord location
@ -139,7 +138,7 @@ evalQualifiedImport :: ( AbstractValue location value effects
=> Name -> ModulePath -> Evaluator location value effects value => Name -> ModulePath -> Evaluator location value effects value
evalQualifiedImport name path = letrec' name $ \addr -> do evalQualifiedImport name path = letrec' name $ \addr -> do
importedEnv <- maybe emptyEnv fst <$> isolate (require path) importedEnv <- maybe emptyEnv fst <$> isolate (require path)
modifyEnv (mergeEnvs importedEnv) bindAll importedEnv
unit <$ makeNamespace name addr Nothing unit <$ makeNamespace name addr Nothing
newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName } newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName }
@ -188,7 +187,7 @@ instance Evaluatable QualifiedAliasedImport where
Rval <$> letrec' alias (\addr -> do Rval <$> letrec' alias (\addr -> do
let path = NonEmpty.last modulePaths let path = NonEmpty.last modulePaths
importedEnv <- maybe emptyEnv fst <$> isolate (require path) importedEnv <- maybe emptyEnv fst <$> isolate (require path)
modifyEnv (mergeEnvs importedEnv) bindAll importedEnv
unit <$ makeNamespace alias addr Nothing) unit <$ makeNamespace alias addr Nothing)
-- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell) -- | 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") eval (Load _) = raiseEff (fail "invalid argument supplied to load, path is required")
doLoad :: ( AbstractValue location value effects doLoad :: ( AbstractValue location value effects
, Member (Env location) effects
, Member (Modules location value) effects , Member (Modules location value) effects
, Member (Resumable ResolutionError) effects , Member (Resumable ResolutionError) effects
, Member (State (Environment location)) effects
, Member (State (Exports location)) effects , Member (State (Exports location)) effects
, Member Trace effects , Member Trace effects
) )
@ -122,7 +122,7 @@ doLoad path shouldWrap = do
path' <- resolveRubyPath path path' <- resolveRubyPath path
traceResolve path path' traceResolve path path'
importedEnv <- maybe emptyEnv fst <$> isolate (load 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 pure (boolean Prelude.True) -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
-- TODO: autoload -- TODO: autoload

View File

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