mirror of
https://github.com/github/semantic.git
synced 2024-12-25 16:02:43 +03:00
Merge branch 'master' into deployment-setup
This commit is contained in:
commit
a15efb9327
@ -46,6 +46,7 @@ library
|
|||||||
, Control.Abstract.Heap
|
, Control.Abstract.Heap
|
||||||
, Control.Abstract.Matching
|
, Control.Abstract.Matching
|
||||||
, Control.Abstract.Modules
|
, Control.Abstract.Modules
|
||||||
|
, Control.Abstract.Primitive
|
||||||
, Control.Abstract.Roots
|
, Control.Abstract.Roots
|
||||||
, Control.Abstract.TermEvaluator
|
, Control.Abstract.TermEvaluator
|
||||||
, Control.Abstract.Value
|
, Control.Abstract.Value
|
||||||
@ -62,9 +63,11 @@ library
|
|||||||
, Data.Abstract.Live
|
, Data.Abstract.Live
|
||||||
, Data.Abstract.Module
|
, Data.Abstract.Module
|
||||||
, Data.Abstract.ModuleTable
|
, Data.Abstract.ModuleTable
|
||||||
|
, Data.Abstract.Name
|
||||||
, Data.Abstract.Number
|
, Data.Abstract.Number
|
||||||
, Data.Abstract.Package
|
, Data.Abstract.Package
|
||||||
, Data.Abstract.Path
|
, Data.Abstract.Path
|
||||||
|
, Data.Abstract.Ref
|
||||||
, Data.Abstract.Type
|
, Data.Abstract.Type
|
||||||
, Data.Abstract.Value
|
, Data.Abstract.Value
|
||||||
-- General datatype definitions & generic algorithms
|
-- General datatype definitions & generic algorithms
|
||||||
|
@ -7,8 +7,8 @@ module Analysis.Abstract.Caching
|
|||||||
|
|
||||||
import Control.Abstract
|
import Control.Abstract
|
||||||
import Data.Abstract.Cache
|
import Data.Abstract.Cache
|
||||||
import Data.Abstract.Evaluatable
|
|
||||||
import Data.Abstract.Module
|
import Data.Abstract.Module
|
||||||
|
import Data.Abstract.Ref
|
||||||
import Data.Semilattice.Lower
|
import Data.Semilattice.Lower
|
||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
@ -63,7 +63,7 @@ cachingTerms :: ( Cacheable term location (Cell location) value
|
|||||||
, Reader (Cache term location (Cell location) value)
|
, Reader (Cache term location (Cell location) value)
|
||||||
, Reader (Live location value)
|
, Reader (Live location value)
|
||||||
, State (Cache term location (Cell location) value)
|
, State (Cache term location (Cell location) value)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
] effects
|
] effects
|
||||||
)
|
)
|
||||||
@ -84,13 +84,12 @@ convergingModules :: ( AbstractValue location value effects
|
|||||||
, Fresh
|
, Fresh
|
||||||
, NonDet
|
, NonDet
|
||||||
, Reader (Cache term location (Cell location) value)
|
, Reader (Cache term location (Cell location) value)
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, Reader (Live location value)
|
, Reader (Live location value)
|
||||||
, Resumable (AddressError location value)
|
, Resumable (AddressError location value)
|
||||||
, Resumable (EnvironmentError value)
|
, Resumable (EnvironmentError value)
|
||||||
, Resumable (EvalError value)
|
|
||||||
, State (Cache term location (Cell location) value)
|
, State (Cache term location (Cell location) value)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
] effects
|
] effects
|
||||||
)
|
)
|
||||||
|
@ -9,10 +9,10 @@ import Data.Semilattice.Lower
|
|||||||
|
|
||||||
-- | An analysis evaluating @term@s to @value@s with a list of @effects@ using 'Evaluatable', and producing incremental results of type @a@.
|
-- | An analysis evaluating @term@s to @value@s with a list of @effects@ using 'Evaluatable', and producing incremental results of type @a@.
|
||||||
data EvaluatingState location value = EvaluatingState
|
data EvaluatingState location value = EvaluatingState
|
||||||
{ environment :: Environment location value
|
{ environment :: Environment location
|
||||||
, heap :: Heap location (Cell location) value
|
, heap :: Heap location (Cell location) value
|
||||||
, modules :: ModuleTable (Maybe (Environment location value, value))
|
, modules :: ModuleTable (Maybe (Environment location, value))
|
||||||
, exports :: Exports location value
|
, exports :: Exports location
|
||||||
}
|
}
|
||||||
|
|
||||||
deriving instance (Eq (Cell location value), Eq location, Eq value) => Eq (EvaluatingState location value)
|
deriving instance (Eq (Cell location value), Eq location, Eq value) => Eq (EvaluatingState location value)
|
||||||
@ -23,19 +23,19 @@ deriving instance (Show (Cell location value), Show location, Show value) => Sho
|
|||||||
evaluating :: Evaluator location value
|
evaluating :: Evaluator location value
|
||||||
( Fail
|
( Fail
|
||||||
': Fresh
|
': Fresh
|
||||||
': Reader (Environment location value)
|
': Reader (Environment location)
|
||||||
': State (Environment location value)
|
': State (Environment location)
|
||||||
': State (Heap location (Cell location) value)
|
': State (Heap location (Cell location) value)
|
||||||
': State (ModuleTable (Maybe (Environment location value, value)))
|
': State (ModuleTable (Maybe (Environment location, value)))
|
||||||
': State (Exports location value)
|
': State (Exports location)
|
||||||
': effects) result
|
': effects) result
|
||||||
-> Evaluator location value effects (Either String result, EvaluatingState location value)
|
-> Evaluator location value effects (Either String result, EvaluatingState location value)
|
||||||
evaluating
|
evaluating
|
||||||
= fmap (\ ((((result, env), heap), modules), exports) -> (result, EvaluatingState env heap modules exports))
|
= fmap (\ ((((result, env), heap), modules), exports) -> (result, EvaluatingState env heap modules exports))
|
||||||
. runState lowerBound -- State (Exports location value)
|
. runState lowerBound -- State (Exports location)
|
||||||
. runState lowerBound -- State (ModuleTable (Maybe (Environment location value, value)))
|
. runState lowerBound -- State (ModuleTable (Maybe (Environment location, value)))
|
||||||
. runState lowerBound -- State (Heap location (Cell location) value)
|
. runState lowerBound -- State (Heap location (Cell location) value)
|
||||||
. runState lowerBound -- State (Environment location value)
|
. runState lowerBound -- State (Environment location)
|
||||||
. runReader lowerBound -- Reader (Environment location value)
|
. runReader lowerBound -- Reader (Environment location)
|
||||||
. runFresh 0
|
. runFresh 0
|
||||||
. runFail
|
. runFail
|
||||||
|
@ -16,8 +16,8 @@ module Analysis.Abstract.Graph
|
|||||||
import Algebra.Graph.Export.Dot hiding (vertexName)
|
import Algebra.Graph.Export.Dot hiding (vertexName)
|
||||||
import Control.Abstract
|
import Control.Abstract
|
||||||
import Data.Abstract.Address
|
import Data.Abstract.Address
|
||||||
import Data.Abstract.FreeVariables
|
|
||||||
import Data.Abstract.Module (Module(moduleInfo), ModuleInfo(..))
|
import Data.Abstract.Module (Module(moduleInfo), ModuleInfo(..))
|
||||||
|
import Data.Abstract.Name
|
||||||
import Data.Abstract.Package (PackageInfo(..))
|
import Data.Abstract.Package (PackageInfo(..))
|
||||||
import Data.Aeson hiding (Result)
|
import Data.Aeson hiding (Result)
|
||||||
import Data.ByteString.Builder
|
import Data.ByteString.Builder
|
||||||
@ -52,9 +52,9 @@ style = (defaultStyle (byteString . vertexName))
|
|||||||
|
|
||||||
-- | Add vertices to the graph for evaluated identifiers.
|
-- | Add vertices to the graph for evaluated identifiers.
|
||||||
graphingTerms :: ( Element Syntax.Identifier syntax
|
graphingTerms :: ( Element Syntax.Identifier syntax
|
||||||
, Members '[ Reader (Environment (Located location) value)
|
, Members '[ Reader (Environment (Located location))
|
||||||
, Reader ModuleInfo
|
, Reader ModuleInfo
|
||||||
, State (Environment (Located location) value)
|
, State (Environment (Located location))
|
||||||
, State (Graph Vertex)
|
, State (Graph Vertex)
|
||||||
] effects
|
] effects
|
||||||
, term ~ Term (Sum syntax) ann
|
, term ~ Term (Sum syntax) ann
|
||||||
@ -125,8 +125,8 @@ moduleInclusion v = do
|
|||||||
appendGraph (vertex (moduleVertex m) `connect` vertex v)
|
appendGraph (vertex (moduleVertex m) `connect` vertex v)
|
||||||
|
|
||||||
-- | Add an edge from the passed variable name to the module it originated within.
|
-- | Add an edge from the passed variable name to the module it originated within.
|
||||||
variableDefinition :: ( Member (Reader (Environment (Located location) value)) effects
|
variableDefinition :: ( Member (Reader (Environment (Located location))) effects
|
||||||
, Member (State (Environment (Located location) value)) effects
|
, Member (State (Environment (Located location))) effects
|
||||||
, Member (State (Graph Vertex)) effects
|
, Member (State (Graph Vertex)) effects
|
||||||
)
|
)
|
||||||
=> Name
|
=> Name
|
||||||
|
@ -14,7 +14,7 @@ import Prologue
|
|||||||
-- Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis.
|
-- Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis.
|
||||||
tracingTerms :: ( Corecursive term
|
tracingTerms :: ( Corecursive term
|
||||||
, Members '[ Reader (Live location value)
|
, Members '[ Reader (Live location value)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
, Writer (trace (Configuration term location (Cell location) value))
|
, Writer (trace (Configuration term location (Cell location) value))
|
||||||
] effects
|
] effects
|
||||||
|
@ -5,7 +5,7 @@ module Analysis.Declaration
|
|||||||
, declarationAlgebra
|
, declarationAlgebra
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Abstract.FreeVariables (Name(..))
|
import Data.Abstract.Name (unName)
|
||||||
import Data.Blob
|
import Data.Blob
|
||||||
import Data.Error (Error(..), showExpectation)
|
import Data.Error (Error(..), showExpectation)
|
||||||
import Data.Language as Language
|
import Data.Language as Language
|
||||||
@ -130,7 +130,7 @@ getSource blobSource = toText . flip Source.slice blobSource . getField
|
|||||||
instance (Syntax.Identifier :< fs, Expression.MemberAccess :< fs) => CustomHasDeclaration (Sum fs) Expression.Call where
|
instance (Syntax.Identifier :< fs, Expression.MemberAccess :< fs) => CustomHasDeclaration (Sum fs) Expression.Call where
|
||||||
customToDeclaration Blob{..} _ (Expression.Call _ (Term (In fromAnn fromF), _) _ _)
|
customToDeclaration Blob{..} _ (Expression.Call _ (Term (In fromAnn fromF), _) _ _)
|
||||||
| Just (Expression.MemberAccess (Term (In leftAnn leftF)) (Term (In idenAnn _))) <- project fromF = Just $ CallReference (getSource idenAnn) mempty blobLanguage (memberAccess leftAnn leftF)
|
| Just (Expression.MemberAccess (Term (In leftAnn leftF)) (Term (In idenAnn _))) <- project fromF = Just $ CallReference (getSource idenAnn) mempty blobLanguage (memberAccess leftAnn leftF)
|
||||||
| Just (Syntax.Identifier (Name name)) <- project fromF = Just $ CallReference (T.decodeUtf8 name) mempty blobLanguage []
|
| Just (Syntax.Identifier name) <- project fromF = Just $ CallReference (T.decodeUtf8 (unName name)) mempty blobLanguage []
|
||||||
| otherwise = Just $ CallReference (getSource fromAnn) mempty blobLanguage []
|
| otherwise = Just $ CallReference (getSource fromAnn) mempty blobLanguage []
|
||||||
where
|
where
|
||||||
memberAccess modAnn termFOut
|
memberAccess modAnn termFOut
|
||||||
|
@ -5,7 +5,7 @@ module Analysis.IdentifierName
|
|||||||
, identifierLabel
|
, identifierLabel
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Abstract.FreeVariables (Name (..))
|
import Data.Abstract.Name (unName)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.JSON.Fields
|
import Data.JSON.Fields
|
||||||
import Data.Sum
|
import Data.Sum
|
||||||
@ -41,7 +41,7 @@ instance Apply IdentifierName fs => CustomIdentifierName (Sum fs) where
|
|||||||
customIdentifierName = apply @IdentifierName identifierName
|
customIdentifierName = apply @IdentifierName identifierName
|
||||||
|
|
||||||
instance CustomIdentifierName Data.Syntax.Identifier where
|
instance CustomIdentifierName Data.Syntax.Identifier where
|
||||||
customIdentifierName (Data.Syntax.Identifier (Name name)) = Just name
|
customIdentifierName (Data.Syntax.Identifier name) = Just (unName name)
|
||||||
|
|
||||||
data Strategy = Default | Custom
|
data Strategy = Default | Custom
|
||||||
|
|
||||||
|
@ -11,6 +11,7 @@ import Control.Abstract.Exports as X
|
|||||||
import Control.Abstract.Heap as X
|
import Control.Abstract.Heap as X
|
||||||
import Control.Abstract.Goto as X
|
import Control.Abstract.Goto as X
|
||||||
import Control.Abstract.Modules as X
|
import Control.Abstract.Modules as X
|
||||||
|
import Control.Abstract.Primitive as X
|
||||||
import Control.Abstract.Roots as X
|
import Control.Abstract.Roots as X
|
||||||
import Control.Abstract.TermEvaluator as X
|
import Control.Abstract.TermEvaluator as X
|
||||||
import Control.Abstract.Value as X
|
import Control.Abstract.Value as X
|
||||||
|
@ -6,7 +6,7 @@ module Control.Abstract.Addressable
|
|||||||
import Control.Abstract.Context
|
import Control.Abstract.Context
|
||||||
import Control.Abstract.Evaluator
|
import Control.Abstract.Evaluator
|
||||||
import Data.Abstract.Address
|
import Data.Abstract.Address
|
||||||
import Data.Abstract.FreeVariables
|
import Data.Abstract.Name
|
||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
-- | Defines allocation and dereferencing of 'Address'es in a 'Heap'.
|
-- | Defines allocation and dereferencing of 'Address'es in a 'Heap'.
|
||||||
|
@ -12,5 +12,5 @@ import Control.Abstract.TermEvaluator
|
|||||||
import Data.Abstract.Configuration
|
import Data.Abstract.Configuration
|
||||||
|
|
||||||
-- | Get the current 'Configuration' with a passed-in term.
|
-- | Get the current 'Configuration' with a passed-in term.
|
||||||
getConfiguration :: Members '[Reader (Live location value), State (Environment location value), State (Heap location (Cell location) value)] effects => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value)
|
getConfiguration :: Members '[Reader (Live location value), State (Environment location), State (Heap location (Cell location) value)] effects => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value)
|
||||||
getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap
|
getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap
|
||||||
|
@ -20,53 +20,53 @@ module Control.Abstract.Environment
|
|||||||
import Control.Abstract.Evaluator
|
import Control.Abstract.Evaluator
|
||||||
import Data.Abstract.Address
|
import Data.Abstract.Address
|
||||||
import Data.Abstract.Environment as Env
|
import Data.Abstract.Environment as Env
|
||||||
import Data.Abstract.FreeVariables
|
import Data.Abstract.Name
|
||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
-- | Retrieve the environment.
|
-- | Retrieve the environment.
|
||||||
getEnv :: Member (State (Environment location value)) effects => Evaluator location value effects (Environment location value)
|
getEnv :: Member (State (Environment location)) effects => Evaluator location value effects (Environment location)
|
||||||
getEnv = get
|
getEnv = get
|
||||||
|
|
||||||
-- | Set the environment.
|
-- | Set the environment.
|
||||||
putEnv :: Member (State (Environment location value)) effects => Environment location value -> Evaluator location value effects ()
|
putEnv :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects ()
|
||||||
putEnv = put
|
putEnv = put
|
||||||
|
|
||||||
-- | Update the global environment.
|
-- | Update the global environment.
|
||||||
modifyEnv :: Member (State (Environment location value)) effects => (Environment location value -> Environment location value) -> Evaluator location value effects ()
|
modifyEnv :: Member (State (Environment location)) effects => (Environment location -> Environment location) -> Evaluator location value effects ()
|
||||||
modifyEnv = modify'
|
modifyEnv = modify'
|
||||||
|
|
||||||
-- | Sets the environment for the lifetime of the given action.
|
-- | Sets the environment for the lifetime of the given action.
|
||||||
withEnv :: Member (State (Environment location value)) effects => Environment location value -> Evaluator location value effects a -> Evaluator location value effects a
|
withEnv :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects a -> Evaluator location value effects a
|
||||||
withEnv = localState . const
|
withEnv = localState . const
|
||||||
|
|
||||||
|
|
||||||
-- | Retrieve the default environment.
|
-- | Retrieve the default environment.
|
||||||
defaultEnvironment :: Member (Reader (Environment location value)) effects => Evaluator location value effects (Environment location value)
|
defaultEnvironment :: Member (Reader (Environment location)) effects => Evaluator location value effects (Environment location)
|
||||||
defaultEnvironment = ask
|
defaultEnvironment = ask
|
||||||
|
|
||||||
-- | Set the default environment for the lifetime of an action.
|
-- | Set the default environment for the lifetime of an action.
|
||||||
-- Usually only invoked in a top-level evaluation function.
|
-- Usually only invoked in a top-level evaluation function.
|
||||||
withDefaultEnvironment :: Member (Reader (Environment location value)) effects => Environment location value -> Evaluator location value effects a -> Evaluator location value effects a
|
withDefaultEnvironment :: Member (Reader (Environment location)) effects => Environment location -> Evaluator location value effects a -> Evaluator location value effects a
|
||||||
withDefaultEnvironment e = local (const e)
|
withDefaultEnvironment e = local (const e)
|
||||||
|
|
||||||
-- | Obtain an environment that is the composition of the current and default environments.
|
-- | Obtain an environment that is the composition of the current and default environments.
|
||||||
-- Useful for debugging.
|
-- Useful for debugging.
|
||||||
fullEnvironment :: Members '[Reader (Environment location value), State (Environment location value)] effects => Evaluator location value effects (Environment location value)
|
fullEnvironment :: Members '[Reader (Environment location), State (Environment location)] effects => Evaluator location value effects (Environment location)
|
||||||
fullEnvironment = mergeEnvs <$> getEnv <*> defaultEnvironment
|
fullEnvironment = mergeEnvs <$> getEnv <*> defaultEnvironment
|
||||||
|
|
||||||
-- | Run an action with a locally-modified environment.
|
-- | Run an action with a locally-modified environment.
|
||||||
localEnv :: Member (State (Environment location value)) effects => (Environment location value -> Environment location value) -> Evaluator location value effects a -> Evaluator location value effects a
|
localEnv :: Member (State (Environment location)) effects => (Environment location -> Environment location) -> Evaluator location value effects a -> Evaluator location value effects a
|
||||||
localEnv f a = do
|
localEnv f a = do
|
||||||
modifyEnv (f . Env.push)
|
modifyEnv (f . Env.push)
|
||||||
result <- a
|
result <- a
|
||||||
result <$ modifyEnv Env.pop
|
result <$ modifyEnv Env.pop
|
||||||
|
|
||||||
-- | Run a computation in a new local environment.
|
-- | Run a computation in a new local environment.
|
||||||
localize :: Member (State (Environment location value)) effects => Evaluator location value effects a -> Evaluator location value effects a
|
localize :: Member (State (Environment location)) effects => Evaluator location value effects a -> Evaluator location value effects a
|
||||||
localize = localEnv id
|
localize = localEnv id
|
||||||
|
|
||||||
-- | Look a 'Name' up in the current environment, trying the default environment if no value is found.
|
-- | Look a 'Name' up in the current environment, trying the default environment if no value is found.
|
||||||
lookupEnv :: Members '[Reader (Environment location value), State (Environment location value)] effects => Name -> Evaluator location value effects (Maybe (Address location value))
|
lookupEnv :: Members '[Reader (Environment location), State (Environment location)] effects => Name -> Evaluator location value effects (Maybe (Address location value))
|
||||||
lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment)
|
lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment)
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,7 +1,6 @@
|
|||||||
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
|
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
|
||||||
module Control.Abstract.Evaluator
|
module Control.Abstract.Evaluator
|
||||||
( Evaluator(..)
|
( Evaluator(..)
|
||||||
, ValueRef(..)
|
|
||||||
-- * Effects
|
-- * Effects
|
||||||
, Return(..)
|
, Return(..)
|
||||||
, earlyReturn
|
, earlyReturn
|
||||||
@ -12,25 +11,16 @@ module Control.Abstract.Evaluator
|
|||||||
, throwContinue
|
, throwContinue
|
||||||
, catchLoopControl
|
, catchLoopControl
|
||||||
, runLoopControl
|
, runLoopControl
|
||||||
, module Control.Monad.Effect
|
, module X
|
||||||
, module Control.Monad.Effect.Fail
|
|
||||||
, module Control.Monad.Effect.Fresh
|
|
||||||
, module Control.Monad.Effect.NonDet
|
|
||||||
, module Control.Monad.Effect.Reader
|
|
||||||
, module Control.Monad.Effect.Resumable
|
|
||||||
, module Control.Monad.Effect.State
|
|
||||||
, module Control.Monad.Effect.Trace
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Effect
|
import Control.Monad.Effect as X
|
||||||
import Control.Monad.Effect.Fail
|
import Control.Monad.Effect.Fresh as X
|
||||||
import Control.Monad.Effect.Fresh
|
import Control.Monad.Effect.NonDet as X
|
||||||
import Control.Monad.Effect.NonDet
|
import Control.Monad.Effect.Reader as X
|
||||||
import Control.Monad.Effect.Reader
|
import Control.Monad.Effect.Resumable as X
|
||||||
import Control.Monad.Effect.Resumable
|
import Control.Monad.Effect.State as X
|
||||||
import Control.Monad.Effect.State
|
import Control.Monad.Effect.Trace as X
|
||||||
import Control.Monad.Effect.Trace
|
|
||||||
import Data.Abstract.FreeVariables
|
|
||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
-- | An 'Evaluator' is a thin wrapper around 'Eff' with (phantom) type parameters for the location, term, and value types.
|
-- | An 'Evaluator' is a thin wrapper around 'Eff' with (phantom) type parameters for the location, term, and value types.
|
||||||
@ -43,16 +33,6 @@ newtype Evaluator location value effects a = Evaluator { runEvaluator :: Eff eff
|
|||||||
|
|
||||||
deriving instance Member NonDet effects => Alternative (Evaluator location value effects)
|
deriving instance Member NonDet effects => Alternative (Evaluator location value effects)
|
||||||
|
|
||||||
-- | 'ValueRef' is the type subterms evaluate to and can represent either values directly ('Rval'), or references to values (lvals - such as local variables or object members)
|
|
||||||
data ValueRef value where
|
|
||||||
-- Represents a value:
|
|
||||||
Rval :: value -> ValueRef value
|
|
||||||
-- Represents a local variable. No environment is attached - it's assumed that LvalLocal will be evaluated in the same scope it was constructed:
|
|
||||||
LvalLocal :: Name -> ValueRef value
|
|
||||||
-- Represents an object member:
|
|
||||||
LvalMember :: value -> Name -> ValueRef value
|
|
||||||
|
|
||||||
deriving (Eq, Ord, Show)
|
|
||||||
|
|
||||||
-- Effects
|
-- Effects
|
||||||
|
|
||||||
|
@ -10,24 +10,24 @@ module Control.Abstract.Exports
|
|||||||
import Control.Abstract.Evaluator
|
import Control.Abstract.Evaluator
|
||||||
import Data.Abstract.Address
|
import Data.Abstract.Address
|
||||||
import Data.Abstract.Exports
|
import Data.Abstract.Exports
|
||||||
import Data.Abstract.FreeVariables
|
import Data.Abstract.Name
|
||||||
|
|
||||||
-- | Get the global export state.
|
-- | Get the global export state.
|
||||||
getExports :: Member (State (Exports location value)) effects => Evaluator location value effects (Exports location value)
|
getExports :: Member (State (Exports location)) effects => Evaluator location value effects (Exports location)
|
||||||
getExports = get
|
getExports = get
|
||||||
|
|
||||||
-- | Set the global export state.
|
-- | Set the global export state.
|
||||||
putExports :: Member (State (Exports location value)) effects => Exports location value -> Evaluator location value effects ()
|
putExports :: Member (State (Exports location)) effects => Exports location -> Evaluator location value effects ()
|
||||||
putExports = put
|
putExports = put
|
||||||
|
|
||||||
-- | Update the global export state.
|
-- | Update the global export state.
|
||||||
modifyExports :: Member (State (Exports location value)) effects => (Exports location value -> Exports location value) -> Evaluator location value effects ()
|
modifyExports :: Member (State (Exports location)) effects => (Exports location -> Exports location) -> Evaluator location value effects ()
|
||||||
modifyExports = modify'
|
modifyExports = modify'
|
||||||
|
|
||||||
-- | Add an export to the global export state.
|
-- | Add an export to the global export state.
|
||||||
addExport :: Member (State (Exports location value)) effects => Name -> Name -> Maybe (Address location value) -> Evaluator location value effects ()
|
addExport :: Member (State (Exports location)) effects => Name -> Name -> Maybe (Address location value) -> Evaluator location value effects ()
|
||||||
addExport name alias = modifyExports . insert name alias
|
addExport name alias = modifyExports . insert name alias
|
||||||
|
|
||||||
-- | Sets the global export state for the lifetime of the given action.
|
-- | Sets the global export state for the lifetime of the given action.
|
||||||
withExports :: Member (State (Exports location value)) effects => Exports location value -> Evaluator location value effects a -> Evaluator location value effects a
|
withExports :: Member (State (Exports location)) effects => Exports location -> Evaluator location value effects a -> Evaluator location value effects a
|
||||||
withExports = localState . const
|
withExports = localState . const
|
||||||
|
@ -24,8 +24,8 @@ import Control.Abstract.Environment
|
|||||||
import Control.Abstract.Evaluator
|
import Control.Abstract.Evaluator
|
||||||
import Data.Abstract.Address
|
import Data.Abstract.Address
|
||||||
import Data.Abstract.Environment
|
import Data.Abstract.Environment
|
||||||
import Data.Abstract.FreeVariables
|
|
||||||
import Data.Abstract.Heap
|
import Data.Abstract.Heap
|
||||||
|
import Data.Abstract.Name
|
||||||
import Data.Semigroup.Reducer
|
import Data.Semigroup.Reducer
|
||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
@ -63,8 +63,8 @@ assign address = modifyHeap . heapInsert address
|
|||||||
|
|
||||||
-- | Look up or allocate an address for a 'Name'.
|
-- | Look up or allocate an address for a 'Name'.
|
||||||
lookupOrAlloc :: Members '[ Allocator location value
|
lookupOrAlloc :: Members '[ Allocator location value
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
] effects
|
] effects
|
||||||
=> Name
|
=> Name
|
||||||
-> Evaluator location value effects (Address location value)
|
-> Evaluator location value effects (Address location value)
|
||||||
@ -72,8 +72,8 @@ lookupOrAlloc name = lookupEnv name >>= maybe (alloc name) pure
|
|||||||
|
|
||||||
|
|
||||||
letrec :: ( Members '[ Allocator location value
|
letrec :: ( Members '[ Allocator location value
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
] effects
|
] effects
|
||||||
, Ord location
|
, Ord location
|
||||||
@ -90,8 +90,8 @@ letrec name body = do
|
|||||||
|
|
||||||
-- Lookup/alloc a name passing the address to a body evaluated in a new local environment.
|
-- Lookup/alloc a name passing the address to a body evaluated in a new local environment.
|
||||||
letrec' :: Members '[ Allocator location value
|
letrec' :: Members '[ Allocator location value
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
] effects
|
] effects
|
||||||
=> Name
|
=> Name
|
||||||
-> (Address location value -> Evaluator location value effects value)
|
-> (Address location value -> Evaluator location value effects value)
|
||||||
@ -104,9 +104,9 @@ letrec' name body = do
|
|||||||
|
|
||||||
-- | Look up and dereference the given 'Name', throwing an exception for free variables.
|
-- | Look up and dereference the given 'Name', throwing an exception for free variables.
|
||||||
variable :: Members '[ Allocator location value
|
variable :: Members '[ Allocator location value
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, Resumable (EnvironmentError value)
|
, Resumable (EnvironmentError value)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
] effects
|
] effects
|
||||||
=> Name
|
=> Name
|
||||||
|
@ -26,7 +26,7 @@ import Data.Language
|
|||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
-- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether we’ve begun loading the module or not, while the inner 'Maybe' indicates whether we’ve completed loading it or not. Thus, @Nothing@ means we’ve never tried to load it, @Just Nothing@ means we’ve started but haven’t yet finished loading it, and @Just (Just (env, value))@ indicates the result of a completed load.
|
-- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether we’ve begun loading the module or not, while the inner 'Maybe' indicates whether we’ve completed loading it or not. Thus, @Nothing@ means we’ve never tried to load it, @Just Nothing@ means we’ve started but haven’t yet finished loading it, and @Just (Just (env, value))@ indicates the result of a completed load.
|
||||||
lookupModule :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Maybe (Environment location value, value)))
|
lookupModule :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Maybe (Environment location, value)))
|
||||||
lookupModule = send . Lookup
|
lookupModule = send . Lookup
|
||||||
|
|
||||||
-- | Resolve a list of module paths to a possible module table entry.
|
-- | Resolve a list of module paths to a possible module table entry.
|
||||||
@ -40,19 +40,19 @@ listModulesInDir = sendModules . List
|
|||||||
-- | Require/import another module by name and return its environment and value.
|
-- | Require/import another module by name and return its environment and value.
|
||||||
--
|
--
|
||||||
-- Looks up the module's name in the cache of evaluated modules first, returns if found, otherwise loads/evaluates the module.
|
-- Looks up the module's name in the cache of evaluated modules first, returns if found, otherwise loads/evaluates the module.
|
||||||
require :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location value, value))
|
require :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location, value))
|
||||||
require path = lookupModule path >>= maybeM (load path)
|
require path = lookupModule path >>= maybeM (load path)
|
||||||
|
|
||||||
-- | Load another module by name and return its environment and value.
|
-- | Load another module by name and return its environment and value.
|
||||||
--
|
--
|
||||||
-- Always loads/evaluates.
|
-- Always loads/evaluates.
|
||||||
load :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location value, value))
|
load :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location, value))
|
||||||
load = send . Load
|
load = send . Load
|
||||||
|
|
||||||
|
|
||||||
data Modules location value return where
|
data Modules location value return where
|
||||||
Load :: ModulePath -> Modules location value (Maybe (Environment location value, value))
|
Load :: ModulePath -> Modules location value (Maybe (Environment location, value))
|
||||||
Lookup :: ModulePath -> Modules location value (Maybe (Maybe (Environment location value, value)))
|
Lookup :: ModulePath -> Modules location value (Maybe (Maybe (Environment location, value)))
|
||||||
Resolve :: [FilePath] -> Modules location value (Maybe ModulePath)
|
Resolve :: [FilePath] -> Modules location value (Maybe ModulePath)
|
||||||
List :: FilePath -> Modules location value [ModulePath]
|
List :: FilePath -> Modules location value [ModulePath]
|
||||||
|
|
||||||
@ -61,10 +61,10 @@ sendModules = send
|
|||||||
|
|
||||||
runModules :: forall term location value effects a
|
runModules :: forall term location value effects a
|
||||||
. Members '[ Resumable (LoadError location value)
|
. Members '[ Resumable (LoadError location value)
|
||||||
, State (ModuleTable (Maybe (Environment location value, value)))
|
, State (ModuleTable (Maybe (Environment location, value)))
|
||||||
, Trace
|
, Trace
|
||||||
] effects
|
] effects
|
||||||
=> (Module term -> Evaluator location value (Modules location value ': effects) (Environment location value, value))
|
=> (Module term -> Evaluator location value (Modules location value ': effects) (Environment location, value))
|
||||||
-> Evaluator location value (Modules location value ': effects) a
|
-> Evaluator location value (Modules location value ': effects) a
|
||||||
-> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a
|
-> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a
|
||||||
runModules evaluateModule = go
|
runModules evaluateModule = go
|
||||||
@ -89,17 +89,17 @@ runModules evaluateModule = go
|
|||||||
pure (find isMember names)
|
pure (find isMember names)
|
||||||
List dir -> modulePathsInDir dir <$> askModuleTable @term)
|
List dir -> modulePathsInDir dir <$> askModuleTable @term)
|
||||||
|
|
||||||
getModuleTable :: Member (State (ModuleTable (Maybe (Environment location value, value)))) effects => Evaluator location value effects (ModuleTable (Maybe (Environment location value, value)))
|
getModuleTable :: Member (State (ModuleTable (Maybe (Environment location, value)))) effects => Evaluator location value effects (ModuleTable (Maybe (Environment location, value)))
|
||||||
getModuleTable = get
|
getModuleTable = get
|
||||||
|
|
||||||
cacheModule :: Member (State (ModuleTable (Maybe (Environment location value, value)))) effects => ModulePath -> Maybe (Environment location value, value) -> Evaluator location value effects (Maybe (Environment location value, value))
|
cacheModule :: Member (State (ModuleTable (Maybe (Environment location, value)))) effects => ModulePath -> Maybe (Environment location, value) -> Evaluator location value effects (Maybe (Environment location, value))
|
||||||
cacheModule path result = modify' (ModuleTable.insert path result) $> result
|
cacheModule path result = modify' (ModuleTable.insert path result) $> result
|
||||||
|
|
||||||
askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator location value effects (ModuleTable [Module term])
|
askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator location value effects (ModuleTable [Module term])
|
||||||
askModuleTable = ask
|
askModuleTable = ask
|
||||||
|
|
||||||
|
|
||||||
newtype Merging m location value = Merging { runMerging :: m (Maybe (Environment location value, value)) }
|
newtype Merging m location value = Merging { runMerging :: m (Maybe (Environment location, value)) }
|
||||||
|
|
||||||
instance Applicative m => Semigroup (Merging m location value) where
|
instance Applicative m => Semigroup (Merging m location value) where
|
||||||
Merging a <> Merging b = Merging (merge <$> a <*> b)
|
Merging a <> Merging b = Merging (merge <$> a <*> b)
|
||||||
@ -113,7 +113,7 @@ instance Applicative m => Monoid (Merging m location value) where
|
|||||||
|
|
||||||
-- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.
|
-- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.
|
||||||
data LoadError location value resume where
|
data LoadError location value resume where
|
||||||
ModuleNotFound :: ModulePath -> LoadError location value (Maybe (Environment location value, value))
|
ModuleNotFound :: ModulePath -> LoadError location value (Maybe (Environment location, value))
|
||||||
|
|
||||||
deriving instance Eq (LoadError location value resume)
|
deriving instance Eq (LoadError location value resume)
|
||||||
deriving instance Show (LoadError location value resume)
|
deriving instance Show (LoadError location value resume)
|
||||||
@ -122,7 +122,7 @@ instance Show1 (LoadError location value) where
|
|||||||
instance Eq1 (LoadError location value) where
|
instance Eq1 (LoadError location value) where
|
||||||
liftEq _ (ModuleNotFound a) (ModuleNotFound b) = a == b
|
liftEq _ (ModuleNotFound a) (ModuleNotFound b) = a == b
|
||||||
|
|
||||||
moduleNotFound :: Member (Resumable (LoadError location value)) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location value, value))
|
moduleNotFound :: Member (Resumable (LoadError location value)) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location, value))
|
||||||
moduleNotFound = throwResumable . ModuleNotFound
|
moduleNotFound = throwResumable . ModuleNotFound
|
||||||
|
|
||||||
resumeLoadError :: Member (Resumable (LoadError location value)) effects => Evaluator location value effects a -> (forall resume . LoadError location value resume -> Evaluator location value effects resume) -> Evaluator location value effects a
|
resumeLoadError :: Member (Resumable (LoadError location value)) effects => Evaluator location value effects a -> (forall resume . LoadError location value resume -> Evaluator location value effects resume) -> Evaluator location value effects a
|
||||||
|
61
src/Control/Abstract/Primitive.hs
Normal file
61
src/Control/Abstract/Primitive.hs
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
module Control.Abstract.Primitive where
|
||||||
|
|
||||||
|
import Control.Abstract.Addressable
|
||||||
|
import Control.Abstract.Context
|
||||||
|
import Control.Abstract.Environment
|
||||||
|
import Control.Abstract.Evaluator
|
||||||
|
import Control.Abstract.Heap
|
||||||
|
import Control.Abstract.Value
|
||||||
|
import Data.Abstract.Environment
|
||||||
|
import Data.Abstract.Name
|
||||||
|
import Data.ByteString.Char8 (pack, unpack)
|
||||||
|
import Data.Semigroup.Reducer hiding (unit)
|
||||||
|
import Data.Semilattice.Lower
|
||||||
|
import Prologue
|
||||||
|
|
||||||
|
builtin :: ( HasCallStack
|
||||||
|
, Members '[ Allocator location value
|
||||||
|
, Reader (Environment location)
|
||||||
|
, Reader ModuleInfo
|
||||||
|
, Reader Span
|
||||||
|
, State (Environment location)
|
||||||
|
, State (Heap location (Cell location) value)
|
||||||
|
] effects
|
||||||
|
, Ord location
|
||||||
|
, Reducer value (Cell location value)
|
||||||
|
)
|
||||||
|
=> String
|
||||||
|
-> Evaluator location value effects value
|
||||||
|
-> Evaluator location value effects ()
|
||||||
|
builtin n def = withCurrentCallStack callStack $ do
|
||||||
|
let name' = name ("__semantic_" <> pack n)
|
||||||
|
addr <- alloc name'
|
||||||
|
modifyEnv (insert name' addr)
|
||||||
|
def >>= assign addr
|
||||||
|
|
||||||
|
lambda :: (AbstractFunction location value effects, Member Fresh effects)
|
||||||
|
=> Set Name
|
||||||
|
-> (Name -> Evaluator location value effects value)
|
||||||
|
-> Evaluator location value effects value
|
||||||
|
lambda fvs body = do
|
||||||
|
var <- nameI <$> fresh
|
||||||
|
closure [var] fvs (body var)
|
||||||
|
|
||||||
|
defineBuiltins :: ( AbstractValue location value effects
|
||||||
|
, HasCallStack
|
||||||
|
, Members '[ Allocator location value
|
||||||
|
, Fresh
|
||||||
|
, Reader (Environment location)
|
||||||
|
, Reader ModuleInfo
|
||||||
|
, Reader Span
|
||||||
|
, Resumable (EnvironmentError value)
|
||||||
|
, State (Environment location)
|
||||||
|
, State (Heap location (Cell location) value)
|
||||||
|
, Trace
|
||||||
|
] effects
|
||||||
|
, Ord location
|
||||||
|
, Reducer value (Cell location value)
|
||||||
|
)
|
||||||
|
=> Evaluator location value effects ()
|
||||||
|
defineBuiltins =
|
||||||
|
builtin "print" (lambda lowerBound (\ v -> variable v >>= asString >>= trace . unpack >> unit))
|
@ -1,12 +1,17 @@
|
|||||||
{-# LANGUAGE Rank2Types #-}
|
{-# LANGUAGE GADTs, Rank2Types #-}
|
||||||
module Control.Abstract.Value
|
module Control.Abstract.Value
|
||||||
( AbstractValue(..)
|
( AbstractValue(..)
|
||||||
|
, AbstractFunction(..)
|
||||||
, AbstractHole(..)
|
, AbstractHole(..)
|
||||||
, Comparator(..)
|
, Comparator(..)
|
||||||
|
, asBool
|
||||||
, while
|
, while
|
||||||
, doWhile
|
, doWhile
|
||||||
, forLoop
|
, forLoop
|
||||||
, makeNamespace
|
, makeNamespace
|
||||||
|
, evaluateInScopedEnv
|
||||||
|
, value
|
||||||
|
, subtermValue
|
||||||
, ValueRoots(..)
|
, ValueRoots(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -16,9 +21,10 @@ import Control.Abstract.Evaluator
|
|||||||
import Control.Abstract.Heap
|
import Control.Abstract.Heap
|
||||||
import Data.Abstract.Address (Address)
|
import Data.Abstract.Address (Address)
|
||||||
import Data.Abstract.Environment as Env
|
import Data.Abstract.Environment as Env
|
||||||
import Data.Abstract.FreeVariables
|
|
||||||
import Data.Abstract.Live (Live)
|
import Data.Abstract.Live (Live)
|
||||||
|
import Data.Abstract.Name
|
||||||
import Data.Abstract.Number as Number
|
import Data.Abstract.Number as Number
|
||||||
|
import Data.Abstract.Ref
|
||||||
import Data.Scientific (Scientific)
|
import Data.Scientific (Scientific)
|
||||||
import Data.Semigroup.Reducer hiding (unit)
|
import Data.Semigroup.Reducer hiding (unit)
|
||||||
import Data.Semilattice.Lower
|
import Data.Semilattice.Lower
|
||||||
@ -38,16 +44,27 @@ data Comparator
|
|||||||
class AbstractHole value where
|
class AbstractHole value where
|
||||||
hole :: value
|
hole :: value
|
||||||
|
|
||||||
|
|
||||||
|
class Show value => AbstractFunction location value effects where
|
||||||
|
-- | Build a closure (a binder like a lambda or method definition).
|
||||||
|
closure :: [Name] -- ^ The parameter names.
|
||||||
|
-> Set Name -- ^ The set of free variables to close over.
|
||||||
|
-> Evaluator location value effects value -- ^ The evaluator for the body of the closure.
|
||||||
|
-> Evaluator location value effects value
|
||||||
|
-- | Evaluate an application (like a function call).
|
||||||
|
call :: value -> [Evaluator location value effects value] -> Evaluator location value effects value
|
||||||
|
|
||||||
|
|
||||||
-- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc).
|
-- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc).
|
||||||
--
|
--
|
||||||
-- This allows us to abstract the choice of whether to evaluate under binders for different value types.
|
-- This allows us to abstract the choice of whether to evaluate under binders for different value types.
|
||||||
class Show value => AbstractValue location value effects where
|
class AbstractFunction location value effects => AbstractValue location value effects where
|
||||||
-- | Construct an abstract unit value.
|
-- | Construct an abstract unit value.
|
||||||
-- TODO: This might be the same as the empty tuple for some value types
|
-- TODO: This might be the same as the empty tuple for some value types
|
||||||
unit :: Evaluator location value effects value
|
unit :: Evaluator location value effects value
|
||||||
|
|
||||||
-- | Construct an abstract integral value.
|
-- | Construct an abstract integral value.
|
||||||
integer :: Prelude.Integer -> Evaluator location value effects value
|
integer :: Integer -> Evaluator location value effects value
|
||||||
|
|
||||||
-- | Lift a unary operator over a 'Num' to a function on 'value's.
|
-- | Lift a unary operator over a 'Num' to a function on 'value's.
|
||||||
liftNumeric :: (forall a . Num a => a -> a)
|
liftNumeric :: (forall a . Num a => a -> a)
|
||||||
@ -87,7 +104,7 @@ class Show value => AbstractValue location value effects where
|
|||||||
float :: Scientific -> Evaluator location value effects value
|
float :: Scientific -> Evaluator location value effects value
|
||||||
|
|
||||||
-- | Construct a rational value.
|
-- | Construct a rational value.
|
||||||
rational :: Prelude.Rational -> Evaluator location value effects value
|
rational :: Rational -> Evaluator location value effects value
|
||||||
|
|
||||||
-- | Construct an N-ary tuple of multiple (possibly-disjoint) values
|
-- | Construct an N-ary tuple of multiple (possibly-disjoint) values
|
||||||
multiple :: [value] -> Evaluator location value effects value
|
multiple :: [value] -> Evaluator location value effects value
|
||||||
@ -108,10 +125,7 @@ class Show value => AbstractValue location value effects where
|
|||||||
asString :: value -> Evaluator location value effects ByteString
|
asString :: value -> Evaluator location value effects ByteString
|
||||||
|
|
||||||
-- | Eliminate boolean values. TODO: s/boolean/truthy
|
-- | Eliminate boolean values. TODO: s/boolean/truthy
|
||||||
ifthenelse :: value -> Evaluator location value effects value -> Evaluator location value effects value -> Evaluator location value effects value
|
ifthenelse :: value -> Evaluator location value effects a -> Evaluator location value effects a -> Evaluator location value effects a
|
||||||
|
|
||||||
-- | Extract a 'Bool' from a given value.
|
|
||||||
asBool :: value -> Evaluator location value effects Bool
|
|
||||||
|
|
||||||
-- | Construct the nil/null datatype.
|
-- | Construct the nil/null datatype.
|
||||||
null :: Evaluator location value effects value
|
null :: Evaluator location value effects value
|
||||||
@ -119,32 +133,21 @@ class Show value => AbstractValue location value effects where
|
|||||||
-- | @index x i@ computes @x[i]@, with zero-indexing.
|
-- | @index x i@ computes @x[i]@, with zero-indexing.
|
||||||
index :: value -> value -> Evaluator location value effects value
|
index :: value -> value -> Evaluator location value effects value
|
||||||
|
|
||||||
-- | Determine whether the given datum is a 'Hole'.
|
|
||||||
isHole :: value -> Evaluator location value effects Bool
|
|
||||||
|
|
||||||
-- | Build a class value from a name and environment.
|
-- | Build a class value from a name and environment.
|
||||||
klass :: Name -- ^ The new class's identifier
|
klass :: Name -- ^ The new class's identifier
|
||||||
-> [value] -- ^ A list of superclasses
|
-> [value] -- ^ A list of superclasses
|
||||||
-> Environment location value -- ^ The environment to capture
|
-> Environment location -- ^ The environment to capture
|
||||||
-> Evaluator location value effects value
|
-> Evaluator location value effects value
|
||||||
|
|
||||||
-- | Build a namespace value from a name and environment stack
|
-- | Build a namespace value from a name and environment stack
|
||||||
--
|
--
|
||||||
-- Namespaces model closures with monoidal environments.
|
-- Namespaces model closures with monoidal environments.
|
||||||
namespace :: Name -- ^ The namespace's identifier
|
namespace :: Name -- ^ The namespace's identifier
|
||||||
-> Environment location value -- ^ The environment to mappend
|
-> Environment location -- ^ The environment to mappend
|
||||||
-> Evaluator location value effects value
|
-> Evaluator location value effects value
|
||||||
|
|
||||||
-- | Extract the environment from any scoped object (e.g. classes, namespaces, etc).
|
-- | Extract the environment from any scoped object (e.g. classes, namespaces, etc).
|
||||||
scopedEnvironment :: value -> Evaluator location value effects (Maybe (Environment location value))
|
scopedEnvironment :: value -> Evaluator location value effects (Maybe (Environment location))
|
||||||
|
|
||||||
-- | Build a closure (a binder like a lambda or method definition).
|
|
||||||
closure :: [Name] -- ^ The parameter names.
|
|
||||||
-> Set Name -- ^ The set of free variables to close over.
|
|
||||||
-> Evaluator location value effects value -- ^ The evaluator for the body of the closure.
|
|
||||||
-> Evaluator location value effects value
|
|
||||||
-- | Evaluate an application (like a function call).
|
|
||||||
call :: value -> [Evaluator location value effects value] -> Evaluator location value effects value
|
|
||||||
|
|
||||||
-- | Primitive looping combinator, approximately equivalent to 'fix'. This should be used in place of direct recursion, as it allows abstraction over recursion.
|
-- | Primitive looping combinator, approximately equivalent to 'fix'. This should be used in place of direct recursion, as it allows abstraction over recursion.
|
||||||
--
|
--
|
||||||
@ -152,9 +155,13 @@ class Show value => AbstractValue location value effects where
|
|||||||
loop :: (Evaluator location value effects value -> Evaluator location value effects value) -> Evaluator location value effects value
|
loop :: (Evaluator location value effects value -> Evaluator location value effects value) -> Evaluator location value effects value
|
||||||
|
|
||||||
|
|
||||||
-- | Attempt to extract a 'Prelude.Bool' from a given value.
|
-- | Extract a 'Bool' from a given value.
|
||||||
|
asBool :: AbstractValue location value effects => value -> Evaluator location value effects Bool
|
||||||
|
asBool value = ifthenelse value (pure True) (pure False)
|
||||||
|
|
||||||
|
-- | C-style for loops.
|
||||||
forLoop :: ( AbstractValue location value effects
|
forLoop :: ( AbstractValue location value effects
|
||||||
, Member (State (Environment location value)) effects
|
, Member (State (Environment location)) effects
|
||||||
)
|
)
|
||||||
=> Evaluator location value effects value -- ^ Initial statement
|
=> Evaluator location value effects value -- ^ Initial statement
|
||||||
-> Evaluator location value effects value -- ^ Condition
|
-> Evaluator location value effects value -- ^ Condition
|
||||||
@ -164,7 +171,7 @@ forLoop :: ( AbstractValue location value effects
|
|||||||
forLoop initial cond step body =
|
forLoop initial cond step body =
|
||||||
localize (initial *> while cond (body *> step))
|
localize (initial *> while cond (body *> step))
|
||||||
|
|
||||||
-- | The fundamental looping primitive, built on top of ifthenelse.
|
-- | The fundamental looping primitive, built on top of 'ifthenelse'.
|
||||||
while :: AbstractValue location value effects
|
while :: AbstractValue location value effects
|
||||||
=> Evaluator location value effects value
|
=> Evaluator location value effects value
|
||||||
-> Evaluator location value effects value
|
-> Evaluator location value effects value
|
||||||
@ -183,7 +190,7 @@ doWhile body cond = loop $ \ continue -> body *> do
|
|||||||
ifthenelse this continue unit
|
ifthenelse this continue unit
|
||||||
|
|
||||||
makeNamespace :: ( AbstractValue location value effects
|
makeNamespace :: ( AbstractValue location value effects
|
||||||
, Member (State (Environment location value)) effects
|
, Member (State (Environment location)) effects
|
||||||
, Member (State (Heap location (Cell location) value)) effects
|
, Member (State (Heap location (Cell location) value)) effects
|
||||||
, Ord location
|
, Ord location
|
||||||
, Reducer value (Cell location value)
|
, Reducer value (Cell location value)
|
||||||
@ -200,6 +207,47 @@ makeNamespace name addr super = do
|
|||||||
v <$ assign addr v
|
v <$ assign addr v
|
||||||
|
|
||||||
|
|
||||||
|
-- | Evaluate a term within the context of the scoped environment of 'scopedEnvTerm'.
|
||||||
|
evaluateInScopedEnv :: ( AbstractValue location value effects
|
||||||
|
, Member (State (Environment location)) effects
|
||||||
|
)
|
||||||
|
=> Evaluator location value effects value
|
||||||
|
-> Evaluator location value effects value
|
||||||
|
-> Evaluator location value effects value
|
||||||
|
evaluateInScopedEnv scopedEnvTerm term = do
|
||||||
|
scopedEnv <- scopedEnvTerm >>= scopedEnvironment
|
||||||
|
maybe term (flip localEnv term . mergeEnvs) scopedEnv
|
||||||
|
|
||||||
|
|
||||||
|
-- | Evaluates a 'Value' returning the referenced value
|
||||||
|
value :: ( AbstractValue location value effects
|
||||||
|
, Members '[ Allocator location value
|
||||||
|
, Reader (Environment location)
|
||||||
|
, Resumable (EnvironmentError value)
|
||||||
|
, State (Environment location)
|
||||||
|
, State (Heap location (Cell location) value)
|
||||||
|
] effects
|
||||||
|
)
|
||||||
|
=> ValueRef value
|
||||||
|
-> Evaluator location value effects value
|
||||||
|
value (LvalLocal var) = variable var
|
||||||
|
value (LvalMember obj prop) = evaluateInScopedEnv (pure obj) (variable prop)
|
||||||
|
value (Rval val) = pure val
|
||||||
|
|
||||||
|
-- | Evaluates a 'Subterm' to its rval
|
||||||
|
subtermValue :: ( AbstractValue location value effects
|
||||||
|
, Members '[ Allocator location value
|
||||||
|
, Reader (Environment location)
|
||||||
|
, Resumable (EnvironmentError value)
|
||||||
|
, State (Environment location)
|
||||||
|
, State (Heap location (Cell location) value)
|
||||||
|
] effects
|
||||||
|
)
|
||||||
|
=> Subterm term (Evaluator location value effects (ValueRef value))
|
||||||
|
-> Evaluator location value effects value
|
||||||
|
subtermValue = value <=< subtermRef
|
||||||
|
|
||||||
|
|
||||||
-- | Value types, e.g. closures, which can root a set of addresses.
|
-- | Value types, e.g. closures, which can root a set of addresses.
|
||||||
class ValueRoots location value where
|
class ValueRoots location value where
|
||||||
-- | Compute the set of addresses rooted by a given value.
|
-- | Compute the set of addresses rooted by a given value.
|
||||||
|
@ -1,8 +1,8 @@
|
|||||||
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
|
||||||
module Data.Abstract.Address where
|
module Data.Abstract.Address where
|
||||||
|
|
||||||
import Data.Abstract.FreeVariables
|
|
||||||
import Data.Abstract.Module (ModuleInfo)
|
import Data.Abstract.Module (ModuleInfo)
|
||||||
|
import Data.Abstract.Name
|
||||||
import Data.Abstract.Package (PackageInfo)
|
import Data.Abstract.Package (PackageInfo)
|
||||||
import Data.Monoid (Last(..))
|
import Data.Monoid (Last(..))
|
||||||
import Data.Semigroup.Reducer
|
import Data.Semigroup.Reducer
|
||||||
@ -35,7 +35,7 @@ newtype Monovariant = Monovariant { unMonovariant :: Name }
|
|||||||
deriving (Eq, Ord)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
instance Show Monovariant where
|
instance Show Monovariant where
|
||||||
showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unName . unMonovariant
|
showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unMonovariant
|
||||||
|
|
||||||
|
|
||||||
data Located location = Located
|
data Located location = Located
|
||||||
|
@ -1,9 +1,9 @@
|
|||||||
{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
|
{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
|
||||||
module Data.Abstract.Cache where
|
module Data.Abstract.Cache where
|
||||||
|
|
||||||
import Control.Abstract.Evaluator
|
|
||||||
import Data.Abstract.Configuration
|
import Data.Abstract.Configuration
|
||||||
import Data.Abstract.Heap
|
import Data.Abstract.Heap
|
||||||
|
import Data.Abstract.Ref
|
||||||
import Data.Map.Monoidal as Monoidal
|
import Data.Map.Monoidal as Monoidal
|
||||||
import Data.Semilattice.Lower
|
import Data.Semilattice.Lower
|
||||||
import Prologue
|
import Prologue
|
||||||
|
@ -6,9 +6,9 @@ import Data.Abstract.Live
|
|||||||
|
|
||||||
-- | A single point in a program’s execution.
|
-- | A single point in a program’s execution.
|
||||||
data Configuration term location cell value = Configuration
|
data Configuration term location cell value = Configuration
|
||||||
{ configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate.
|
{ configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate.
|
||||||
, configurationRoots :: Live location value -- ^ The set of rooted addresses.
|
, configurationRoots :: Live location value -- ^ The set of rooted addresses.
|
||||||
, configurationEnvironment :: Environment location value -- ^ The environment binding any free variables in 'configurationTerm'.
|
, configurationEnvironment :: Environment location -- ^ The environment binding any free variables in 'configurationTerm'.
|
||||||
, configurationHeap :: Heap location cell value -- ^ The heap of values.
|
, configurationHeap :: Heap location cell value -- ^ The heap of values.
|
||||||
}
|
}
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
@ -2,6 +2,7 @@
|
|||||||
module Data.Abstract.Declarations where
|
module Data.Abstract.Declarations where
|
||||||
|
|
||||||
import Data.Abstract.FreeVariables
|
import Data.Abstract.FreeVariables
|
||||||
|
import Data.Abstract.Name
|
||||||
import Data.Sum
|
import Data.Sum
|
||||||
import Data.Term
|
import Data.Term
|
||||||
import Prologue
|
import Prologue
|
||||||
|
@ -19,8 +19,8 @@ module Data.Abstract.Environment
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Abstract.Address
|
import Data.Abstract.Address
|
||||||
import Data.Abstract.FreeVariables
|
|
||||||
import Data.Abstract.Live
|
import Data.Abstract.Live
|
||||||
|
import Data.Abstract.Name
|
||||||
import Data.Align
|
import Data.Align
|
||||||
import qualified Data.List.NonEmpty as NonEmpty
|
import qualified Data.List.NonEmpty as NonEmpty
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
@ -35,36 +35,32 @@ import Prologue
|
|||||||
-- | A LIFO stack of maps of names to addresses, representing a lexically-scoped evaluation environment.
|
-- | A LIFO stack of maps of names to addresses, representing a lexically-scoped evaluation environment.
|
||||||
-- All behaviors can be assumed to be frontmost-biased: looking up "a" will check the most specific
|
-- All behaviors can be assumed to be frontmost-biased: looking up "a" will check the most specific
|
||||||
-- scope for "a", then the next, and so on.
|
-- scope for "a", then the next, and so on.
|
||||||
newtype Environment location value = Environment { unEnvironment :: NonEmpty (Map.Map Name (Address location value)) }
|
newtype Environment location = Environment { unEnvironment :: NonEmpty (Map.Map Name location) }
|
||||||
deriving (Eq, Ord)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
instance Eq location => Eq1 (Environment location) where liftEq eq (Environment a) (Environment b) = liftEq (liftEq (liftEq eq)) a b
|
mergeEnvs :: Environment location -> Environment location -> Environment location
|
||||||
instance Ord location => Ord1 (Environment location) where liftCompare compare (Environment a) (Environment b) = liftCompare (liftCompare (liftCompare compare)) a b
|
|
||||||
instance Show location => Show1 (Environment location) where liftShowsPrec _ _ = showsPrec
|
|
||||||
|
|
||||||
mergeEnvs :: Environment location value -> Environment location value -> Environment location value
|
|
||||||
mergeEnvs (Environment (a :| as)) (Environment (b :| bs)) =
|
mergeEnvs (Environment (a :| as)) (Environment (b :| bs)) =
|
||||||
Environment ((<>) a b :| alignWith (mergeThese (<>)) as bs)
|
Environment ((<>) a b :| alignWith (mergeThese (<>)) as bs)
|
||||||
|
|
||||||
emptyEnv :: Environment location value
|
emptyEnv :: Environment location
|
||||||
emptyEnv = Environment (lowerBound :| [])
|
emptyEnv = Environment (lowerBound :| [])
|
||||||
|
|
||||||
-- | Make and enter a new empty scope in the given environment.
|
-- | Make and enter a new empty scope in the given environment.
|
||||||
push :: Environment location value -> Environment location value
|
push :: Environment location -> Environment location
|
||||||
push (Environment (a :| as)) = Environment (mempty :| a : as)
|
push (Environment (a :| as)) = Environment (mempty :| a : as)
|
||||||
|
|
||||||
-- | Remove the frontmost scope.
|
-- | Remove the frontmost scope.
|
||||||
pop :: Environment location value -> Environment location value
|
pop :: Environment location -> Environment location
|
||||||
pop (Environment (_ :| [])) = emptyEnv
|
pop (Environment (_ :| [])) = emptyEnv
|
||||||
pop (Environment (_ :| a : as)) = Environment (a :| as)
|
pop (Environment (_ :| a : as)) = Environment (a :| as)
|
||||||
|
|
||||||
-- | Drop all scopes save for the frontmost one.
|
-- | Drop all scopes save for the frontmost one.
|
||||||
head :: Environment location value -> Environment location value
|
head :: Environment location -> Environment location
|
||||||
head (Environment (a :| _)) = Environment (a :| [])
|
head (Environment (a :| _)) = Environment (a :| [])
|
||||||
|
|
||||||
-- | Take the union of two environments. When duplicate keys are found in the
|
-- | Take the union of two environments. When duplicate keys are found in the
|
||||||
-- name to address map, the second definition wins.
|
-- name to address map, the second definition wins.
|
||||||
mergeNewer :: Environment location value -> Environment location value -> Environment location value
|
mergeNewer :: Environment location -> Environment location -> Environment location
|
||||||
mergeNewer (Environment a) (Environment b) =
|
mergeNewer (Environment a) (Environment b) =
|
||||||
Environment (NonEmpty.fromList . reverse $ alignWith (mergeThese combine) (reverse as) (reverse bs))
|
Environment (NonEmpty.fromList . reverse $ alignWith (mergeThese combine) (reverse as) (reverse bs))
|
||||||
where
|
where
|
||||||
@ -76,45 +72,45 @@ mergeNewer (Environment a) (Environment b) =
|
|||||||
--
|
--
|
||||||
-- >>> pairs shadowed
|
-- >>> pairs shadowed
|
||||||
-- [("foo",Precise 1)]
|
-- [("foo",Precise 1)]
|
||||||
pairs :: Environment location value -> [(Name, Address location value)]
|
pairs :: Environment location -> [(Name, Address location value)]
|
||||||
pairs = Map.toList . fold . unEnvironment
|
pairs = map (second Address) . Map.toList . fold . unEnvironment
|
||||||
|
|
||||||
unpairs :: [(Name, Address location value)] -> Environment location value
|
unpairs :: [(Name, Address location value)] -> Environment location
|
||||||
unpairs = Environment . pure . Map.fromList
|
unpairs = Environment . pure . Map.fromList . map (second unAddress)
|
||||||
|
|
||||||
-- | Lookup a 'Name' in the environment.
|
-- | Lookup a 'Name' in the environment.
|
||||||
--
|
--
|
||||||
-- >>> lookup (name "foo") shadowed
|
-- >>> lookup (name "foo") shadowed
|
||||||
-- Just (Precise 1)
|
-- Just (Precise 1)
|
||||||
lookup :: Name -> Environment location value -> Maybe (Address location value)
|
lookup :: Name -> Environment location -> Maybe (Address location value)
|
||||||
lookup k = foldMapA (Map.lookup k) . unEnvironment
|
lookup k = fmap Address . foldMapA (Map.lookup k) . unEnvironment
|
||||||
|
|
||||||
-- | Insert a 'Name' in the environment.
|
-- | Insert a 'Name' in the environment.
|
||||||
insert :: Name -> Address location value -> Environment location value -> Environment location value
|
insert :: Name -> Address location value -> Environment location -> Environment location
|
||||||
insert name address (Environment (a :| as)) = Environment (Map.insert name address a :| as)
|
insert name (Address value) (Environment (a :| as)) = Environment (Map.insert name value a :| as)
|
||||||
|
|
||||||
-- | Remove a 'Name' from the environment.
|
-- | Remove a 'Name' from the environment.
|
||||||
--
|
--
|
||||||
-- >>> delete (name "foo") shadowed
|
-- >>> delete (name "foo") shadowed
|
||||||
-- Environment []
|
-- Environment []
|
||||||
delete :: Name -> Environment location value -> Environment location value
|
delete :: Name -> Environment location -> Environment location
|
||||||
delete name = trim . Environment . fmap (Map.delete name) . unEnvironment
|
delete name = trim . Environment . fmap (Map.delete name) . unEnvironment
|
||||||
|
|
||||||
trim :: Environment location value -> Environment location value
|
trim :: Environment location -> Environment location
|
||||||
trim (Environment (a :| as)) = Environment (a :| filtered)
|
trim (Environment (a :| as)) = Environment (a :| filtered)
|
||||||
where filtered = filter (not . Map.null) as
|
where filtered = filter (not . Map.null) as
|
||||||
|
|
||||||
bind :: Foldable t => t Name -> Environment location value -> Environment location value
|
bind :: Foldable t => t Name -> Environment location -> Environment location
|
||||||
bind names env = unpairs (mapMaybe lookupName (toList names))
|
bind names env = unpairs (mapMaybe lookupName (toList names))
|
||||||
where
|
where
|
||||||
lookupName name = (,) name <$> lookup name env
|
lookupName name = (,) name <$> lookup name env
|
||||||
|
|
||||||
-- | Get all bound 'Name's in an environment.
|
-- | Get all bound 'Name's in an environment.
|
||||||
names :: Environment location value -> [Name]
|
names :: Environment location -> [Name]
|
||||||
names = fmap fst . pairs
|
names = fmap fst . pairs
|
||||||
|
|
||||||
-- | Lookup and alias name-value bindings from an environment.
|
-- | Lookup and alias name-value bindings from an environment.
|
||||||
overwrite :: [(Name, Name)] -> Environment location value -> Environment location value
|
overwrite :: [(Name, Name)] -> Environment location -> Environment location
|
||||||
overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs
|
overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs
|
||||||
where
|
where
|
||||||
lookupAndAlias (oldName, newName) = (,) newName <$> lookup oldName env
|
lookupAndAlias (oldName, newName) = (,) newName <$> lookup oldName env
|
||||||
@ -122,14 +118,14 @@ overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs
|
|||||||
-- | Retrieve the 'Live' set of addresses to which the given free variable names are bound.
|
-- | Retrieve the 'Live' set of addresses to which the given free variable names are bound.
|
||||||
--
|
--
|
||||||
-- Unbound names are silently dropped.
|
-- Unbound names are silently dropped.
|
||||||
roots :: (Ord location, Foldable t) => Environment location value -> t Name -> Live location value
|
roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location value
|
||||||
roots env = foldMap (maybe mempty liveSingleton . flip lookup env)
|
roots env = foldMap (maybe mempty liveSingleton . flip lookup env)
|
||||||
|
|
||||||
addresses :: Ord location => Environment location value -> Live location value
|
addresses :: Ord location => Environment location -> Live location value
|
||||||
addresses = fromAddresses . map snd . pairs
|
addresses = fromAddresses . map snd . pairs
|
||||||
|
|
||||||
|
|
||||||
instance Lower (Environment location value) where lowerBound = emptyEnv
|
instance Lower (Environment location) where lowerBound = emptyEnv
|
||||||
|
|
||||||
instance Show location => Show (Environment location value) where
|
instance Show location => Show (Environment location) where
|
||||||
showsPrec d = showsUnaryWith showsPrec "Environment" d . map (first unName) . pairs
|
showsPrec d = showsUnaryWith showsPrec "Environment" d . pairs
|
||||||
|
@ -2,36 +2,37 @@
|
|||||||
module Data.Abstract.Evaluatable
|
module Data.Abstract.Evaluatable
|
||||||
( module X
|
( module X
|
||||||
, Evaluatable(..)
|
, Evaluatable(..)
|
||||||
|
, evaluatePackageWith
|
||||||
|
, isolate
|
||||||
|
, traceResolve
|
||||||
|
-- | Effects
|
||||||
|
, EvalError(..)
|
||||||
|
, throwEvalError
|
||||||
|
, runEvalError
|
||||||
|
, runEvalErrorWith
|
||||||
, Unspecialized(..)
|
, Unspecialized(..)
|
||||||
, runUnspecialized
|
, runUnspecialized
|
||||||
, runUnspecializedWith
|
, runUnspecializedWith
|
||||||
, EvalError(..)
|
, Cell
|
||||||
, runEvalError
|
|
||||||
, runEvalErrorWith
|
|
||||||
, value
|
|
||||||
, subtermValue
|
|
||||||
, evaluateInScopedEnv
|
|
||||||
, evaluatePackageWith
|
|
||||||
, throwEvalError
|
|
||||||
, traceResolve
|
|
||||||
, builtin
|
|
||||||
, isolate
|
|
||||||
, Modules
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Abstract as X hiding (Goto(..), LoopControl(..), Modules(..), Return(..), TermEvaluator(..))
|
import Control.Abstract
|
||||||
import Control.Abstract.Evaluator (LoopControl, Return(..))
|
import Control.Abstract.Context as X
|
||||||
import Control.Abstract.Goto (Goto(..))
|
import Control.Abstract.Environment as X hiding (runEnvironmentError, runEnvironmentErrorWith)
|
||||||
import Control.Abstract.Modules (Modules(..))
|
import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catchLoopControl, runLoopControl, catchReturn, runReturn)
|
||||||
import Control.Abstract.TermEvaluator (TermEvaluator(..))
|
import Control.Abstract.Exports as X
|
||||||
|
import Control.Abstract.Heap as X hiding (AddressError(..), runAddressError, runAddressErrorWith)
|
||||||
|
import Control.Abstract.Modules as X (Modules, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve)
|
||||||
|
import Control.Abstract.Value as X
|
||||||
import Data.Abstract.Declarations as X
|
import Data.Abstract.Declarations as X
|
||||||
import Data.Abstract.Environment as X
|
import Data.Abstract.Environment as X
|
||||||
import Data.Abstract.Exports as Exports
|
import Data.Abstract.Exports as Exports
|
||||||
import Data.Abstract.FreeVariables as X
|
import Data.Abstract.FreeVariables as X
|
||||||
import Data.Abstract.Module
|
import Data.Abstract.Module
|
||||||
import Data.Abstract.ModuleTable as ModuleTable
|
import Data.Abstract.ModuleTable as ModuleTable
|
||||||
|
import Data.Abstract.Name as X
|
||||||
import Data.Abstract.Package as Package
|
import Data.Abstract.Package as Package
|
||||||
import Data.ByteString.Char8 (pack, unpack)
|
import Data.Abstract.Ref as X
|
||||||
import Data.Scientific (Scientific)
|
import Data.Scientific (Scientific)
|
||||||
import Data.Semigroup.App
|
import Data.Semigroup.App
|
||||||
import Data.Semigroup.Foldable
|
import Data.Semigroup.Foldable
|
||||||
@ -57,17 +58,17 @@ type EvaluatableConstraints location term value effects =
|
|||||||
, Members '[ Allocator location value
|
, Members '[ Allocator location value
|
||||||
, LoopControl value
|
, LoopControl value
|
||||||
, Modules location value
|
, Modules location value
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, Reader ModuleInfo
|
, Reader ModuleInfo
|
||||||
, Reader PackageInfo
|
, Reader PackageInfo
|
||||||
, Reader Span
|
, Reader Span
|
||||||
, Resumable (EnvironmentError value)
|
, Resumable (EnvironmentError value)
|
||||||
, Resumable (EvalError value)
|
, Resumable EvalError
|
||||||
, Resumable ResolutionError
|
, Resumable ResolutionError
|
||||||
, Resumable (Unspecialized value)
|
, Resumable (Unspecialized value)
|
||||||
, Return value
|
, Return value
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Exports location value)
|
, State (Exports location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
, Trace
|
, Trace
|
||||||
] effects
|
] effects
|
||||||
@ -76,148 +77,6 @@ type EvaluatableConstraints location term value effects =
|
|||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
-- | The type of error thrown when failing to evaluate a term.
|
|
||||||
data EvalError value resume where
|
|
||||||
FreeVariablesError :: [Name] -> EvalError value Name
|
|
||||||
-- Indicates that our evaluator wasn't able to make sense of these literals.
|
|
||||||
IntegerFormatError :: ByteString -> EvalError value Integer
|
|
||||||
FloatFormatError :: ByteString -> EvalError value Scientific
|
|
||||||
RationalFormatError :: ByteString -> EvalError value Rational
|
|
||||||
DefaultExportError :: EvalError value ()
|
|
||||||
ExportError :: ModulePath -> Name -> EvalError value ()
|
|
||||||
EnvironmentLookupError :: value -> EvalError value value
|
|
||||||
|
|
||||||
runEvalError :: Effectful (m value) => m value (Resumable (EvalError value) ': effects) a -> m value effects (Either (SomeExc (EvalError value)) a)
|
|
||||||
runEvalError = runResumable
|
|
||||||
|
|
||||||
runEvalErrorWith :: Effectful (m value) => (forall resume . EvalError value resume -> m value effects resume) -> m value (Resumable (EvalError value) ': effects) a -> m value effects a
|
|
||||||
runEvalErrorWith = runResumableWith
|
|
||||||
|
|
||||||
-- | Evaluate a term within the context of the scoped environment of 'scopedEnvTerm'.
|
|
||||||
-- Throws an 'EnvironmentLookupError' if @scopedEnvTerm@ does not have an environment.
|
|
||||||
evaluateInScopedEnv :: ( AbstractValue location value effects
|
|
||||||
, Members '[ Resumable (EvalError value)
|
|
||||||
, State (Environment location value)
|
|
||||||
] effects
|
|
||||||
)
|
|
||||||
=> Evaluator location value effects value
|
|
||||||
-> Evaluator location value effects value
|
|
||||||
-> Evaluator location value effects value
|
|
||||||
evaluateInScopedEnv scopedEnvTerm term = do
|
|
||||||
value <- scopedEnvTerm
|
|
||||||
scopedEnv <- scopedEnvironment value
|
|
||||||
maybe (throwEvalError (EnvironmentLookupError value)) (flip localEnv term . mergeEnvs) scopedEnv
|
|
||||||
|
|
||||||
deriving instance Eq a => Eq (EvalError a b)
|
|
||||||
deriving instance Show a => Show (EvalError a b)
|
|
||||||
instance Show value => Show1 (EvalError value) where
|
|
||||||
liftShowsPrec _ _ = showsPrec
|
|
||||||
instance Eq term => Eq1 (EvalError term) where
|
|
||||||
liftEq _ (FreeVariablesError a) (FreeVariablesError b) = a == b
|
|
||||||
liftEq _ DefaultExportError DefaultExportError = True
|
|
||||||
liftEq _ (ExportError a b) (ExportError c d) = (a == c) && (b == d)
|
|
||||||
liftEq _ (IntegerFormatError a) (IntegerFormatError b) = a == b
|
|
||||||
liftEq _ (FloatFormatError a) (FloatFormatError b) = a == b
|
|
||||||
liftEq _ (RationalFormatError a) (RationalFormatError b) = a == b
|
|
||||||
liftEq _ (EnvironmentLookupError a) (EnvironmentLookupError b) = a == b
|
|
||||||
liftEq _ _ _ = False
|
|
||||||
|
|
||||||
|
|
||||||
throwEvalError :: Member (Resumable (EvalError value)) effects => EvalError value resume -> Evaluator location value effects resume
|
|
||||||
throwEvalError = throwResumable
|
|
||||||
|
|
||||||
|
|
||||||
data Unspecialized a b where
|
|
||||||
Unspecialized :: Prelude.String -> Unspecialized value (ValueRef value)
|
|
||||||
|
|
||||||
instance Eq1 (Unspecialized a) where
|
|
||||||
liftEq _ (Unspecialized a) (Unspecialized b) = a == b
|
|
||||||
|
|
||||||
deriving instance Eq (Unspecialized a b)
|
|
||||||
deriving instance Show (Unspecialized a b)
|
|
||||||
instance Show1 (Unspecialized a) where
|
|
||||||
liftShowsPrec _ _ = showsPrec
|
|
||||||
|
|
||||||
-- | Evaluates a 'Value' returning the referenced value
|
|
||||||
value :: ( AbstractValue location value effects
|
|
||||||
, Members '[ Allocator location value
|
|
||||||
, Reader (Environment location value)
|
|
||||||
, Resumable (EnvironmentError value)
|
|
||||||
, Resumable (EvalError value)
|
|
||||||
, State (Environment location value)
|
|
||||||
, State (Heap location (Cell location) value)
|
|
||||||
] effects
|
|
||||||
)
|
|
||||||
=> ValueRef value
|
|
||||||
-> Evaluator location value effects value
|
|
||||||
value (LvalLocal var) = variable var
|
|
||||||
value (LvalMember obj prop) = evaluateInScopedEnv (pure obj) (variable prop)
|
|
||||||
value (Rval val) = pure val
|
|
||||||
|
|
||||||
-- | Evaluates a 'Subterm' to its rval
|
|
||||||
subtermValue :: ( AbstractValue location value effects
|
|
||||||
, Members '[ Allocator location value
|
|
||||||
, Reader (Environment location value)
|
|
||||||
, Resumable (EnvironmentError value)
|
|
||||||
, Resumable (EvalError value)
|
|
||||||
, State (Environment location value)
|
|
||||||
, State (Heap location (Cell location) value)
|
|
||||||
] effects
|
|
||||||
)
|
|
||||||
=> Subterm term (Evaluator location value effects (ValueRef value))
|
|
||||||
-> Evaluator location value effects value
|
|
||||||
subtermValue = value <=< subtermRef
|
|
||||||
|
|
||||||
runUnspecialized :: Effectful (m value) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects (Either (SomeExc (Unspecialized value)) a)
|
|
||||||
runUnspecialized = runResumable
|
|
||||||
|
|
||||||
runUnspecializedWith :: Effectful (m value) => (forall resume . Unspecialized value resume -> m value effects resume) -> m value (Resumable (Unspecialized value) ': effects) a -> m value effects a
|
|
||||||
runUnspecializedWith = runResumableWith
|
|
||||||
|
|
||||||
-- Instances
|
|
||||||
|
|
||||||
-- | If we can evaluate any syntax which can occur in a 'Sum', we can evaluate the 'Sum'.
|
|
||||||
instance Apply Evaluatable fs => Evaluatable (Sum fs) where
|
|
||||||
eval = apply @Evaluatable eval
|
|
||||||
|
|
||||||
-- | Evaluating a 'TermF' ignores its annotation, evaluating the underlying syntax.
|
|
||||||
instance Evaluatable s => Evaluatable (TermF s a) where
|
|
||||||
eval = eval . termFOut
|
|
||||||
|
|
||||||
--- | '[]' is treated as an imperative sequence of statements/declarations s.t.:
|
|
||||||
---
|
|
||||||
--- 1. Each statement’s effects on the store are accumulated;
|
|
||||||
--- 2. Each statement can affect the environment of later statements (e.g. by 'modify'-ing the environment); and
|
|
||||||
--- 3. Only the last statement’s return value is returned.
|
|
||||||
instance Evaluatable [] where
|
|
||||||
-- 'nonEmpty' and 'foldMap1' enable us to return the last statement’s result instead of 'unit' for non-empty lists.
|
|
||||||
eval = maybe (Rval <$> unit) (runApp . foldMap1 (App . subtermRef)) . nonEmpty
|
|
||||||
|
|
||||||
|
|
||||||
traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator location value effects ()
|
|
||||||
traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
|
|
||||||
|
|
||||||
|
|
||||||
builtin :: ( HasCallStack
|
|
||||||
, Members '[ Allocator location value
|
|
||||||
, Reader (Environment location value)
|
|
||||||
, Reader ModuleInfo
|
|
||||||
, Reader Span
|
|
||||||
, State (Environment location value)
|
|
||||||
, State (Heap location (Cell location) value)
|
|
||||||
] effects
|
|
||||||
, Ord location
|
|
||||||
, Reducer value (Cell location value)
|
|
||||||
)
|
|
||||||
=> String
|
|
||||||
-> Evaluator location value effects value
|
|
||||||
-> Evaluator location value effects ()
|
|
||||||
builtin n def = withCurrentCallStack callStack $ do
|
|
||||||
let name = X.name ("__semantic_" <> pack n)
|
|
||||||
addr <- alloc name
|
|
||||||
modifyEnv (X.insert name addr)
|
|
||||||
def >>= assign addr
|
|
||||||
|
|
||||||
-- | Evaluate a given package.
|
-- | Evaluate a given package.
|
||||||
evaluatePackageWith :: forall location term value inner inner' outer
|
evaluatePackageWith :: forall location term value inner inner' outer
|
||||||
-- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' locations require knowledge of 'currentModule' to run. Can we fix that? If not, can we factor this effect list out?
|
-- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' locations require knowledge of 'currentModule' to run. Can we fix that? If not, can we factor this effect list out?
|
||||||
@ -226,13 +85,13 @@ evaluatePackageWith :: forall location term value inner inner' outer
|
|||||||
, EvaluatableConstraints location term value inner
|
, EvaluatableConstraints location term value inner
|
||||||
, Members '[ Fail
|
, Members '[ Fail
|
||||||
, Fresh
|
, Fresh
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, Resumable (AddressError location value)
|
, Resumable (AddressError location value)
|
||||||
, Resumable (LoadError location value)
|
, Resumable (LoadError location value)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Exports location value)
|
, State (Exports location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
, State (ModuleTable (Maybe (Environment location value, value)))
|
, State (ModuleTable (Maybe (Environment location, value)))
|
||||||
, Trace
|
, Trace
|
||||||
] outer
|
] outer
|
||||||
, Recursive term
|
, Recursive term
|
||||||
@ -273,9 +132,7 @@ evaluatePackageWith analyzeModule analyzeTerm package
|
|||||||
maybe v ((`call` []) <=< variable) sym
|
maybe v ((`call` []) <=< variable) sym
|
||||||
|
|
||||||
evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule)) $ do
|
evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule)) $ do
|
||||||
_ <- runInModule moduleInfoFromCallStack . TermEvaluator $ do
|
_ <- runInModule moduleInfoFromCallStack (TermEvaluator (defineBuiltins *> unit))
|
||||||
builtin "print" (closure ["s"] lowerBound (variable "s" >>= asString >>= trace . unpack >> unit))
|
|
||||||
unit
|
|
||||||
fst <$> evalModule prelude
|
fst <$> evalModule prelude
|
||||||
|
|
||||||
withPrelude Nothing a = a
|
withPrelude Nothing a = a
|
||||||
@ -296,5 +153,84 @@ newtype Gotos location value outer = Gotos { getGotos :: GotoTable (LoopControl
|
|||||||
|
|
||||||
|
|
||||||
-- | Isolate the given action with an empty global environment and exports.
|
-- | Isolate the given action with an empty global environment and exports.
|
||||||
isolate :: Members '[State (Environment location value), State (Exports location value)] effects => Evaluator location value effects a -> Evaluator location value effects a
|
isolate :: Members '[State (Environment location), State (Exports location)] effects => Evaluator location value effects a -> Evaluator location value effects a
|
||||||
isolate = withEnv lowerBound . withExports lowerBound
|
isolate = withEnv lowerBound . withExports lowerBound
|
||||||
|
|
||||||
|
traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator location value effects ()
|
||||||
|
traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
|
||||||
|
|
||||||
|
|
||||||
|
-- Effects
|
||||||
|
|
||||||
|
-- | The type of error thrown when failing to evaluate a term.
|
||||||
|
data EvalError return where
|
||||||
|
FreeVariablesError :: [Name] -> EvalError Name
|
||||||
|
-- Indicates that our evaluator wasn't able to make sense of these literals.
|
||||||
|
IntegerFormatError :: ByteString -> EvalError Integer
|
||||||
|
FloatFormatError :: ByteString -> EvalError Scientific
|
||||||
|
RationalFormatError :: ByteString -> EvalError Rational
|
||||||
|
DefaultExportError :: EvalError ()
|
||||||
|
ExportError :: ModulePath -> Name -> EvalError ()
|
||||||
|
|
||||||
|
deriving instance Eq (EvalError return)
|
||||||
|
deriving instance Show (EvalError return)
|
||||||
|
|
||||||
|
instance Eq1 EvalError where
|
||||||
|
liftEq _ (FreeVariablesError a) (FreeVariablesError b) = a == b
|
||||||
|
liftEq _ DefaultExportError DefaultExportError = True
|
||||||
|
liftEq _ (ExportError a b) (ExportError c d) = (a == c) && (b == d)
|
||||||
|
liftEq _ (IntegerFormatError a) (IntegerFormatError b) = a == b
|
||||||
|
liftEq _ (FloatFormatError a) (FloatFormatError b) = a == b
|
||||||
|
liftEq _ (RationalFormatError a) (RationalFormatError b) = a == b
|
||||||
|
liftEq _ _ _ = False
|
||||||
|
|
||||||
|
instance Show1 EvalError where
|
||||||
|
liftShowsPrec _ _ = showsPrec
|
||||||
|
|
||||||
|
throwEvalError :: (Effectful m, Member (Resumable EvalError) effects) => EvalError resume -> m effects resume
|
||||||
|
throwEvalError = throwResumable
|
||||||
|
|
||||||
|
runEvalError :: Effectful m => m (Resumable EvalError ': effects) a -> m effects (Either (SomeExc EvalError) a)
|
||||||
|
runEvalError = runResumable
|
||||||
|
|
||||||
|
runEvalErrorWith :: Effectful m => (forall resume . EvalError resume -> m effects resume) -> m (Resumable EvalError ': effects) a -> m effects a
|
||||||
|
runEvalErrorWith = runResumableWith
|
||||||
|
|
||||||
|
|
||||||
|
data Unspecialized a b where
|
||||||
|
Unspecialized :: String -> Unspecialized value (ValueRef value)
|
||||||
|
|
||||||
|
deriving instance Eq (Unspecialized a b)
|
||||||
|
deriving instance Show (Unspecialized a b)
|
||||||
|
|
||||||
|
instance Eq1 (Unspecialized a) where
|
||||||
|
liftEq _ (Unspecialized a) (Unspecialized b) = a == b
|
||||||
|
|
||||||
|
instance Show1 (Unspecialized a) where
|
||||||
|
liftShowsPrec _ _ = showsPrec
|
||||||
|
|
||||||
|
runUnspecialized :: Effectful (m value) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects (Either (SomeExc (Unspecialized value)) a)
|
||||||
|
runUnspecialized = runResumable
|
||||||
|
|
||||||
|
runUnspecializedWith :: Effectful (m value) => (forall resume . Unspecialized value resume -> m value effects resume) -> m value (Resumable (Unspecialized value) ': effects) a -> m value effects a
|
||||||
|
runUnspecializedWith = runResumableWith
|
||||||
|
|
||||||
|
|
||||||
|
-- Instances
|
||||||
|
|
||||||
|
-- | If we can evaluate any syntax which can occur in a 'Sum', we can evaluate the 'Sum'.
|
||||||
|
instance Apply Evaluatable fs => Evaluatable (Sum fs) where
|
||||||
|
eval = apply @Evaluatable eval
|
||||||
|
|
||||||
|
-- | Evaluating a 'TermF' ignores its annotation, evaluating the underlying syntax.
|
||||||
|
instance Evaluatable s => Evaluatable (TermF s a) where
|
||||||
|
eval = eval . termFOut
|
||||||
|
|
||||||
|
--- | '[]' is treated as an imperative sequence of statements/declarations s.t.:
|
||||||
|
---
|
||||||
|
--- 1. Each statement’s effects on the store are accumulated;
|
||||||
|
--- 2. Each statement can affect the environment of later statements (e.g. by 'modify'-ing the environment); and
|
||||||
|
--- 3. Only the last statement’s return value is returned.
|
||||||
|
instance Evaluatable [] where
|
||||||
|
-- 'nonEmpty' and 'foldMap1' enable us to return the last statement’s result instead of 'unit' for non-empty lists.
|
||||||
|
eval = maybe (Rval <$> unit) (runApp . foldMap1 (App . subtermRef)) . nonEmpty
|
||||||
|
@ -11,30 +11,27 @@ import Prelude hiding (null)
|
|||||||
import Prologue hiding (null)
|
import Prologue hiding (null)
|
||||||
import Data.Abstract.Address
|
import Data.Abstract.Address
|
||||||
import Data.Abstract.Environment (Environment, unpairs)
|
import Data.Abstract.Environment (Environment, unpairs)
|
||||||
import Data.Abstract.FreeVariables
|
import Data.Abstract.Name
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Semilattice.Lower
|
import Data.Semilattice.Lower
|
||||||
|
|
||||||
-- | A map of export names to an alias & address tuple.
|
-- | A map of export names to an alias & address tuple.
|
||||||
newtype Exports location value = Exports { unExports :: Map.Map Name (Name, Maybe (Address location value)) }
|
newtype Exports location = Exports { unExports :: Map.Map Name (Name, Maybe location) }
|
||||||
deriving (Eq, Lower, Monoid, Ord, Semigroup)
|
deriving (Eq, Lower, Monoid, Ord, Semigroup)
|
||||||
|
|
||||||
null :: Exports location value -> Bool
|
null :: Exports location -> Bool
|
||||||
null = Map.null . unExports
|
null = Map.null . unExports
|
||||||
|
|
||||||
toEnvironment :: Exports location value -> Environment location value
|
toEnvironment :: Exports location -> Environment location
|
||||||
toEnvironment exports = unpairs (mapMaybe collectExport (toList (unExports exports)))
|
toEnvironment exports = unpairs (mapMaybe (traverse (fmap Address)) (toList (unExports exports)))
|
||||||
where
|
|
||||||
collectExport (_, Nothing) = Nothing
|
|
||||||
collectExport (n, Just value) = Just (n, value)
|
|
||||||
|
|
||||||
insert :: Name -> Name -> Maybe (Address location value) -> Exports location value -> Exports location value
|
insert :: Name -> Name -> Maybe (Address location value) -> Exports location -> Exports location
|
||||||
insert name alias address = Exports . Map.insert name (alias, address) . unExports
|
insert name alias address = Exports . Map.insert name (alias, unAddress <$> address) . unExports
|
||||||
|
|
||||||
-- TODO: Should we filter for duplicates here?
|
-- TODO: Should we filter for duplicates here?
|
||||||
aliases :: Exports location value -> [(Name, Name)]
|
aliases :: Exports location -> [(Name, Name)]
|
||||||
aliases = Map.toList . fmap fst . unExports
|
aliases = Map.toList . fmap fst . unExports
|
||||||
|
|
||||||
|
|
||||||
instance Show location => Show (Exports location value) where
|
instance Show location => Show (Exports location) where
|
||||||
showsPrec d = showsUnaryWith showsPrec "Exports" d . Map.toList . unExports
|
showsPrec d = showsUnaryWith showsPrec "Exports" d . Map.toList . unExports
|
||||||
|
@ -1,25 +1,11 @@
|
|||||||
{-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, UndecidableInstances #-}
|
{-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, UndecidableInstances #-}
|
||||||
module Data.Abstract.FreeVariables where
|
module Data.Abstract.FreeVariables where
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BC
|
import Data.Abstract.Name
|
||||||
import Data.String
|
|
||||||
import Data.Sum
|
import Data.Sum
|
||||||
import Data.Term
|
import Data.Term
|
||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
-- | The type of variable names.
|
|
||||||
newtype Name = Name { unName :: ByteString }
|
|
||||||
deriving (Eq, Hashable, Ord)
|
|
||||||
|
|
||||||
name :: ByteString -> Name
|
|
||||||
name = Name
|
|
||||||
|
|
||||||
instance IsString Name where
|
|
||||||
fromString = Name . BC.pack
|
|
||||||
|
|
||||||
instance Show Name where showsPrec d (Name str) = showsPrec d str
|
|
||||||
|
|
||||||
|
|
||||||
-- | Types which can contain unbound variables.
|
-- | Types which can contain unbound variables.
|
||||||
class FreeVariables term where
|
class FreeVariables term where
|
||||||
-- | The set of free variables in the given value.
|
-- | The set of free variables in the given value.
|
||||||
|
55
src/Data/Abstract/Name.hs
Normal file
55
src/Data/Abstract/Name.hs
Normal file
@ -0,0 +1,55 @@
|
|||||||
|
module Data.Abstract.Name
|
||||||
|
( Name
|
||||||
|
-- * Constructors
|
||||||
|
, name
|
||||||
|
, nameI
|
||||||
|
, unName
|
||||||
|
) where
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Char8 as BC
|
||||||
|
import qualified Data.Char as Char
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
import qualified Data.Text.Encoding as Text
|
||||||
|
import Data.String
|
||||||
|
import Prologue
|
||||||
|
|
||||||
|
-- | The type of variable names.
|
||||||
|
data Name
|
||||||
|
= Name ByteString
|
||||||
|
| I Int
|
||||||
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
|
-- | Construct a 'Name' from a 'ByteString'.
|
||||||
|
name :: ByteString -> Name
|
||||||
|
name = Name
|
||||||
|
|
||||||
|
-- | Construct a 'Name' from an 'Int'. This is suitable for automatic generation, e.g. using a Fresh effect, but should not be used for human-generated names.
|
||||||
|
nameI :: Int -> Name
|
||||||
|
nameI = I
|
||||||
|
|
||||||
|
-- | Extract a human-readable 'ByteString' from a 'Name'.
|
||||||
|
unName :: Name -> ByteString
|
||||||
|
unName (Name name) = name
|
||||||
|
unName (I i) = Text.encodeUtf8 . Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ'
|
||||||
|
where alphabet = ['a'..'z']
|
||||||
|
(n, a) = i `divMod` length alphabet
|
||||||
|
|
||||||
|
instance IsString Name where
|
||||||
|
fromString = Name . BC.pack
|
||||||
|
|
||||||
|
-- $
|
||||||
|
-- >>> I 0
|
||||||
|
-- "_a"
|
||||||
|
-- >>> I 26
|
||||||
|
-- "_aʹ"
|
||||||
|
instance Show Name where
|
||||||
|
showsPrec _ = prettyShowString . Text.unpack . Text.decodeUtf8 . unName
|
||||||
|
where prettyShowString str = showChar '"' . foldr ((.) . prettyChar) id str . showChar '"'
|
||||||
|
prettyChar c
|
||||||
|
| c `elem` ['\\', '\"'] = Char.showLitChar c
|
||||||
|
| Char.isPrint c = showChar c
|
||||||
|
| otherwise = Char.showLitChar c
|
||||||
|
|
||||||
|
instance Hashable Name where
|
||||||
|
hashWithSalt salt (Name name) = hashWithSalt salt name
|
||||||
|
hashWithSalt salt (I i) = salt `hashWithSalt` (1 :: Int) `hashWithSalt` i
|
@ -1,10 +1,10 @@
|
|||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
module Data.Abstract.Package where
|
module Data.Abstract.Package where
|
||||||
|
|
||||||
import Data.Abstract.FreeVariables
|
|
||||||
import Data.Abstract.Module
|
import Data.Abstract.Module
|
||||||
import Data.Abstract.ModuleTable as ModuleTable
|
import Data.Abstract.ModuleTable as ModuleTable
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
import Data.Abstract.Name
|
||||||
|
|
||||||
type PackageName = Name
|
type PackageName = Name
|
||||||
|
|
||||||
|
14
src/Data/Abstract/Ref.hs
Normal file
14
src/Data/Abstract/Ref.hs
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
module Data.Abstract.Ref where
|
||||||
|
|
||||||
|
import Data.Abstract.Name
|
||||||
|
|
||||||
|
-- | 'ValueRef' is the type subterms evaluate to and can represent either values directly ('Rval'), or references to values (lvals - such as local variables or object members)
|
||||||
|
data ValueRef value where
|
||||||
|
-- | A value.
|
||||||
|
Rval :: value -> ValueRef value
|
||||||
|
-- | A local variable. No environment is attached—it’s assumed that 'LvalLocal' will be evaluated in the same scope it was constructed in.
|
||||||
|
LvalLocal :: Name -> ValueRef value
|
||||||
|
-- | An object member.
|
||||||
|
LvalMember :: value -> Name -> ValueRef value
|
||||||
|
deriving (Eq, Ord, Show)
|
@ -9,7 +9,6 @@ module Data.Abstract.Type
|
|||||||
|
|
||||||
import Control.Abstract
|
import Control.Abstract
|
||||||
import Data.Abstract.Environment as Env
|
import Data.Abstract.Environment as Env
|
||||||
import Data.Abstract.Evaluatable
|
|
||||||
import Data.Semigroup.Foldable (foldMap1)
|
import Data.Semigroup.Foldable (foldMap1)
|
||||||
import Data.Semigroup.Reducer (Reducer)
|
import Data.Semigroup.Reducer (Reducer)
|
||||||
import Prologue hiding (TypeError)
|
import Prologue hiding (TypeError)
|
||||||
@ -102,22 +101,19 @@ instance Ord location => ValueRoots location Type where
|
|||||||
instance AbstractHole Type where
|
instance AbstractHole Type where
|
||||||
hole = Hole
|
hole = Hole
|
||||||
|
|
||||||
-- | Discard the value arguments (if any), constructing a 'Type' instead.
|
|
||||||
instance ( Members '[ Allocator location Type
|
instance ( Members '[ Allocator location Type
|
||||||
, Fresh
|
, Fresh
|
||||||
, NonDet
|
, NonDet
|
||||||
, Reader (Environment location Type)
|
, Reader (Environment location)
|
||||||
, Resumable (AddressError location Type)
|
|
||||||
, Resumable (EvalError Type)
|
|
||||||
, Resumable TypeError
|
, Resumable TypeError
|
||||||
, Return Type
|
, Return Type
|
||||||
, State (Environment location Type)
|
, State (Environment location)
|
||||||
, State (Heap location (Cell location) Type)
|
, State (Heap location (Cell location) Type)
|
||||||
] effects
|
] effects
|
||||||
, Ord location
|
, Ord location
|
||||||
, Reducer Type (Cell location Type)
|
, Reducer Type (Cell location Type)
|
||||||
)
|
)
|
||||||
=> AbstractValue location Type effects where
|
=> AbstractFunction location Type effects where
|
||||||
closure names _ body = do
|
closure names _ body = do
|
||||||
(env, tvars) <- foldr (\ name rest -> do
|
(env, tvars) <- foldr (\ name rest -> do
|
||||||
a <- alloc name
|
a <- alloc name
|
||||||
@ -126,6 +122,30 @@ instance ( Members '[ Allocator location Type
|
|||||||
bimap (Env.insert name a) (tvar :) <$> rest) (pure (emptyEnv, [])) names
|
bimap (Env.insert name a) (tvar :) <$> rest) (pure (emptyEnv, [])) names
|
||||||
(zeroOrMoreProduct tvars :->) <$> localEnv (mergeEnvs env) (body `catchReturn` \ (Return value) -> pure value)
|
(zeroOrMoreProduct tvars :->) <$> localEnv (mergeEnvs env) (body `catchReturn` \ (Return value) -> pure value)
|
||||||
|
|
||||||
|
call op params = do
|
||||||
|
tvar <- fresh
|
||||||
|
paramTypes <- sequenceA params
|
||||||
|
let needed = zeroOrMoreProduct paramTypes :-> Var tvar
|
||||||
|
unified <- op `unify` needed
|
||||||
|
case unified of
|
||||||
|
_ :-> ret -> pure ret
|
||||||
|
gotten -> throwResumable (UnificationError needed gotten)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Discard the value arguments (if any), constructing a 'Type' instead.
|
||||||
|
instance ( Members '[ Allocator location Type
|
||||||
|
, Fresh
|
||||||
|
, NonDet
|
||||||
|
, Reader (Environment location)
|
||||||
|
, Resumable TypeError
|
||||||
|
, Return Type
|
||||||
|
, State (Environment location)
|
||||||
|
, State (Heap location (Cell location) Type)
|
||||||
|
] effects
|
||||||
|
, Ord location
|
||||||
|
, Reducer Type (Cell location Type)
|
||||||
|
)
|
||||||
|
=> AbstractValue location Type effects where
|
||||||
unit = pure Unit
|
unit = pure Unit
|
||||||
integer _ = pure Int
|
integer _ = pure Int
|
||||||
boolean _ = pure Bool
|
boolean _ = pure Bool
|
||||||
@ -152,9 +172,6 @@ instance ( Members '[ Allocator location Type
|
|||||||
t1 <- fresh
|
t1 <- fresh
|
||||||
t2 <- fresh
|
t2 <- fresh
|
||||||
unify t (Var t1 :* Var t2) $> (Var t1, Var t2)
|
unify t (Var t1 :* Var t2) $> (Var t1, Var t2)
|
||||||
asBool t = unify t Bool *> (pure True <|> pure False)
|
|
||||||
|
|
||||||
isHole ty = pure (ty == Hole)
|
|
||||||
|
|
||||||
index arr sub = do
|
index arr sub = do
|
||||||
_ <- unify sub Int
|
_ <- unify sub Int
|
||||||
@ -181,13 +198,4 @@ instance ( Members '[ Allocator location Type
|
|||||||
(Int, Float) -> pure Int
|
(Int, Float) -> pure Int
|
||||||
_ -> unify left right $> Bool
|
_ -> unify left right $> Bool
|
||||||
|
|
||||||
call op params = do
|
|
||||||
tvar <- fresh
|
|
||||||
paramTypes <- sequenceA params
|
|
||||||
let needed = zeroOrMoreProduct paramTypes :-> Var tvar
|
|
||||||
unified <- op `unify` needed
|
|
||||||
case unified of
|
|
||||||
_ :-> ret -> pure ret
|
|
||||||
gotten -> throwResumable (UnificationError needed gotten)
|
|
||||||
|
|
||||||
loop f = f empty
|
loop f = f empty
|
||||||
|
@ -4,7 +4,7 @@ module Data.Abstract.Value where
|
|||||||
import Control.Abstract
|
import Control.Abstract
|
||||||
import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs)
|
import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs)
|
||||||
import qualified Data.Abstract.Environment as Env
|
import qualified Data.Abstract.Environment as Env
|
||||||
import Data.Abstract.FreeVariables
|
import Data.Abstract.Name
|
||||||
import qualified Data.Abstract.Number as Number
|
import qualified Data.Abstract.Number as Number
|
||||||
import Data.List (genericIndex, genericLength)
|
import Data.List (genericIndex, genericLength)
|
||||||
import Data.Scientific (Scientific)
|
import Data.Scientific (Scientific)
|
||||||
@ -57,7 +57,7 @@ prjPair = bitraverse prjValue prjValue
|
|||||||
-- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union.
|
-- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union.
|
||||||
|
|
||||||
-- | A function value consisting of a package & module info, a list of parameter 'Name's, a 'Label' to jump to the body of the function, and an 'Environment' of bindings captured by the body.
|
-- | A function value consisting of a package & module info, a list of parameter 'Name's, a 'Label' to jump to the body of the function, and an 'Environment' of bindings captured by the body.
|
||||||
data Closure location value = Closure PackageInfo ModuleInfo [Name] Label (Environment location value)
|
data Closure location value = Closure PackageInfo ModuleInfo [Name] Label (Environment location)
|
||||||
deriving (Eq, Generic1, Ord, Show)
|
deriving (Eq, Generic1, Ord, Show)
|
||||||
|
|
||||||
instance Eq location => Eq1 (Closure location) where liftEq = genericLiftEq
|
instance Eq location => Eq1 (Closure location) where liftEq = genericLiftEq
|
||||||
@ -80,7 +80,7 @@ instance Ord1 Hole where liftCompare = genericLiftCompare
|
|||||||
instance Show1 Hole where liftShowsPrec = genericLiftShowsPrec
|
instance Show1 Hole where liftShowsPrec = genericLiftShowsPrec
|
||||||
|
|
||||||
-- | Boolean values.
|
-- | Boolean values.
|
||||||
newtype Boolean value = Boolean Prelude.Bool
|
newtype Boolean value = Boolean { getBoolean :: Bool }
|
||||||
deriving (Eq, Generic1, Ord, Show)
|
deriving (Eq, Generic1, Ord, Show)
|
||||||
|
|
||||||
instance Eq1 Boolean where liftEq = genericLiftEq
|
instance Eq1 Boolean where liftEq = genericLiftEq
|
||||||
@ -151,7 +151,7 @@ instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
|
|||||||
-- but for the time being we're pretending all languages have prototypical inheritance.
|
-- but for the time being we're pretending all languages have prototypical inheritance.
|
||||||
data Class location value = Class
|
data Class location value = Class
|
||||||
{ _className :: Name
|
{ _className :: Name
|
||||||
, _classScope :: Environment location value
|
, _classScope :: Environment location
|
||||||
} deriving (Eq, Generic1, Ord, Show)
|
} deriving (Eq, Generic1, Ord, Show)
|
||||||
|
|
||||||
instance Eq location => Eq1 (Class location) where liftEq = genericLiftEq
|
instance Eq location => Eq1 (Class location) where liftEq = genericLiftEq
|
||||||
@ -160,7 +160,7 @@ instance Show location => Show1 (Class location) where liftShowsPrec = genericLi
|
|||||||
|
|
||||||
data Namespace location value = Namespace
|
data Namespace location value = Namespace
|
||||||
{ namespaceName :: Name
|
{ namespaceName :: Name
|
||||||
, namespaceScope :: Environment location value
|
, namespaceScope :: Environment location
|
||||||
} deriving (Eq, Generic1, Ord, Show)
|
} deriving (Eq, Generic1, Ord, Show)
|
||||||
|
|
||||||
instance Eq location => Eq1 (Namespace location) where liftEq = genericLiftEq
|
instance Eq location => Eq1 (Namespace location) where liftEq = genericLiftEq
|
||||||
@ -204,16 +204,51 @@ instance Ord location => ValueRoots location (Value location) where
|
|||||||
instance AbstractHole (Value location) where
|
instance AbstractHole (Value location) where
|
||||||
hole = injValue Hole
|
hole = injValue Hole
|
||||||
|
|
||||||
-- | Construct a 'Value' wrapping the value arguments (if any).
|
|
||||||
instance ( Members '[ Allocator location (Value location)
|
instance ( Members '[ Allocator location (Value location)
|
||||||
, Fail
|
, Reader (Environment location)
|
||||||
, LoopControl (Value location)
|
|
||||||
, Reader (Environment location (Value location))
|
|
||||||
, Reader ModuleInfo
|
, Reader ModuleInfo
|
||||||
, Reader PackageInfo
|
, Reader PackageInfo
|
||||||
, Resumable (ValueError location)
|
, Resumable (ValueError location)
|
||||||
, Return (Value location)
|
, Return (Value location)
|
||||||
, State (Environment location (Value location))
|
, State (Environment location)
|
||||||
|
, State (Heap location (Cell location) (Value location))
|
||||||
|
] effects
|
||||||
|
, Ord location
|
||||||
|
, Reducer (Value location) (Cell location (Value location))
|
||||||
|
, Show location
|
||||||
|
)
|
||||||
|
=> AbstractFunction location (Value location) (Goto effects (Value location) ': effects) where
|
||||||
|
closure parameters freeVariables body = do
|
||||||
|
packageInfo <- currentPackage
|
||||||
|
moduleInfo <- currentModule
|
||||||
|
l <- label body
|
||||||
|
injValue . Closure packageInfo moduleInfo parameters l . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv
|
||||||
|
|
||||||
|
call op params = do
|
||||||
|
case prjValue op of
|
||||||
|
Just (Closure packageInfo moduleInfo names label env) -> do
|
||||||
|
body <- goto label
|
||||||
|
-- Evaluate the bindings and body with the closure’s package/module info in scope in order to
|
||||||
|
-- charge them to the closure's origin.
|
||||||
|
withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do
|
||||||
|
bindings <- foldr (\ (name, param) rest -> do
|
||||||
|
v <- param
|
||||||
|
a <- alloc name
|
||||||
|
assign a v
|
||||||
|
Env.insert name a <$> rest) (pure env) (zip names params)
|
||||||
|
localEnv (mergeEnvs bindings) (body `catchReturn` \ (Return value) -> pure value)
|
||||||
|
Nothing -> throwValueError (CallError op)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Construct a 'Value' wrapping the value arguments (if any).
|
||||||
|
instance ( Members '[ Allocator location (Value location)
|
||||||
|
, LoopControl (Value location)
|
||||||
|
, Reader (Environment location)
|
||||||
|
, Reader ModuleInfo
|
||||||
|
, Reader PackageInfo
|
||||||
|
, Resumable (ValueError location)
|
||||||
|
, Return (Value location)
|
||||||
|
, State (Environment location)
|
||||||
, State (Heap location (Cell location) (Value location))
|
, State (Heap location (Cell location) (Value location))
|
||||||
] effects
|
] effects
|
||||||
, Ord location
|
, Ord location
|
||||||
@ -265,18 +300,8 @@ instance ( Members '[ Allocator location (Value location)
|
|||||||
| otherwise = throwValueError $ StringError v
|
| otherwise = throwValueError $ StringError v
|
||||||
|
|
||||||
ifthenelse cond if' else' = do
|
ifthenelse cond if' else' = do
|
||||||
isHole <- isHole cond
|
bool <- maybe (throwValueError (BoolError cond)) (pure . getBoolean) (prjValue cond)
|
||||||
if isHole then
|
if bool then if' else else'
|
||||||
pure hole
|
|
||||||
else do
|
|
||||||
bool <- asBool cond
|
|
||||||
if bool then if' else else'
|
|
||||||
|
|
||||||
asBool val
|
|
||||||
| Just (Boolean b) <- prjValue val = pure b
|
|
||||||
| otherwise = throwValueError $ BoolError val
|
|
||||||
|
|
||||||
isHole val = pure (prjValue val == Just Hole)
|
|
||||||
|
|
||||||
index = go where
|
index = go where
|
||||||
tryIdx list ii
|
tryIdx list ii
|
||||||
@ -348,27 +373,6 @@ instance ( Members '[ Allocator location (Value location)
|
|||||||
| otherwise = throwValueError (Bitwise2Error left right)
|
| otherwise = throwValueError (Bitwise2Error left right)
|
||||||
where pair = (left, right)
|
where pair = (left, right)
|
||||||
|
|
||||||
closure parameters freeVariables body = do
|
|
||||||
packageInfo <- currentPackage
|
|
||||||
moduleInfo <- currentModule
|
|
||||||
l <- label body
|
|
||||||
injValue . Closure packageInfo moduleInfo parameters l . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv
|
|
||||||
|
|
||||||
call op params = do
|
|
||||||
case prjValue op of
|
|
||||||
Just (Closure packageInfo moduleInfo names label env) -> do
|
|
||||||
body <- goto label
|
|
||||||
-- Evaluate the bindings and body with the closure’s package/module info in scope in order to
|
|
||||||
-- charge them to the closure's origin.
|
|
||||||
withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do
|
|
||||||
bindings <- foldr (\ (name, param) rest -> do
|
|
||||||
v <- param
|
|
||||||
a <- alloc name
|
|
||||||
assign a v
|
|
||||||
Env.insert name a <$> rest) (pure env) (zip names params)
|
|
||||||
localEnv (mergeEnvs bindings) (body `catchReturn` \ (Return value) -> pure value)
|
|
||||||
Nothing -> throwValueError (CallError op)
|
|
||||||
|
|
||||||
loop x = catchLoopControl (fix x) (\ control -> case control of
|
loop x = catchLoopControl (fix x) (\ control -> case control of
|
||||||
Break value -> pure value
|
Break value -> pure value
|
||||||
-- FIXME: Figure out how to deal with this. Ruby treats this as the result of the current block iteration, while PHP specifies a breakout level and TypeScript appears to take a label.
|
-- FIXME: Figure out how to deal with this. Ruby treats this as the result of the current block iteration, while PHP specifies a breakout level and TypeScript appears to take a label.
|
||||||
@ -380,7 +384,7 @@ data ValueError location resume where
|
|||||||
StringError :: Value location -> ValueError location ByteString
|
StringError :: Value location -> ValueError location ByteString
|
||||||
BoolError :: Value location -> ValueError location Bool
|
BoolError :: Value location -> ValueError location Bool
|
||||||
IndexError :: Value location -> Value location -> ValueError location (Value location)
|
IndexError :: Value location -> Value location -> ValueError location (Value location)
|
||||||
NamespaceError :: Prelude.String -> ValueError location (Environment location (Value location))
|
NamespaceError :: Prelude.String -> ValueError location (Environment location)
|
||||||
CallError :: Value location -> ValueError location (Value location)
|
CallError :: Value location -> ValueError location (Value location)
|
||||||
NumericError :: Value location -> ValueError location (Value location)
|
NumericError :: Value location -> ValueError location (Value location)
|
||||||
Numeric2Error :: Value location -> Value location -> ValueError location (Value location)
|
Numeric2Error :: Value location -> Value location -> ValueError location (Value location)
|
||||||
|
@ -1,7 +1,6 @@
|
|||||||
{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, ViewPatterns #-}
|
{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, ViewPatterns #-}
|
||||||
module Data.Syntax.Statement where
|
module Data.Syntax.Statement where
|
||||||
|
|
||||||
import Control.Abstract.Evaluator (ValueRef(..))
|
|
||||||
import qualified Data.Abstract.Environment as Env
|
import qualified Data.Abstract.Environment as Env
|
||||||
import Data.Abstract.Evaluatable
|
import Data.Abstract.Evaluatable
|
||||||
import Data.ByteString.Char8 (unpack)
|
import Data.ByteString.Char8 (unpack)
|
||||||
|
@ -7,7 +7,7 @@ module Language.Go.Assignment
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Assigning.Assignment hiding (Assignment, Error)
|
import Assigning.Assignment hiding (Assignment, Error)
|
||||||
import Data.Abstract.FreeVariables (name)
|
import Data.Abstract.Name (name)
|
||||||
import Data.Record
|
import Data.Record
|
||||||
import Data.Syntax (contextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
|
import Data.Syntax (contextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
|
||||||
import Language.Go.Grammar as Grammar
|
import Language.Go.Grammar as Grammar
|
||||||
|
@ -1,8 +1,7 @@
|
|||||||
{-# LANGUAGE DeriveAnyClass #-}
|
{-# LANGUAGE DeriveAnyClass #-}
|
||||||
module Language.Go.Syntax where
|
module Language.Go.Syntax where
|
||||||
|
|
||||||
import Data.Abstract.Evaluatable hiding (Label)
|
import Data.Abstract.Evaluatable
|
||||||
import Data.Abstract.FreeVariables (Name (..), name)
|
|
||||||
import Data.Abstract.Module
|
import Data.Abstract.Module
|
||||||
import qualified Data.Abstract.Package as Package
|
import qualified Data.Abstract.Package as Package
|
||||||
import Data.Abstract.Path
|
import Data.Abstract.Path
|
||||||
|
@ -9,18 +9,23 @@ module Language.Haskell.Assignment
|
|||||||
import Assigning.Assignment hiding (Assignment, Error)
|
import Assigning.Assignment hiding (Assignment, Error)
|
||||||
import Data.Record
|
import Data.Record
|
||||||
import Data.Sum
|
import Data.Sum
|
||||||
import Data.Syntax (emptyTerm, handleError, parseError, makeTerm, contextualize, postContextualize)
|
import Data.Syntax (emptyTerm, handleError, parseError, makeTerm, makeTerm'', contextualize, postContextualize)
|
||||||
import Language.Haskell.Grammar as Grammar
|
import Language.Haskell.Grammar as Grammar
|
||||||
import qualified Assigning.Assignment as Assignment
|
import qualified Assigning.Assignment as Assignment
|
||||||
import qualified Data.Abstract.FreeVariables as FV
|
import qualified Data.Abstract.Name as Name
|
||||||
import qualified Data.Syntax as Syntax
|
import qualified Data.Syntax as Syntax
|
||||||
import qualified Data.Syntax.Comment as Comment
|
import qualified Data.Syntax.Comment as Comment
|
||||||
|
import qualified Data.Syntax.Declaration as Declaration
|
||||||
|
import qualified Data.Syntax.Literal as Literal
|
||||||
import qualified Data.Term as Term
|
import qualified Data.Term as Term
|
||||||
import qualified Language.Haskell.Syntax as Syntax
|
import qualified Language.Haskell.Syntax as Syntax
|
||||||
import Prologue
|
import Prologue
|
||||||
|
|
||||||
type Syntax = '[
|
type Syntax = '[
|
||||||
Comment.Comment
|
Comment.Comment
|
||||||
|
, Declaration.Function
|
||||||
|
, Literal.Float
|
||||||
|
, Literal.Integer
|
||||||
, Syntax.Context
|
, Syntax.Context
|
||||||
, Syntax.Empty
|
, Syntax.Empty
|
||||||
, Syntax.Error
|
, Syntax.Error
|
||||||
@ -37,16 +42,26 @@ assignment :: Assignment
|
|||||||
assignment = handleError $ module' <|> parseError
|
assignment = handleError $ module' <|> parseError
|
||||||
|
|
||||||
module' :: Assignment
|
module' :: Assignment
|
||||||
module' = makeTerm <$> symbol Module <*> children (Syntax.Module <$> moduleIdentifier <*> pure [] <*> (where' <|> emptyTerm))
|
module' = makeTerm
|
||||||
|
<$> symbol Module
|
||||||
|
<*> children (Syntax.Module <$> (moduleIdentifier <|> emptyTerm) <*> pure [] <*> (where' <|> expressions <|> emptyTerm))
|
||||||
|
|
||||||
|
|
||||||
|
expressions :: Assignment
|
||||||
|
expressions = makeTerm'' <$> location <*> many expression
|
||||||
|
|
||||||
expression :: Assignment
|
expression :: Assignment
|
||||||
expression = term (handleError (choice expressionChoices))
|
expression = term (handleError (choice expressionChoices))
|
||||||
|
|
||||||
expressionChoices :: [Assignment.Assignment [] Grammar Term]
|
expressionChoices :: [Assignment.Assignment [] Grammar Term]
|
||||||
expressionChoices = [
|
expressionChoices = [
|
||||||
constructorIdentifier
|
comment
|
||||||
|
, constructorIdentifier
|
||||||
|
, float
|
||||||
|
, functionDeclaration
|
||||||
|
, integer
|
||||||
, moduleIdentifier
|
, moduleIdentifier
|
||||||
, comment
|
, variableIdentifier
|
||||||
, where'
|
, where'
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -56,11 +71,36 @@ term term = contextualize comment (postContextualize comment term)
|
|||||||
comment :: Assignment
|
comment :: Assignment
|
||||||
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
|
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
|
||||||
|
|
||||||
|
variableIdentifier :: Assignment
|
||||||
|
variableIdentifier = makeTerm <$> symbol VariableIdentifier <*> (Syntax.Identifier . Name.name <$> source)
|
||||||
|
|
||||||
constructorIdentifier :: Assignment
|
constructorIdentifier :: Assignment
|
||||||
constructorIdentifier = makeTerm <$> symbol ConstructorIdentifier <*> (Syntax.Identifier . FV.name <$> source)
|
constructorIdentifier = makeTerm <$> symbol ConstructorIdentifier <*> (Syntax.Identifier . Name.name <$> source)
|
||||||
|
|
||||||
moduleIdentifier :: Assignment
|
moduleIdentifier :: Assignment
|
||||||
moduleIdentifier = makeTerm <$> symbol ModuleIdentifier <*> (Syntax.Identifier . FV.name <$> source)
|
moduleIdentifier = makeTerm <$> symbol ModuleIdentifier <*> (Syntax.Identifier . Name.name <$> source)
|
||||||
|
|
||||||
where' :: Assignment
|
where' :: Assignment
|
||||||
where' = makeTerm <$> (symbol Where <|> symbol Where') <*> children (many expression)
|
where' = makeTerm <$> (symbol Where <|> symbol Where') <*> children (many expression)
|
||||||
|
|
||||||
|
functionBody :: Assignment
|
||||||
|
functionBody = makeTerm <$> symbol FunctionBody <*> children (many expression)
|
||||||
|
|
||||||
|
functionDeclaration :: Assignment
|
||||||
|
functionDeclaration = makeTerm
|
||||||
|
<$> symbol FunctionDeclaration
|
||||||
|
<*> children (Declaration.Function
|
||||||
|
<$> pure []
|
||||||
|
<*> variableIdentifier
|
||||||
|
<*> (manyTermsTill expression (symbol FunctionBody) <|> pure [])
|
||||||
|
<*> functionBody)
|
||||||
|
|
||||||
|
integer :: Assignment
|
||||||
|
integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
|
||||||
|
|
||||||
|
float :: Assignment
|
||||||
|
float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
|
||||||
|
|
||||||
|
-- | Match a series of terms or comments until a delimiter is matched.
|
||||||
|
manyTermsTill :: Assignment.Assignment [] Grammar Term -> Assignment.Assignment [] Grammar b -> Assignment.Assignment [] Grammar [Term]
|
||||||
|
manyTermsTill step = manyTill (step <|> comment)
|
||||||
|
@ -12,7 +12,7 @@ import Data.Sum
|
|||||||
import Data.Syntax (emptyTerm, handleError, parseError, infixContext, makeTerm, makeTerm', makeTerm1, contextualize, postContextualize)
|
import Data.Syntax (emptyTerm, handleError, parseError, infixContext, makeTerm, makeTerm', makeTerm1, contextualize, postContextualize)
|
||||||
import Language.PHP.Grammar as Grammar
|
import Language.PHP.Grammar as Grammar
|
||||||
import qualified Assigning.Assignment as Assignment
|
import qualified Assigning.Assignment as Assignment
|
||||||
import qualified Data.Abstract.FreeVariables as FV
|
import qualified Data.Abstract.Name as Name
|
||||||
import qualified Data.List.NonEmpty as NonEmpty
|
import qualified Data.List.NonEmpty as NonEmpty
|
||||||
import qualified Data.Syntax as Syntax
|
import qualified Data.Syntax as Syntax
|
||||||
import qualified Data.Syntax.Comment as Comment
|
import qualified Data.Syntax.Comment as Comment
|
||||||
@ -445,7 +445,7 @@ classConstDeclaration :: Assignment
|
|||||||
classConstDeclaration = makeTerm <$> symbol ClassConstDeclaration <*> children (Syntax.ClassConstDeclaration <$> (term visibilityModifier <|> emptyTerm) <*> manyTerm constElement)
|
classConstDeclaration = makeTerm <$> symbol ClassConstDeclaration <*> children (Syntax.ClassConstDeclaration <$> (term visibilityModifier <|> emptyTerm) <*> manyTerm constElement)
|
||||||
|
|
||||||
visibilityModifier :: Assignment
|
visibilityModifier :: Assignment
|
||||||
visibilityModifier = makeTerm <$> symbol VisibilityModifier <*> (Syntax.Identifier . FV.name <$> source)
|
visibilityModifier = makeTerm <$> symbol VisibilityModifier <*> (Syntax.Identifier . Name.name <$> source)
|
||||||
|
|
||||||
constElement :: Assignment
|
constElement :: Assignment
|
||||||
constElement = makeTerm <$> symbol ConstElement <*> children (Statement.Assignment [] <$> term name <*> term expression)
|
constElement = makeTerm <$> symbol ConstElement <*> children (Statement.Assignment [] <$> term name <*> term expression)
|
||||||
@ -651,7 +651,7 @@ propertyDeclaration :: Assignment
|
|||||||
propertyDeclaration = makeTerm <$> symbol PropertyDeclaration <*> children (Syntax.PropertyDeclaration <$> term propertyModifier <*> someTerm propertyElement)
|
propertyDeclaration = makeTerm <$> symbol PropertyDeclaration <*> children (Syntax.PropertyDeclaration <$> term propertyModifier <*> someTerm propertyElement)
|
||||||
|
|
||||||
propertyModifier :: Assignment
|
propertyModifier :: Assignment
|
||||||
propertyModifier = (makeTerm <$> symbol PropertyModifier <*> children (Syntax.PropertyModifier <$> (term visibilityModifier <|> emptyTerm) <*> (term staticModifier <|> emptyTerm))) <|> term (makeTerm <$> symbol PropertyModifier <*> (Syntax.Identifier . FV.name <$> source))
|
propertyModifier = (makeTerm <$> symbol PropertyModifier <*> children (Syntax.PropertyModifier <$> (term visibilityModifier <|> emptyTerm) <*> (term staticModifier <|> emptyTerm))) <|> term (makeTerm <$> symbol PropertyModifier <*> (Syntax.Identifier . Name.name <$> source))
|
||||||
|
|
||||||
propertyElement :: Assignment
|
propertyElement :: Assignment
|
||||||
propertyElement = makeTerm <$> symbol PropertyElement <*> children (Statement.Assignment [] <$> term variableName <*> term propertyInitializer) <|> (symbol PropertyElement *> children (term variableName))
|
propertyElement = makeTerm <$> symbol PropertyElement <*> children (Statement.Assignment [] <$> term variableName <*> term propertyInitializer) <|> (symbol PropertyElement *> children (term variableName))
|
||||||
@ -712,7 +712,7 @@ namespaceAliasingClause = makeTerm <$> symbol NamespaceAliasingClause <*> childr
|
|||||||
|
|
||||||
-- | TODO Do something better than Identifier
|
-- | TODO Do something better than Identifier
|
||||||
namespaceFunctionOrConst :: Assignment
|
namespaceFunctionOrConst :: Assignment
|
||||||
namespaceFunctionOrConst = makeTerm <$> symbol NamespaceFunctionOrConst <*> (Syntax.Identifier . FV.name <$> source)
|
namespaceFunctionOrConst = makeTerm <$> symbol NamespaceFunctionOrConst <*> (Syntax.Identifier . Name.name <$> source)
|
||||||
|
|
||||||
globalDeclaration :: Assignment
|
globalDeclaration :: Assignment
|
||||||
globalDeclaration = makeTerm <$> symbol GlobalDeclaration <*> children (Syntax.GlobalDeclaration <$> manyTerm simpleVariable')
|
globalDeclaration = makeTerm <$> symbol GlobalDeclaration <*> children (Syntax.GlobalDeclaration <$> manyTerm simpleVariable')
|
||||||
@ -748,7 +748,7 @@ variableName :: Assignment
|
|||||||
variableName = makeTerm <$> symbol VariableName <*> children (Syntax.VariableName <$> term name)
|
variableName = makeTerm <$> symbol VariableName <*> children (Syntax.VariableName <$> term name)
|
||||||
|
|
||||||
name :: Assignment
|
name :: Assignment
|
||||||
name = makeTerm <$> (symbol Name <|> symbol Name') <*> (Syntax.Identifier . FV.name <$> source)
|
name = makeTerm <$> (symbol Name <|> symbol Name') <*> (Syntax.Identifier . Name.name <$> source)
|
||||||
|
|
||||||
functionStaticDeclaration :: Assignment
|
functionStaticDeclaration :: Assignment
|
||||||
functionStaticDeclaration = makeTerm <$> symbol FunctionStaticDeclaration <*> children (Declaration.VariableDeclaration <$> manyTerm staticVariableDeclaration)
|
functionStaticDeclaration = makeTerm <$> symbol FunctionStaticDeclaration <*> children (Declaration.VariableDeclaration <$> manyTerm staticVariableDeclaration)
|
||||||
|
@ -55,18 +55,17 @@ resolvePHPName n = do
|
|||||||
include :: ( AbstractValue location value effects
|
include :: ( AbstractValue location value effects
|
||||||
, Members '[ Allocator location value
|
, Members '[ Allocator location value
|
||||||
, Modules location value
|
, Modules location value
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, Resumable ResolutionError
|
, Resumable ResolutionError
|
||||||
, Resumable (EnvironmentError value)
|
, Resumable (EnvironmentError value)
|
||||||
, Resumable (EvalError value)
|
, State (Environment location)
|
||||||
, State (Environment location value)
|
, State (Exports location)
|
||||||
, State (Exports location value)
|
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
, Trace
|
, Trace
|
||||||
] effects
|
] effects
|
||||||
)
|
)
|
||||||
=> Subterm term (Evaluator location value effects (ValueRef value))
|
=> Subterm term (Evaluator location value effects (ValueRef value))
|
||||||
-> (ModulePath -> Evaluator location value effects (Maybe (Environment location value, value)))
|
-> (ModulePath -> Evaluator location value effects (Maybe (Environment location, value)))
|
||||||
-> Evaluator location value effects (ValueRef value)
|
-> Evaluator location value effects (ValueRef value)
|
||||||
include pathTerm f = do
|
include pathTerm f = do
|
||||||
name <- subtermValue pathTerm >>= asString
|
name <- subtermValue pathTerm >>= asString
|
||||||
|
@ -8,7 +8,7 @@ module Language.Python.Assignment
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Assigning.Assignment hiding (Assignment, Error)
|
import Assigning.Assignment hiding (Assignment, Error)
|
||||||
import Data.Abstract.FreeVariables (name)
|
import Data.Abstract.Name (name)
|
||||||
import Data.Record
|
import Data.Record
|
||||||
import Data.Syntax (contextualize, emptyTerm, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1, parseError, postContextualize)
|
import Data.Syntax (contextualize, emptyTerm, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1, parseError, postContextualize)
|
||||||
import GHC.Stack
|
import GHC.Stack
|
||||||
|
@ -3,7 +3,6 @@ module Language.Python.Syntax where
|
|||||||
|
|
||||||
import Data.Abstract.Environment as Env
|
import Data.Abstract.Environment as Env
|
||||||
import Data.Abstract.Evaluatable
|
import Data.Abstract.Evaluatable
|
||||||
import qualified Data.Abstract.FreeVariables as FV
|
|
||||||
import Data.Abstract.Module
|
import Data.Abstract.Module
|
||||||
import Data.Align.Generic
|
import Data.Align.Generic
|
||||||
import qualified Data.ByteString.Char8 as BC
|
import qualified Data.ByteString.Char8 as BC
|
||||||
@ -131,9 +130,9 @@ instance Evaluatable Import where
|
|||||||
evalQualifiedImport :: ( AbstractValue location value effects
|
evalQualifiedImport :: ( AbstractValue location value effects
|
||||||
, Members '[ Allocator location value
|
, Members '[ Allocator location value
|
||||||
, Modules location value
|
, Modules location value
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Exports location value)
|
, State (Exports location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
] effects
|
] effects
|
||||||
, Ord location
|
, Ord location
|
||||||
@ -158,9 +157,9 @@ instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
|
|||||||
-- import a.b.c
|
-- import a.b.c
|
||||||
instance Evaluatable QualifiedImport where
|
instance Evaluatable QualifiedImport where
|
||||||
eval (QualifiedImport (RelativeQualifiedName _ _)) = raiseEff (fail "technically this is not allowed in python")
|
eval (QualifiedImport (RelativeQualifiedName _ _)) = raiseEff (fail "technically this is not allowed in python")
|
||||||
eval (QualifiedImport name@(QualifiedName qualifiedName)) = do
|
eval (QualifiedImport qname@(QualifiedName qualifiedName)) = do
|
||||||
modulePaths <- resolvePythonModules name
|
modulePaths <- resolvePythonModules qname
|
||||||
Rval <$> go (NonEmpty.zip (FV.name . BC.pack <$> qualifiedName) modulePaths)
|
Rval <$> go (NonEmpty.zip (name . BC.pack <$> qualifiedName) modulePaths)
|
||||||
where
|
where
|
||||||
-- Evaluate and import the last module, updating the environment
|
-- Evaluate and import the last module, updating the environment
|
||||||
go ((name, path) :| []) = evalQualifiedImport name path
|
go ((name, path) :| []) = evalQualifiedImport name path
|
||||||
|
@ -7,11 +7,11 @@ module Language.Ruby.Assignment
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Assigning.Assignment hiding (Assignment, Error)
|
import Assigning.Assignment hiding (Assignment, Error)
|
||||||
|
import Data.Abstract.Name (name)
|
||||||
import Data.List (elem)
|
import Data.List (elem)
|
||||||
import Data.Record
|
import Data.Record
|
||||||
import Data.Syntax (contextualize, postContextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
|
import Data.Syntax (contextualize, postContextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
|
||||||
import Language.Ruby.Grammar as Grammar
|
import Language.Ruby.Grammar as Grammar
|
||||||
import Data.Abstract.FreeVariables (name)
|
|
||||||
import qualified Assigning.Assignment as Assignment
|
import qualified Assigning.Assignment as Assignment
|
||||||
import Data.Sum
|
import Data.Sum
|
||||||
import qualified Data.Syntax as Syntax
|
import qualified Data.Syntax as Syntax
|
||||||
|
@ -81,7 +81,7 @@ doRequire :: ( AbstractValue location value effects
|
|||||||
, Member (Modules location value) effects
|
, Member (Modules location value) effects
|
||||||
)
|
)
|
||||||
=> M.ModulePath
|
=> M.ModulePath
|
||||||
-> Evaluator location value effects (Environment location value, value)
|
-> Evaluator location value effects (Environment location, value)
|
||||||
doRequire path = do
|
doRequire path = do
|
||||||
result <- join <$> lookupModule path
|
result <- join <$> lookupModule path
|
||||||
case result of
|
case result of
|
||||||
@ -111,8 +111,8 @@ instance Evaluatable Load where
|
|||||||
doLoad :: ( AbstractValue location value effects
|
doLoad :: ( AbstractValue location value effects
|
||||||
, Members '[ Modules location value
|
, Members '[ Modules location value
|
||||||
, Resumable ResolutionError
|
, Resumable ResolutionError
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Exports location value)
|
, State (Exports location)
|
||||||
, Trace
|
, Trace
|
||||||
] effects
|
] effects
|
||||||
)
|
)
|
||||||
|
@ -7,7 +7,7 @@ module Language.TypeScript.Assignment
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Assigning.Assignment hiding (Assignment, Error)
|
import Assigning.Assignment hiding (Assignment, Error)
|
||||||
import Data.Abstract.FreeVariables (name)
|
import Data.Abstract.Name (name)
|
||||||
import qualified Assigning.Assignment as Assignment
|
import qualified Assigning.Assignment as Assignment
|
||||||
import Data.Record
|
import Data.Record
|
||||||
import Data.Sum
|
import Data.Sum
|
||||||
|
@ -3,7 +3,6 @@ module Language.TypeScript.Syntax where
|
|||||||
|
|
||||||
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.FreeVariables as FV
|
|
||||||
import qualified Data.Abstract.Module as M
|
import qualified Data.Abstract.Module as M
|
||||||
import Data.Abstract.Package
|
import Data.Abstract.Package
|
||||||
import Data.Abstract.Path
|
import Data.Abstract.Path
|
||||||
@ -32,7 +31,7 @@ importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (path
|
|||||||
| otherwise = NonRelative
|
| otherwise = NonRelative
|
||||||
|
|
||||||
toName :: ImportPath -> Name
|
toName :: ImportPath -> Name
|
||||||
toName = FV.name . BC.pack . unPath
|
toName = name . BC.pack . unPath
|
||||||
|
|
||||||
-- Node.js resolution algorithm: https://nodejs.org/api/modules.html#modules_all_together
|
-- Node.js resolution algorithm: https://nodejs.org/api/modules.html#modules_all_together
|
||||||
--
|
--
|
||||||
@ -136,9 +135,9 @@ javascriptExtensions = ["js"]
|
|||||||
evalRequire :: ( AbstractValue location value effects
|
evalRequire :: ( AbstractValue location value effects
|
||||||
, Members '[ Allocator location value
|
, Members '[ Allocator location value
|
||||||
, Modules location value
|
, Modules location value
|
||||||
, Reader (Environment location value)
|
, Reader (Environment location)
|
||||||
, State (Environment location value)
|
, State (Environment location)
|
||||||
, State (Exports location value)
|
, State (Exports location)
|
||||||
, State (Heap location (Cell location) value)
|
, State (Heap location (Cell location) value)
|
||||||
, Trace
|
, Trace
|
||||||
] effects
|
] effects
|
||||||
|
@ -112,9 +112,8 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr
|
|||||||
resumingLoadError :: Member Trace effects => Evaluator location value (Resumable (LoadError location value) ': effects) a -> Evaluator location value effects a
|
resumingLoadError :: Member Trace effects => Evaluator location value (Resumable (LoadError location value) ': effects) a -> Evaluator location value effects a
|
||||||
resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> Nothing)
|
resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> Nothing)
|
||||||
|
|
||||||
resumingEvalError :: (AbstractHole value, Member Trace effects, Show value) => Evaluator location value (Resumable (EvalError value) ': effects) a -> Evaluator location value effects a
|
resumingEvalError :: Member Trace effects => Evaluator location value (Resumable EvalError ': effects) a -> Evaluator location value effects a
|
||||||
resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) *> case err of
|
resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) *> case err of
|
||||||
EnvironmentLookupError{} -> pure hole
|
|
||||||
DefaultExportError{} -> pure ()
|
DefaultExportError{} -> pure ()
|
||||||
ExportError{} -> pure ()
|
ExportError{} -> pure ()
|
||||||
IntegerFormatError{} -> pure 0
|
IntegerFormatError{} -> pure 0
|
||||||
@ -130,7 +129,7 @@ resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> s
|
|||||||
UnallocatedAddress _ -> pure lowerBound
|
UnallocatedAddress _ -> pure lowerBound
|
||||||
UninitializedAddress _ -> pure hole)
|
UninitializedAddress _ -> pure hole)
|
||||||
|
|
||||||
resumingValueError :: (Members '[State (Environment location (Value location)), Trace] effects, Show location) => Evaluator location (Value location) (Resumable (ValueError location) ': effects) a -> Evaluator location (Value location) effects a
|
resumingValueError :: (Members '[State (Environment location), Trace] effects, Show location) => Evaluator location (Value location) (Resumable (ValueError location) ': effects) a -> Evaluator location (Value location) effects a
|
||||||
resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of
|
resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of
|
||||||
CallError val -> pure val
|
CallError val -> pure val
|
||||||
StringError val -> pure (pack (show val))
|
StringError val -> pure (pack (show val))
|
||||||
|
@ -4,9 +4,8 @@ module Semantic.Util where
|
|||||||
|
|
||||||
import Analysis.Abstract.Caching
|
import Analysis.Abstract.Caching
|
||||||
import Analysis.Abstract.Collecting
|
import Analysis.Abstract.Collecting
|
||||||
import Analysis.Abstract.Evaluating as X
|
import Analysis.Abstract.Evaluating
|
||||||
import Control.Abstract.Evaluator
|
import Control.Abstract
|
||||||
import Control.Abstract.TermEvaluator
|
|
||||||
import Control.Monad.Effect.Trace (runPrintingTrace)
|
import Control.Monad.Effect.Trace (runPrintingTrace)
|
||||||
import Data.Abstract.Address
|
import Data.Abstract.Address
|
||||||
import Data.Abstract.Evaluatable
|
import Data.Abstract.Evaluatable
|
||||||
|
@ -32,7 +32,7 @@ spec = parallel $ do
|
|||||||
|
|
||||||
it "fails exporting symbols not defined in the module" $ do
|
it "fails exporting symbols not defined in the module" $ do
|
||||||
((res, _), _) <- evaluate "bad-export.ts"
|
((res, _), _) <- evaluate "bad-export.ts"
|
||||||
res `shouldBe` Left (SomeExc (inject @(EvalError (Value Precise)) (ExportError "foo.ts" (Name "pip"))))
|
res `shouldBe` Left (SomeExc (inject @EvalError (ExportError "foo.ts" (name "pip"))))
|
||||||
|
|
||||||
it "evaluates early return statements" $ do
|
it "evaluates early return statements" $ do
|
||||||
((res, _), _) <- evaluate "early-return.ts"
|
((res, _), _) <- evaluate "early-return.ts"
|
||||||
|
@ -47,7 +47,7 @@ import qualified Data.Syntax as Syntax
|
|||||||
import qualified Data.Syntax.Comment as Comment
|
import qualified Data.Syntax.Comment as Comment
|
||||||
import qualified Data.Syntax.Declaration as Declaration
|
import qualified Data.Syntax.Declaration as Declaration
|
||||||
import qualified Data.Syntax.Statement as Statement
|
import qualified Data.Syntax.Statement as Statement
|
||||||
import qualified Data.Abstract.FreeVariables as FV
|
import qualified Data.Abstract.Name as Name
|
||||||
import Data.Term
|
import Data.Term
|
||||||
import Data.Text as T (Text, pack)
|
import Data.Text as T (Text, pack)
|
||||||
import qualified Data.Text.Encoding as T
|
import qualified Data.Text.Encoding as T
|
||||||
@ -257,8 +257,8 @@ type ListableSyntax = Sum
|
|||||||
, []
|
, []
|
||||||
]
|
]
|
||||||
|
|
||||||
instance Listable FV.Name where
|
instance Listable Name.Name where
|
||||||
tiers = cons1 FV.name
|
tiers = cons1 Name.name
|
||||||
|
|
||||||
instance Listable1 Gram where
|
instance Listable1 Gram where
|
||||||
liftTiers tiers = liftCons2 (liftTiers (liftTiers tiers)) (liftTiers (liftTiers tiers)) Gram
|
liftTiers tiers = liftCons2 (liftTiers (liftTiers tiers)) (liftTiers (liftTiers tiers)) Gram
|
||||||
|
@ -5,7 +5,12 @@ module Main
|
|||||||
import System.Environment
|
import System.Environment
|
||||||
import Test.DocTest
|
import Test.DocTest
|
||||||
|
|
||||||
defaultFiles = ["src/Data/Abstract/Environment.hs", "src/Data/Range.hs", "src/Data/Semigroup/App.hs"]
|
defaultFiles =
|
||||||
|
[ "src/Data/Abstract/Environment.hs"
|
||||||
|
, "src/Data/Abstract/Name.hs"
|
||||||
|
, "src/Data/Range.hs"
|
||||||
|
, "src/Data/Semigroup/App.hs"
|
||||||
|
]
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
@ -20,9 +20,10 @@ import Control.Monad ((>=>))
|
|||||||
import Data.Abstract.Address as X
|
import Data.Abstract.Address as X
|
||||||
import Data.Abstract.Environment as Env
|
import Data.Abstract.Environment as Env
|
||||||
import Data.Abstract.Evaluatable
|
import Data.Abstract.Evaluatable
|
||||||
import Data.Abstract.FreeVariables as X hiding (dropExtension)
|
import Data.Abstract.FreeVariables as X
|
||||||
import Data.Abstract.Heap as X
|
import Data.Abstract.Heap as X
|
||||||
import Data.Abstract.ModuleTable as X hiding (lookup)
|
import Data.Abstract.ModuleTable as X hiding (lookup)
|
||||||
|
import Data.Abstract.Name as X
|
||||||
import Data.Abstract.Value (Namespace(..), Value, ValueError, injValue, prjValue, runValueError)
|
import Data.Abstract.Value (Namespace(..), Value, ValueError, injValue, prjValue, runValueError)
|
||||||
import Data.Bifunctor (first)
|
import Data.Bifunctor (first)
|
||||||
import Data.Blob as X
|
import Data.Blob as X
|
||||||
@ -93,7 +94,7 @@ testEvaluating
|
|||||||
deNamespace :: Value Precise -> Maybe (Name, [Name])
|
deNamespace :: Value Precise -> Maybe (Name, [Name])
|
||||||
deNamespace = fmap (namespaceName &&& Env.names . namespaceScope) . prjValue @(Namespace Precise)
|
deNamespace = fmap (namespaceName &&& Env.names . namespaceScope) . prjValue @(Namespace Precise)
|
||||||
|
|
||||||
derefQName :: Heap Precise (Cell Precise) (Value Precise) -> NonEmpty Name -> Environment Precise (Value Precise) -> Maybe (Value Precise)
|
derefQName :: Heap Precise (Cell Precise) (Value Precise) -> NonEmpty Name -> Environment Precise -> Maybe (Value Precise)
|
||||||
derefQName heap = go
|
derefQName heap = go
|
||||||
where go (n1 :| ns) env = Env.lookup n1 env >>= flip heapLookup heap >>= getLast . unLatest >>= case ns of
|
where go (n1 :| ns) env = Env.lookup n1 env >>= flip heapLookup heap >>= getLast . unLatest >>= case ns of
|
||||||
[] -> Just
|
[] -> Just
|
||||||
|
0
test/fixtures/haskell/corpus/blank.A.hs
vendored
Normal file
0
test/fixtures/haskell/corpus/blank.A.hs
vendored
Normal file
3
test/fixtures/haskell/corpus/blank.parseA.txt
vendored
Normal file
3
test/fixtures/haskell/corpus/blank.parseA.txt
vendored
Normal file
@ -0,0 +1,3 @@
|
|||||||
|
(Module
|
||||||
|
(Empty)
|
||||||
|
([]))
|
37
test/fixtures/haskell/corpus/literals.A.hs
vendored
Normal file
37
test/fixtures/haskell/corpus/literals.A.hs
vendored
Normal file
@ -0,0 +1,37 @@
|
|||||||
|
module A where
|
||||||
|
a = 0
|
||||||
|
a = 1
|
||||||
|
|
||||||
|
a = 0o00
|
||||||
|
a = 0O77
|
||||||
|
|
||||||
|
a = 0x00
|
||||||
|
a = 0XFF
|
||||||
|
|
||||||
|
a = 0.00
|
||||||
|
a = 0.99
|
||||||
|
|
||||||
|
a = 0.00e01
|
||||||
|
a = 0.99E01
|
||||||
|
a = 0.00e+01
|
||||||
|
a = 0.99E-01
|
||||||
|
a = 0.00e-01
|
||||||
|
a = 0.99E+01
|
||||||
|
|
||||||
|
a = 00e01
|
||||||
|
a = 99E01
|
||||||
|
a = 00e+01
|
||||||
|
a = 99E-01
|
||||||
|
a = 00e-01
|
||||||
|
a = 99E+01
|
||||||
|
|
||||||
|
a = undefined
|
||||||
|
_a0 = undefined
|
||||||
|
_A0 = undefined
|
||||||
|
a0 = undefined
|
||||||
|
a9 = undefined
|
||||||
|
aA = undefined
|
||||||
|
aZ' = undefined
|
||||||
|
|
||||||
|
a = True
|
||||||
|
a = False
|
37
test/fixtures/haskell/corpus/literals.B.hs
vendored
Normal file
37
test/fixtures/haskell/corpus/literals.B.hs
vendored
Normal file
@ -0,0 +1,37 @@
|
|||||||
|
module A where
|
||||||
|
b = 0
|
||||||
|
b = 1
|
||||||
|
|
||||||
|
b = 0o00
|
||||||
|
b = 0O77
|
||||||
|
|
||||||
|
b = 0x00
|
||||||
|
b = 0XFF
|
||||||
|
|
||||||
|
b = 0.00
|
||||||
|
b = 0.99
|
||||||
|
|
||||||
|
b = 0.00e01
|
||||||
|
b = 0.99E01
|
||||||
|
b = 0.00e+01
|
||||||
|
b = 0.99E-01
|
||||||
|
b = 0.00e-01
|
||||||
|
b = 0.99E+01
|
||||||
|
|
||||||
|
b = 00e01
|
||||||
|
b = 99E01
|
||||||
|
b = 00e+01
|
||||||
|
b = 99E-01
|
||||||
|
b = 00e-01
|
||||||
|
b = 99E+01
|
||||||
|
|
||||||
|
b = undefined
|
||||||
|
ba0 = undefined
|
||||||
|
bA0 = undefined
|
||||||
|
b0 = undefined
|
||||||
|
b9 = undefined
|
||||||
|
bA = undefined
|
||||||
|
bZ' = undefined
|
||||||
|
|
||||||
|
b = True
|
||||||
|
b = False
|
232
test/fixtures/haskell/corpus/literals.diffA-B.txt
vendored
Normal file
232
test/fixtures/haskell/corpus/literals.diffA-B.txt
vendored
Normal file
@ -0,0 +1,232 @@
|
|||||||
|
(Module
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Function
|
||||||
|
{ (Identifier)
|
||||||
|
->(Identifier) }
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}))
|
230
test/fixtures/haskell/corpus/literals.diffB-A.txt
vendored
Normal file
230
test/fixtures/haskell/corpus/literals.diffB-A.txt
vendored
Normal file
@ -0,0 +1,230 @@
|
|||||||
|
(Module
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Function
|
||||||
|
{ (Identifier)
|
||||||
|
->(Identifier) }
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Integer)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Float)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
(Function
|
||||||
|
{ (Identifier)
|
||||||
|
->(Identifier) }
|
||||||
|
(
|
||||||
|
{+(Identifier)+}
|
||||||
|
{-(Integer)-}))
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{+(Function
|
||||||
|
{+(Identifier)+}
|
||||||
|
{+(
|
||||||
|
{+(Identifier)+})+})+}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Integer)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Float)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}
|
||||||
|
{-(Function
|
||||||
|
{-(Identifier)-}
|
||||||
|
{-(
|
||||||
|
{-(Identifier)-})-})-}))
|
119
test/fixtures/haskell/corpus/literals.parseA.txt
vendored
Normal file
119
test/fixtures/haskell/corpus/literals.parseA.txt
vendored
Normal file
@ -0,0 +1,119 @@
|
|||||||
|
(Module
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))))
|
119
test/fixtures/haskell/corpus/literals.parseB.txt
vendored
Normal file
119
test/fixtures/haskell/corpus/literals.parseB.txt
vendored
Normal file
@ -0,0 +1,119 @@
|
|||||||
|
(Module
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Integer)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Float)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))
|
||||||
|
(Function
|
||||||
|
(Identifier)
|
||||||
|
(
|
||||||
|
(Identifier)))))
|
Loading…
Reference in New Issue
Block a user