1
1
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:
Timothy Clem 2018-05-24 10:13:25 -07:00 committed by GitHub
commit a15efb9327
56 changed files with 1381 additions and 476 deletions

View File

@ -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

View File

@ -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
) )

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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'.

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -26,7 +26,7 @@ import Data.Language
import Prologue import Prologue
-- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether weve begun loading the module or not, while the inner 'Maybe' indicates whether weve completed loading it or not. Thus, @Nothing@ means weve never tried to load it, @Just Nothing@ means weve started but havent 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 weve begun loading the module or not, while the inner 'Maybe' indicates whether weve completed loading it or not. Thus, @Nothing@ means weve never tried to load it, @Just Nothing@ means weve started but havent 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

View 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))

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -6,9 +6,9 @@ import Data.Abstract.Live
-- | A single point in a programs execution. -- | A single point in a programs 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)

View File

@ -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

View File

@ -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

View File

@ -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 statements 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 statements return value is returned.
instance Evaluatable [] where
-- 'nonEmpty' and 'foldMap1' enable us to return the last statements 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: Itd be nice if we didnt 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: Itd be nice if we didnt 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 statements 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 statements return value is returned.
instance Evaluatable [] where
-- 'nonEmpty' and 'foldMap1' enable us to return the last statements result instead of 'unit' for non-empty lists.
eval = maybe (Rval <$> unit) (runApp . foldMap1 (App . subtermRef)) . nonEmpty

View File

@ -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

View File

@ -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
View 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

View File

@ -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
View 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—its 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)

View File

@ -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

View File

@ -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 closures 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 closures 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)

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
) )

View File

@ -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

View File

@ -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

View File

@ -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))

View File

@ -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

View File

@ -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"

View File

@ -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

View File

@ -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

View File

@ -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

View File

View File

@ -0,0 +1,3 @@
(Module
(Empty)
([]))

View 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

View 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

View 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)-})-})-}))

View 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)-})-})-}))

View 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)))))

View 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)))))