diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 index 000000000..94400e61a --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,29 @@ +module Main where + +import Criterion.Main +import Semantic.Util +import Data.Monoid +import Control.Monad + +-- We use `fmap show` to ensure that all the parts of the result of evaluation are +-- evaluated themselves. While an NFData instance is the most morally correct way +-- to do this, I'm reluctant to add NFData instances to every single datatype in the +-- project—coercing the result into a string will suffice, though it throws off the +-- memory allocation results a bit. +pyEval :: FilePath -> Benchmarkable +pyEval = whnfIO . fmap show . evaluatePythonFile . ("bench/bench-fixtures/python/" <>) + +rbEval :: FilePath -> Benchmarkable +rbEval = whnfIO . fmap show . evaluateRubyFile . ("bench/bench-fixtures/ruby/" <>) + +main :: IO () +main = defaultMain + [ bgroup "python" [ bench "assignment" $ pyEval "simple-assignment.py" + , bench "function def" $ pyEval "function-definition.py" + , bench "if + function calls" $ pyEval "if-statement-functions.py" + ] + , bgroup "ruby" [ bench "assignment" $ rbEval "simple-assignment.rb" + , bench "function def" $ rbEval "function-definition.rb" + , bench "if + function calls" $ rbEval "if-statement-functions.rb" + ] + ] diff --git a/bench/bench-fixtures/python/function-definition.py b/bench/bench-fixtures/python/function-definition.py new file mode 100644 index 000000000..5e687baf3 --- /dev/null +++ b/bench/bench-fixtures/python/function-definition.py @@ -0,0 +1,14 @@ +def a(): + b + +def c(d): + e + +def g(g, *h): + i + +def h(i=1): + i + +def i(j="default", **c): + j diff --git a/bench/bench-fixtures/python/if-statement-functions.py b/bench/bench-fixtures/python/if-statement-functions.py new file mode 100644 index 000000000..b0354a090 --- /dev/null +++ b/bench/bench-fixtures/python/if-statement-functions.py @@ -0,0 +1,12 @@ +def foo(): return "bipp" + +def bar(): return foo() + +def baz(): return bar() + +def why(): return "elle" + +if True: + baz() +else: + why() diff --git a/bench/bench-fixtures/python/simple-assignment.py b/bench/bench-fixtures/python/simple-assignment.py new file mode 100644 index 000000000..d3c54e12d --- /dev/null +++ b/bench/bench-fixtures/python/simple-assignment.py @@ -0,0 +1,5 @@ +foo = 2 +bar = foo +dang = 3 +song = dang +song diff --git a/bench/bench-fixtures/ruby/function-definition.rb b/bench/bench-fixtures/ruby/function-definition.rb new file mode 100644 index 000000000..275e25082 --- /dev/null +++ b/bench/bench-fixtures/ruby/function-definition.rb @@ -0,0 +1,19 @@ +def a() + "b" +end + +def c(d) + "e" +end + +def g(g_) + "i" +end + +def h(i=1) + i +end + +def i() + "j" +end diff --git a/bench/bench-fixtures/ruby/if-statement-functions.rb b/bench/bench-fixtures/ruby/if-statement-functions.rb new file mode 100644 index 000000000..52f7af32f --- /dev/null +++ b/bench/bench-fixtures/ruby/if-statement-functions.rb @@ -0,0 +1,21 @@ +def foo() + "bipp" +end + +def bar() + foo() +end + +def baz() + bar() +end + +def why() + return "elle" +end + +if true + baz() +else + why() +end diff --git a/bench/bench-fixtures/ruby/simple-assignment.rb b/bench/bench-fixtures/ruby/simple-assignment.rb new file mode 100644 index 000000000..d3c54e12d --- /dev/null +++ b/bench/bench-fixtures/ruby/simple-assignment.rb @@ -0,0 +1,5 @@ +foo = 2 +bar = foo +dang = 3 +song = dang +song diff --git a/semantic.cabal b/semantic.cabal index fc7eaa59a..64ab0b1e7 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -37,7 +37,6 @@ library -- Control flow , Control.Effect -- Effects used for program analysis - , Control.Monad.Effect.Cache , Control.Monad.Effect.Fresh -- , Control.Monad.Effect.GC , Control.Monad.Effect.NonDet @@ -141,7 +140,6 @@ library , bifunctors , bytestring , cmark-gfm - , comonad , containers , directory , effects @@ -162,7 +160,6 @@ library , parsers , pointed , recursion-schemes - , semigroups , scientific , split , stm-chans @@ -254,6 +251,18 @@ test-suite test default-language: Haskell2010 default-extensions: DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, RecordWildCards +benchmark evaluation + hs-source-dirs: bench + type: exitcode-stdio-1.0 + main-is: Main.hs + ghc-options: -threaded -rtsopts "-with-rtsopts=-N -A4m -n2m -T" -static -j -O + cc-options: -DU_STATIC_IMPLEMENTATION=1 + cpp-options: -DU_STATIC_IMPLEMENTATION=1 + build-depends: base + , criterion + , semantic + + source-repository head type: git location: https://github.com/github/semantic diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 981c4d801..71aa8c8c0 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -33,8 +33,8 @@ type CachingEffects t v , Fail -- For 'MonadFail'. , NonDetEff -- For 'Alternative' & 'MonadNonDet'. , State (Store (LocationFor v) v) -- For 'MonadStore'. - , Reader (Cache (LocationFor v) t v) -- For 'MonadCacheIn'. - , State (Cache (LocationFor v) t v) -- For 'MonadCacheOut'. + , Reader (Cache (LocationFor v) t v) -- For reading memoized values. + , State (Cache (LocationFor v) t v) -- For writing said values. , Reader (ModuleTable t) -- Cache of unevaluated modules , State (ModuleTable (EnvironmentFor v)) -- Cache of evaluated modules ] diff --git a/src/Control/Monad/Effect/Cache.hs b/src/Control/Monad/Effect/Cache.hs deleted file mode 100644 index 5d72578b9..000000000 --- a/src/Control/Monad/Effect/Cache.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} -module Control.Monad.Effect.Cache where - -import Control.Monad.Effect -import Control.Monad.Effect.Reader -import Control.Monad.Effect.State -import Data.Abstract.Cache -import Data.Abstract.Value - --- | 'Monad's offering a readable 'Cache' of values & stores for each configuration in a program. --- --- This (in-)cache is used as an oracle for the results of recursive computations, allowing us to finitize potentially nonterminating control flow by repeatedly computing the results until analysis converges on a stable value. Each iteration of this process must consult this cache only _after_ evaluating the configuration itself in order to ensure soundness (since it could otherwise produce stale results for some configurations). --- --- Since finitization crucially depends on convergence, this cache should only be used with value abstractions that will converge for multiple disjoint assignments of a given variable, e.g. its type, and not with precisely-modelled values. To illustrate why, consider a simple incrementing recursive function: --- --- > inc :: Integer -> a --- > inc n = inc (n + 1) --- --- @n@ differs at every iteration, and thus a precise modelling of the integral value will not converge in the store: each iteration will allocate a new address & write a distinct value into it. Modelling values with their types _will_ converge, however, as the type at each iteration is the same. -class Monad m => MonadCacheIn t v m where - -- | Retrieve the local in-cache. - askCache :: m (Cache (LocationFor v) t v) - - -- | Run a computation with a locally-modified in-cache. - localCache :: (Cache (LocationFor v) t v -> Cache (LocationFor v) t v) -> m a -> m a - -instance (Reader (Cache (LocationFor v) t v) :< fs) => MonadCacheIn t v (Eff fs) where - askCache = ask - localCache = local - --- | Project a value out of the in-cache. -asksCache :: MonadCacheIn t v m => (Cache (LocationFor v) t v -> a) -> m a -asksCache f = f <$> askCache - - --- | 'Monad's offering a readable & writable 'Cache' of values & stores for each configuration in a program. --- --- This (out-)cache is used to store the results of recursive computations, allowing us to finitize each iteration of an analysis by first looking up the current configuration in the cache and only evaluating: --- --- 1. If the configuration has not been visited before, and --- 2. _after_ copying the previous iteration’s results (from the in-cache, and defaulting to a 'mempty' set of results) into the out-cache. --- --- Thus, visiting the same configuration twice recursively will terminate, since we’ll have consulted the in-cache as an oracle before evaluating, and after evaluating, the resulting value and store should be appended into the out-cache. Then, once the current iteration of the analysis has completed, the updated out-cache will be used as the oracle for the next iteration, until such time as the cache converges. --- --- See also 'MonadCacheIn' for discussion of the conditions of finitization. -class Monad m => MonadCacheOut t v m where - -- | Retrieve the current out-cache. - getCache :: m (Cache (LocationFor v) t v) - - -- | Update the current out-cache. - putCache :: Cache (LocationFor v) t v -> m () - -instance (State (Cache (LocationFor v) t v) :< fs) => MonadCacheOut t v (Eff fs) where - getCache = get - putCache = put - --- | Project a value out of the out-cache. -getsCache :: MonadCacheOut t v m => (Cache (LocationFor v) t v -> a) -> m a -getsCache f = f <$> getCache - --- | Modify the current out-cache using a given function. -modifyCache :: MonadCacheOut t v m => (Cache (LocationFor v) t v -> Cache (LocationFor v) t v) -> m () -modifyCache f = fmap f getCache >>= putCache diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index d2345c1e9..5b6086642 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -158,8 +158,19 @@ instance Eq1 Module where liftEq = genericLiftEq instance Ord1 Module where liftCompare = genericLiftCompare instance Show1 Module where liftShowsPrec = genericLiftShowsPrec --- TODO: Implement Eval instance for Module -instance Evaluatable Module +-- TODO: Fix this extremely bogus instance (copied from that of Program) +-- In Go, functions in the same module can be spread across files. +-- We need to ensure that all input files have aggregated their content into +-- a coherent module before we begin evaluating a module. +instance Evaluatable Module where + eval (Module _ xs) = eval' xs + where + eval' [] = unit >>= interface + eval' [x] = subtermValue x >>= interface + eval' (x:xs) = do + _ <- subtermValue x + env <- getGlobalEnv + localEnv (envUnion env) (eval' xs) -- | A decorator in Python data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a } diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index c4550cd06..904cbb2b1 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -2,51 +2,70 @@ module Language.Go.Syntax where import Prologue +import Data.Abstract.Evaluatable import Diffing.Algorithm -- A composite literal in Go data Composite a = Composite { compositeType :: !a, compositeElement :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Composite where liftEq = genericLiftEq instance Ord1 Composite where liftCompare = genericLiftCompare instance Show1 Composite where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for Composite +instance Evaluatable Composite + -- | A default pattern in a Go select or switch statement (e.g. `switch { default: s() }`). newtype DefaultPattern a = DefaultPattern { defaultPatternBody :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 DefaultPattern where liftEq = genericLiftEq instance Ord1 DefaultPattern where liftCompare = genericLiftCompare instance Show1 DefaultPattern where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for DefaultPattern +instance Evaluatable DefaultPattern + -- | A defer statement in Go (e.g. `defer x()`). newtype Defer a = Defer { deferBody :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Defer where liftEq = genericLiftEq instance Ord1 Defer where liftCompare = genericLiftCompare instance Show1 Defer where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for Defer +instance Evaluatable Defer + -- | A go statement (i.e. go routine) in Go (e.g. `go x()`). newtype Go a = Go { goBody :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Go where liftEq = genericLiftEq instance Ord1 Go where liftCompare = genericLiftCompare instance Show1 Go where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for Go +instance Evaluatable Go + -- | A label statement in Go (e.g. `label:continue`). data Label a = Label { _labelName :: !a, labelStatement :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Label where liftEq = genericLiftEq instance Ord1 Label where liftCompare = genericLiftCompare instance Show1 Label where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for Label +instance Evaluatable Label + -- | A rune literal in Go (e.g. `'⌘'`). newtype Rune a = Rune { _runeLiteral :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + +-- TODO: Implement Eval instance for Rune +instance Evaluatable Rune instance Eq1 Rune where liftEq = genericLiftEq instance Ord1 Rune where liftCompare = genericLiftCompare @@ -54,7 +73,10 @@ instance Show1 Rune where liftShowsPrec = genericLiftShowsPrec -- | A select statement in Go (e.g. `select { case x := <-c: x() }` where each case is a send or receive operation on channels). data Select a = Select { selectCases :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + +-- TODO: Implement Eval instance for Select +instance Evaluatable Select instance Eq1 Select where liftEq = genericLiftEq instance Ord1 Select where liftCompare = genericLiftCompare @@ -62,80 +84,110 @@ instance Show1 Select where liftShowsPrec = genericLiftShowsPrec -- | A send statement in Go (e.g. `channel <- value`). data Send a = Send { sendReceiver :: !a, sendValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Send where liftEq = genericLiftEq instance Ord1 Send where liftCompare = genericLiftCompare instance Show1 Send where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for Send +instance Evaluatable Send + -- | A slice expression in Go (e.g. `a[1:4:3]` where a is a list, 1 is the low bound, 4 is the high bound, and 3 is the max capacity). data Slice a = Slice { sliceName :: !a, sliceLow :: !a, sliceHigh :: !a, sliceCapacity :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Slice where liftEq = genericLiftEq instance Ord1 Slice where liftCompare = genericLiftCompare instance Show1 Slice where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for Slice +instance Evaluatable Slice + -- | A type switch statement in Go (e.g. `switch x.(type) { // cases }`). data TypeSwitch a = TypeSwitch { typeSwitchSubject :: !a, typeSwitchCases :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeSwitch where liftEq = genericLiftEq instance Ord1 TypeSwitch where liftCompare = genericLiftCompare instance Show1 TypeSwitch where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for TypeSwitch +instance Evaluatable TypeSwitch + -- | A type switch guard statement in a Go type switch statement (e.g. `switch i := x.(type) { // cases}`). newtype TypeSwitchGuard a = TypeSwitchGuard { typeSwitchGuardSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare instance Show1 TypeSwitchGuard where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for TypeSwitchGuard +instance Evaluatable TypeSwitchGuard + -- | A receive statement in a Go select statement (e.g. `case value := <-channel` ) data Receive a = Receive { receiveSubject :: !a, receiveExpression :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Receive where liftEq = genericLiftEq instance Ord1 Receive where liftCompare = genericLiftCompare instance Show1 Receive where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for Receive +instance Evaluatable Receive + -- | A receive operator unary expression in Go (e.g. `<-channel` ) data ReceiveOperator a = ReceiveOperator a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ReceiveOperator where liftEq = genericLiftEq instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare instance Show1 ReceiveOperator where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for ReceiveOperator +instance Evaluatable ReceiveOperator + -- | A field declaration in a Go struct type declaration. data Field a = Field { fieldContext :: ![a], fieldName :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Field where liftEq = genericLiftEq instance Ord1 Field where liftCompare = genericLiftCompare instance Show1 Field where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for Field +instance Evaluatable Field + -- | A type assertion in Go (e.g. `x.(T)` where the value of `x` is not nil and is of type `T`). data TypeAssertion a = TypeAssertion { typeAssertionSubject :: !a, typeAssertionType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeAssertion where liftEq = genericLiftEq instance Ord1 TypeAssertion where liftCompare = genericLiftCompare instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for TypeAssertion +instance Evaluatable TypeAssertion + -- | A type conversion expression in Go (e.g. `T(x)` where `T` is a type and `x` is an expression that can be converted to type `T`). data TypeConversion a = TypeConversion { typeConversionType :: !a, typeConversionSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeConversion where liftEq = genericLiftEq instance Ord1 TypeConversion where liftCompare = genericLiftCompare instance Show1 TypeConversion where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for TypeConversion +instance Evaluatable TypeConversion + -- | Variadic arguments and parameters in Go (e.g. parameter: `param ...Type`, argument: `Type...`). data Variadic a = Variadic { variadicContext :: [a], variadicIdentifier :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Variadic where liftEq = genericLiftEq instance Ord1 Variadic where liftCompare = genericLiftCompare instance Show1 Variadic where liftShowsPrec = genericLiftShowsPrec + +-- TODO: Implement Eval instance for Variadic +instance Evaluatable Variadic diff --git a/src/Language/Go/Type.hs b/src/Language/Go/Type.hs index f867030ee..b6292c5c0 100644 --- a/src/Language/Go/Type.hs +++ b/src/Language/Go/Type.hs @@ -2,28 +2,38 @@ module Language.Go.Type where import Prologue +import Data.Abstract.Evaluatable import Diffing.Algorithm -- | A Bidirectional channel in Go (e.g. `chan`). newtype BidirectionalChannel a = BidirectionalChannel a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 BidirectionalChannel where liftEq = genericLiftEq instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare instance Show1 BidirectionalChannel where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for BidirectionalChannel +instance Evaluatable BidirectionalChannel + -- | A Receive channel in Go (e.g. `<-chan`). newtype ReceiveChannel a = ReceiveChannel a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ReceiveChannel where liftEq = genericLiftEq instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare instance Show1 ReceiveChannel where liftShowsPrec = genericLiftShowsPrec +-- TODO: Implement Eval instance for ReceiveChannel +instance Evaluatable ReceiveChannel + -- | A Send channel in Go (e.g. `chan<-`). newtype SendChannel a = SendChannel a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 SendChannel where liftEq = genericLiftEq instance Ord1 SendChannel where liftCompare = genericLiftCompare instance Show1 SendChannel where liftShowsPrec = genericLiftShowsPrec + +-- TODO: Implement Eval instance for SendChannel +instance Evaluatable SendChannel diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 34ad22d99..f1e534805 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -24,13 +24,17 @@ import Semantic import Semantic.IO as IO import Semantic.Task +import qualified Language.Go.Assignment as Go import qualified Language.Ruby.Assignment as Ruby import qualified Language.Python.Assignment as Python import qualified Language.TypeScript.Assignment as TypeScript -type RubyValue = Value Precise (Term (Union Ruby.Syntax) (Record Location)) -type PythonValue = Value Precise (Term (Union Python.Syntax) (Record Location)) -type TypeScriptValue = Value Precise (Term (Union TypeScript.Syntax) (Record Location)) +type Language a = Value Precise (Term (Union a) (Record Location)) + +type GoValue = Language Go.Syntax +type RubyValue = Language Ruby.Syntax +type PythonValue = Language Python.Syntax +type TypeScriptValue = Language TypeScript.Syntax file :: MonadIO m => FilePath -> m Blob file path = fromJust <$> IO.readFile path (languageForFilePath path) @@ -44,6 +48,13 @@ evaluateRubyFiles paths = do (t:ts) <- runTask $ traverse (parse rubyParser) blobs pure $ evaluates @RubyValue (zip bs ts) (b, t) +-- Go +typecheckGoFile path = evaluateCache @Type <$> + (file path >>= runTask . parse goParser) + +evaluateGoFile path = evaluateCache @GoValue <$> + (file path >>= runTask . parse goParser) + -- Python typecheckPythonFile path = evaluateCache @Type <$> (file path >>= runTask . parse pythonParser) diff --git a/test/Assigning/Assignment/Spec.hs b/test/Assigning/Assignment/Spec.hs index ea1969012..e4327a153 100644 --- a/test/Assigning/Assignment/Spec.hs +++ b/test/Assigning/Assignment/Spec.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DataKinds #-} -module Assigning.Assignment.Spec where +module Assigning.Assignment.Spec (spec) where import Assigning.Assignment import Data.AST diff --git a/test/Data/Functor/Classes/Generic/Spec.hs b/test/Data/Functor/Classes/Generic/Spec.hs index e1cca2d59..01d4e41a5 100644 --- a/test/Data/Functor/Classes/Generic/Spec.hs +++ b/test/Data/Functor/Classes/Generic/Spec.hs @@ -1,4 +1,4 @@ -module Data.Functor.Classes.Generic.Spec where +module Data.Functor.Classes.Generic.Spec (spec) where import Data.Functor.Classes.Generic import Data.Functor.Listable diff --git a/test/Data/Mergeable/Spec.hs b/test/Data/Mergeable/Spec.hs index 9f3bd3cfe..92493e060 100644 --- a/test/Data/Mergeable/Spec.hs +++ b/test/Data/Mergeable/Spec.hs @@ -1,5 +1,5 @@ {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} -module Data.Mergeable.Spec where +module Data.Mergeable.Spec (spec) where import Control.Applicative (Alternative(..)) import Data.Functor.Identity diff --git a/test/Data/Source/Spec.hs b/test/Data/Source/Spec.hs index a0da10b93..a48820dd3 100644 --- a/test/Data/Source/Spec.hs +++ b/test/Data/Source/Spec.hs @@ -1,4 +1,4 @@ -module Data.Source.Spec where +module Data.Source.Spec (spec) where import Data.Char (chr) import Data.Functor.Listable diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs index 607483abc..b601587f9 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, OverloadedStrings #-} -module Integration.Spec where +module Integration.Spec (spec) where import qualified Data.ByteString as B import Data.Foldable (find, traverse_) diff --git a/test/Rendering/Imports/Spec.hs b/test/Rendering/Imports/Spec.hs index 77051325f..1feb80f53 100644 --- a/test/Rendering/Imports/Spec.hs +++ b/test/Rendering/Imports/Spec.hs @@ -1,4 +1,4 @@ -module Rendering.Imports.Spec where +module Rendering.Imports.Spec (spec) where import Analysis.Declaration (HasDeclaration, declarationAlgebra) import Analysis.ModuleDef (HasModuleDef, moduleDefAlgebra) @@ -10,7 +10,7 @@ import qualified Data.Map as Map import qualified Semantic.Util as Util import Rendering.Imports import Rendering.Renderer -import Rendering.TOC.Spec +import Rendering.TOC.Spec hiding (spec) import Semantic import Semantic.Task import SpecHelpers diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index fd23648b9..acc3b60a0 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DataKinds, TypeOperators #-} -module Rendering.TOC.Spec where +module Rendering.TOC.Spec (spec) where import Analysis.Decorator (constructorNameAndConstantFields) import Analysis.Declaration diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index 209797908..d650797a3 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} -module Semantic.CLI.Spec where +module Semantic.CLI.Spec (spec) where import Control.Monad (when) import Data.ByteString (ByteString) diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs index d0ae83566..8bc6d391c 100644 --- a/test/Semantic/IO/Spec.hs +++ b/test/Semantic/IO/Spec.hs @@ -1,4 +1,4 @@ -module Semantic.IO.Spec where +module Semantic.IO.Spec (spec) where import Data.Blob import Data.Functor.Both as Both diff --git a/test/Semantic/Stat/Spec.hs b/test/Semantic/Stat/Spec.hs index 6fd3f2209..9928ad030 100644 --- a/test/Semantic/Stat/Spec.hs +++ b/test/Semantic/Stat/Spec.hs @@ -1,4 +1,4 @@ -module Semantic.Stat.Spec where +module Semantic.Stat.Spec (spec) where import Semantic.Stat import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index a59375f8d..9dc4296c4 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -5,7 +5,6 @@ module SpecHelpers , diffFilePaths , parseFilePath , readFilePair -, languageForFilePath , Verbatim(..) , verbatim , readFileVerbatim @@ -79,18 +78,13 @@ diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionD -- | Returns an s-expression parse tree for the specified FilePath. parseFilePath :: FilePath -> IO B.ByteString -parseFilePath path = IO.readFile path (languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer +parseFilePath path = IO.readFile path (IO.languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer -- | Read two files to a BlobPair. readFilePair :: Both FilePath -> IO BlobPair -readFilePair paths = let paths' = fmap (\p -> (p, languageForFilePath p)) paths in +readFilePair paths = let paths' = fmap (\p -> (p, IO.languageForFilePath p)) paths in runBothWith IO.readFilePair paths' --- | Returns a Maybe Language based on the FilePath's extension. -languageForFilePath :: FilePath -> Maybe Language -languageForFilePath = languageForType . takeExtension - - readFileVerbatim :: FilePath -> IO Verbatim readFileVerbatim = fmap verbatim . B.readFile