mirror of
https://github.com/github/semantic.git
synced 2024-12-19 04:41:47 +03:00
Use bindAll most places.
This commit is contained in:
parent
d9a0d4dad7
commit
d8aa3c9a41
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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 }
|
||||
|
Loading…
Reference in New Issue
Block a user