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:
parent
d9a0d4dad7
commit
d8aa3c9a41
@ -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)
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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 }
|
||||||
|
Loading…
Reference in New Issue
Block a user