Merge branch 'master' into preludes-and-subclassing

.gitmodules

@@ -13,18 +13,9 @@
 [submodule "vendor/effects"]
 	path = vendor/effects
 	url = https://github.com/joshvera/effects.git
-[submodule "languages/c/vendor/tree-sitter-c"]
-	path = languages/c/vendor/tree-sitter-c
-	url = https://github.com/tree-sitter/tree-sitter-c.git
-[submodule "languages/javascript/vendor/tree-sitter-javascript"]
-	path = languages/javascript/vendor/tree-sitter-javascript
-	url = https://github.com/tree-sitter/tree-sitter-javascript.git
 [submodule "vendor/haskell-tree-sitter"]
 	path = vendor/haskell-tree-sitter
 	url = https://github.com/tree-sitter/haskell-tree-sitter.git
 [submodule "vendor/freer-cofreer"]
 	path = vendor/freer-cofreer
 	url = https://github.com/robrix/freer-cofreer.git
-[submodule "vendor/ghc-mod"]
-	path = vendor/ghc-mod
-	url = https://github.com/joshvera/ghc-mod

.stylish-haskell.yaml

@@ -225,6 +225,8 @@ language_extensions:
   - FlexibleContexts
   - FlexibleInstances
   - MultiParamTypeClasses
+  - StandaloneDeriving
+  - DataKinds
   - OverloadedStrings
   - RecordWildCards
   - StrictData

semantic.cabal

@@ -183,14 +183,17 @@ library
                      , tree-sitter-ruby
                      , tree-sitter-typescript
   default-language:    Haskell2010
-  default-extensions:  DeriveFoldable
+  default-extensions:  DataKinds
+                     , DeriveFoldable
                      , DeriveFunctor
                      , DeriveGeneric
                      , DeriveTraversable
                      , FlexibleContexts
                      , FlexibleInstances
+                     , MultiParamTypeClasses
                      , OverloadedStrings
                      , RecordWildCards
+                     , StandaloneDeriving
                      , StrictData
   ghc-options:         -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O -j
   ghc-prof-options:    -fprof-auto
@@ -259,7 +262,15 @@ test-suite test
                      , these
   ghc-options:       -threaded -rtsopts -with-rtsopts=-N -j
   default-language:    Haskell2010
-  default-extensions:  DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, RecordWildCards
+  default-extensions:  DataKinds
+                     , DeriveFunctor
+                     , DeriveGeneric
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , MultiParamTypeClasses
+                     , OverloadedStrings
+                     , RecordWildCards
+                     , StandaloneDeriving
 
 test-suite doctests
   type:                exitcode-stdio-1.0

src/Analysis/Abstract/Caching.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Abstract.Caching
 ( type Caching
 ) where
@@ -13,7 +13,7 @@ import Prologue
 -- | The effects necessary for caching analyses.
 type CachingEffects term value effects
   = Fresh                        -- For 'MonadFresh'.
- ': NonDetEff                    -- For 'Alternative' and 'MonadNonDet'.
+ ': NonDet                       -- For 'Alternative' and 'MonadNonDet'.
  ': Reader (CacheFor term value) -- The in-cache used as an oracle while converging on a result.
  ': State  (CacheFor term value) -- The out-cache used to record results in each iteration of convergence.
  ': effects

src/Analysis/Abstract/Collecting.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Abstract.Collecting
 ( type Collecting
 ) where

src/Analysis/Abstract/Dead.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
 module Analysis.Abstract.Dead
 ( type DeadCode
 ) where

src/Analysis/Abstract/Evaluating.hs

@@ -11,9 +11,7 @@ module Analysis.Abstract.Evaluating
 
 import Control.Abstract.Evaluator
 import Control.Monad.Effect
-import Control.Monad.Effect.Fail
-import Control.Monad.Effect.Reader
-import Control.Monad.Effect.State
+import Control.Monad.Effect.Resumable
 import Data.Abstract.Configuration
 import qualified Data.Abstract.Environment as Env
 import Data.Abstract.Environment (Environment)
@@ -27,7 +25,7 @@ import qualified Data.IntMap as IntMap
 import Data.Language
 import Data.List.Split (splitWhen)
 import Prelude hiding (fail)
-import Prologue
+import Prologue hiding (throwError)
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.Map as Map
 import System.FilePath.Posix
@@ -160,12 +158,13 @@ newtype Evaluating term value effects a = Evaluating (Eff effects a)
 
 deriving instance Member Fail      effects => MonadFail   (Evaluating term value effects)
 deriving instance Member Fresh     effects => MonadFresh  (Evaluating term value effects)
-deriving instance Member NonDetEff effects => Alternative (Evaluating term value effects)
-deriving instance Member NonDetEff effects => MonadNonDet (Evaluating term value effects)
+deriving instance Member NonDet    effects => Alternative (Evaluating term value effects)
+deriving instance Member NonDet    effects => MonadNonDet (Evaluating term value effects)
 
 -- | Effects necessary for evaluating (whether concrete or abstract).
 type EvaluatingEffects term value
-  = '[ Fail                                               -- Failure with an error message
+  = '[ Resumable Prelude.String value
+     , Fail                                        -- Failure with an error message
      , State  (EnvironmentFor value)                      -- Environments (both local and global)
      , State  (HeapFor value)                             -- The heap
      , Reader (ModuleTable [term])                        -- Cache of unevaluated modules
@@ -175,6 +174,10 @@ type EvaluatingEffects term value
      , State  (IntMap.IntMap term)                        -- For jumps
      ]
 
+
+instance Members '[Resumable Prelude.String value] effects => MonadThrow Prelude.String value (Evaluating term value effects) where
+   throwException = raise . throwError
+
 instance Members '[Fail, State (IntMap.IntMap term)] effects => MonadControl term (Evaluating term value effects) where
   label term = do
     m <- raise get
@@ -229,4 +232,4 @@ instance ( Evaluatable (Base term)
          => MonadAnalysis term value (Evaluating term value effects) where
   type RequiredEffects term value (Evaluating term value effects) = EvaluatingEffects term value
 
-  analyzeTerm = eval
+  analyzeTerm term = resumeException @value (eval term) (\yield exc -> string (BC.pack exc) >>= yield)

src/Analysis/Abstract/Tracing.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Abstract.Tracing
 ( type Tracing
 ) where

src/Analysis/ConstructorName.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.ConstructorName
 ( ConstructorName(..)
 , ConstructorLabel(..)

src/Analysis/Declaration.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, TypeOperators, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE TypeOperators, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Analysis.Declaration
 ( Declaration(..)
 , HasDeclaration

src/Analysis/IdentifierName.hs

@@ -1,17 +1,17 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.IdentifierName
 ( IdentifierName(..)
 , IdentifierLabel(..)
 , identifierLabel
 ) where
 
-import Data.Abstract.FreeVariables
-import Data.Aeson
-import Data.JSON.Fields
-import Data.Term
-import Data.Text.Encoding (decodeUtf8)
-import Prologue
+import           Data.Abstract.FreeVariables
+import           Data.Aeson
+import           Data.JSON.Fields
 import qualified Data.Syntax
+import           Data.Term
+import           Data.Text.Encoding (decodeUtf8)
+import           Prologue
 
 -- | Compute a 'IdentifierLabel' label for a 'Term'.
 identifierLabel :: IdentifierName syntax => TermF syntax a b -> Maybe IdentifierLabel

src/Analysis/ModuleDef.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Analysis.ModuleDef
 ( ModuleDef(..)
 , HasModuleDef

src/Control/Abstract/Analysis.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For runAnalysis
 module Control.Abstract.Analysis
 ( MonadAnalysis(..)

src/Control/Abstract/Evaluator.hs

@@ -14,6 +14,7 @@ module Control.Abstract.Evaluator
   , MonadModuleTable(..)
   , modifyModuleTable
   , MonadControl(..)
+  , MonadThrow(..)
 ) where
 
 import Data.Abstract.Address
@@ -160,3 +161,6 @@ class Monad m => MonadControl term m where
   label :: term -> m Label
   -- | “Jump” to a previously-allocated 'Label' (retrieving the @term@ at which it points, which can then be evaluated in e.g. a 'MonadAnalysis' instance).
   goto :: Label -> m term
+
+class Monad m => MonadThrow exc v m | m -> exc where
+  throwException :: exc -> m v

src/Control/Abstract/Value.hs

@@ -92,8 +92,15 @@ class (Monad m, Show value) => MonadValue value m where
         -> EnvironmentFor value -- ^ The environment to capture
         -> m value
 
-  -- | Extract the environment from a class.
-  objectEnvironment :: value -> m (EnvironmentFor value)
+  -- | Build a namespace value from a name and environment stack
+  --
+  -- Namespaces model closures with monoidal environments.
+  namespace :: Name                 -- ^ The namespace's identifier
+            -> EnvironmentFor value -- ^ The environment to mappend
+            -> m value
+
+  -- | Extract the environment from any scoped object (e.g. classes, namespaces, etc).
+  scopedEnvironment :: value -> m (EnvironmentFor value)
 
   -- | Evaluate an abstraction (a binder like a lambda or method definition).
   abstract :: (FreeVariables term, MonadControl term m) => [Name] -> Subterm term (m value) -> m value
@@ -157,13 +164,22 @@ instance ( Monad m
 
   klass n [] env = pure . injValue $ Class n env
   klass n supers env = do
-    product <- mconcat <$> traverse objectEnvironment supers
+    product <- mconcat <$> traverse scopedEnvironment supers
     pure . injValue $ Class n (Env.push product <> env)
 
 
-  objectEnvironment o
+  namespace n env = do
+    maybeAddr <- lookupEnv n
+    env' <- maybe (pure mempty) (asNamespaceEnv <=< deref) maybeAddr
+    pure (injValue (Namespace n (env' <> env)))
+    where asNamespaceEnv v
+            | Just (Namespace _ env') <- prjValue v = pure env'
+            | otherwise                             = fail ("expected " <> show v <> " to be a namespace")
+
+  scopedEnvironment o
     | Just (Class _ env) <- prjValue o = pure env
-    | otherwise = fail ("non-object type passed to objectEnvironment: " <> show o)
+    | Just (Namespace _ env) <- prjValue o = pure env
+    | otherwise = fail ("object type passed to scopedEnvironment doesn't have an environment: " <> show o)
 
   asString v
     | Just (Value.String n) <- prjValue v = pure n
@@ -268,9 +284,10 @@ instance (Alternative m, MonadEnvironment Type m, MonadFail m, MonadFresh m, Mon
   multiple   = pure . Type.Product
   array      = pure . Type.Array
 
-  klass _ _ _  = pure Object
+  klass _ _ _   = pure Object
+  namespace _ _ = pure Type.Unit
 
-  objectEnvironment _ = pure mempty
+  scopedEnvironment _ = pure mempty
 
   asString _ = fail "Must evaluate to Value to use asString"
 

src/Control/Effect.hs

@@ -1,13 +1,13 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, TypeOperators, UndecidableInstances, ScopedTypeVariables #-}
 module Control.Effect where
 
-import qualified Control.Monad.Effect as Effect
+import Control.Monad.Effect as Effect
 import Control.Monad.Effect.Fail
-import Control.Monad.Effect.Internal
-import Control.Monad.Effect.NonDetEff
+import Control.Monad.Effect.NonDet
 import Control.Monad.Effect.Reader
 import Control.Monad.Effect.State
 import Control.Monad.Effect.Writer
+import Control.Monad.Effect.Resumable
 import Data.Semigroup.Reducer
 import Prologue
 
@@ -58,12 +58,18 @@ instance Monoid w => RunEffect (Writer w) a where
   type Result (Writer w) a = (a, w)
   runEffect = runWriter
 
--- | 'NonDetEff' effects are interpreted into a nondeterministic set of result values.
-instance Ord a => RunEffect NonDetEff a where
-  type Result NonDetEff a = Set a
-  runEffect = relay (pure . unit) (\ m k -> case m of
-    MZero -> pure mempty
-    MPlus -> mappend <$> k True <*> k False)
+-- | 'NonDet' effects are interpreted into a nondeterministic set of result values.
+instance Ord a => RunEffect NonDet a where
+  type Result NonDet a = Set a
+  runEffect = runNonDet unit
+
+-- | 'Resumable' effects are interpreted into 'Either' s.t. failures are in 'Left' and successful results are in 'Right'.
+instance RunEffect (Resumable exc v) a where
+  type Result (Resumable exc v) a = Either exc a
+  runEffect = runError
+
+resumeException :: forall v m exc e a. (Effectful m, Resumable exc v :< e) => m e a -> ((v -> m e a) -> exc -> m e a) -> m e a
+resumeException m handle = raise (resumeError (lower m) (\yield -> lower . handle (raise . yield)))
 
 
 -- | Types wrapping 'Eff' actions.

src/Control/Effect/NonDet.hs

@@ -1,11 +1,11 @@
 {-# LANGUAGE TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Control.Effect.NonDet
 ( MonadNonDet(..)
-, NonDetEff
+, NonDet
 ) where
 
 import Control.Monad.Effect.Internal
-import Control.Monad.Effect.NonDetEff
+import Control.Monad.Effect.NonDet as NonDet
 import Prologue
 
 -- | 'Monad's offering local isolation of nondeterminism effects.
@@ -16,8 +16,6 @@ class (Alternative m, Monad m) => MonadNonDet m where
          -> m a      -- ^ The computation to run locally-nondeterministically.
          -> m b      -- ^ A _deterministic_ computation producing the 'Monoid'al accumulation of the _locally-nondeterministic_ result values.
 
--- | Effect stacks containing 'NonDetEff' offer a 'MonadNonDet' instance which implements 'gather' by interpreting the requests for nondeterminism locally, without removing 'NonDetEff' from the stack—i.e. the _capacity_ for nondeterminism is still present in the effect stack, but any local nondeterminism has been applied.
-instance (NonDetEff :< fs) => MonadNonDet (Eff fs) where
-  gather f = interpose (pure . f) (\ m k -> case m of
-    MZero -> pure mempty
-    MPlus -> mappend <$> k True <*> k False)
+-- | Effect stacks containing 'NonDet' offer a 'MonadNonDet' instance which implements 'gather' by interpreting the requests for nondeterminism locally, without removing 'NonDet' from the stack—i.e. the _capacity_ for nondeterminism is still present in the effect stack, but any local nondeterminism has been applied.
+instance (NonDet :< fs) => MonadNonDet (Eff fs) where
+  gather = NonDet.gather

src/Data/Abstract/Evaluatable.hs

@@ -18,7 +18,6 @@ import Data.Proxy
 import Data.Semigroup.Foldable
 import Data.Semigroup.App
 import Data.Term
-import Prelude hiding (fail)
 import Prologue
 
 
@@ -29,10 +28,11 @@ class Evaluatable constr where
           , MonadAnalysis term value m
           , MonadValue value m
           , Show (LocationFor value)
+          , MonadThrow Prelude.String value m
           )
        => SubtermAlgebra constr term (m value)
-  default eval :: (MonadFail m, Show1 constr) => SubtermAlgebra constr term (m value)
-  eval expr = fail $ "Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr ""
+  default eval :: (MonadThrow Prelude.String value m, Show1 constr) => SubtermAlgebra constr term (m value)
+  eval expr = throwException $ "Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr ""
 
 -- | If we can evaluate any syntax which can occur in a 'Union', we can evaluate the 'Union'.
 instance Apply Evaluatable fs => Evaluatable (Union fs) where

src/Data/Abstract/Value.hs

@@ -22,6 +22,7 @@ type ValueConstructors
     , Closure
     , Float
     , Integer
+    , Namespace
     , String
     , Rational
     , Symbol
@@ -145,6 +146,15 @@ instance Eq1 Class where liftEq = genericLiftEq
 instance Ord1 Class where liftCompare = genericLiftCompare
 instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
 
+data Namespace value = Namespace
+  { namespaceName  :: Name
+  , namespaceScope :: Environment Precise value
+  } deriving (Eq, Generic1, Ord, Show)
+
+instance Eq1 Namespace where liftEq = genericLiftEq
+instance Ord1 Namespace where liftCompare = genericLiftCompare
+instance Show1 Namespace where liftShowsPrec = genericLiftShowsPrec
+
 -- | The environment for an abstract value type.
 type EnvironmentFor v = Environment (LocationFor v) v
 

src/Data/Syntax/Expression.hs

@@ -193,7 +193,7 @@ instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable MemberAccess where
   eval (fmap subtermValue -> MemberAccess mem acc) = do
-    lhs <- mem >>= objectEnvironment
+    lhs <- mem >>= scopedEnvironment
     localEnv (mappend lhs) acc
 
 -- | Subscript (e.g a[1])

src/Data/Term.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, RankNTypes, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE RankNTypes, TypeFamilies, TypeOperators #-}
 module Data.Term
 ( Term(..)
 , termIn

src/Language/PHP/Syntax.hs

@@ -1,10 +1,12 @@
-{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveAnyClass, ViewPatterns #-}
 module Language.PHP.Syntax where
 
 import Analysis.Abstract.Evaluating
 import Data.Abstract.Evaluatable
+import Data.Abstract.Environment as Env
 import Data.Abstract.Path
 import Diffing.Algorithm
+import Prelude hiding (fail)
 import Prologue hiding (Text)
 
 
@@ -177,13 +179,18 @@ instance Ord1 RelativeScope where liftCompare = genericLiftCompare
 instance Show1 RelativeScope where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable RelativeScope
 
-data QualifiedName a = QualifiedName a a
+data QualifiedName a = QualifiedName !a !a
   deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 QualifiedName where liftEq = genericLiftEq
 instance Ord1 QualifiedName where liftCompare = genericLiftCompare
 instance Show1 QualifiedName where liftShowsPrec = genericLiftShowsPrec
-instance Evaluatable QualifiedName
+
+instance Evaluatable QualifiedName where
+  eval (fmap subtermValue -> QualifiedName name iden) = do
+    lhs <- name >>= scopedEnvironment
+    localEnv (mappend lhs) iden
+
 
 newtype NamespaceName a = NamespaceName [a]
   deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
@@ -191,7 +198,15 @@ newtype NamespaceName a = NamespaceName [a]
 instance Eq1 NamespaceName where liftEq = genericLiftEq
 instance Ord1 NamespaceName where liftCompare = genericLiftCompare
 instance Show1 NamespaceName where liftShowsPrec = genericLiftShowsPrec
-instance Evaluatable NamespaceName
+
+instance Evaluatable NamespaceName where
+  eval (NamespaceName xs) = go xs
+    where
+      go []     = fail "nonempty NamespaceName not allowed"
+      go [x]    = subtermValue x
+      go (x:xs) = do
+        env <- subtermValue x >>= scopedEnvironment
+        localEnv (mappend env) (go xs)
 
 newtype ConstDeclaration a = ConstDeclaration [a]
   deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
@@ -338,13 +353,31 @@ instance Ord1 NamespaceUseGroupClause where liftCompare = genericLiftCompare
 instance Show1 NamespaceUseGroupClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NamespaceUseGroupClause
 
-data Namespace a = Namespace { namespaceName :: a, namespaceBody :: a}
+data Namespace a = Namespace { namespaceName :: a, namespaceBody :: a }
   deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Namespace where liftEq = genericLiftEq
 instance Ord1 Namespace where liftCompare = genericLiftCompare
 instance Show1 Namespace where liftShowsPrec = genericLiftShowsPrec
-instance Evaluatable Namespace
+
+instance Evaluatable Namespace where
+  eval Namespace{..} = go names
+    where
+      names = toList (freeVariables (subterm namespaceName))
+      go [] = fail "expected at least one free variable in namespaceName, found none"
+      go [name] = letrec' name $ \addr ->
+        subtermValue namespaceBody *> makeNamespace name addr
+      go (name:xs) = letrec' name $ \addr ->
+        go xs <* makeNamespace name addr
+
+      makeNamespace name addr = do
+        namespaceEnv <- Env.head <$> getEnv
+        v <- namespace name namespaceEnv
+        v <$ assign addr v
+      letrec' name body = do
+        addr <- lookupOrAlloc name
+        v <- localEnv id (body addr)
+        v <$ modifyEnv (insert name addr)
 
 data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] }
   deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

src/Prologue.hs

@@ -10,64 +10,48 @@ module Prologue
 import Data.Bifunctor.Join as X
 import Data.Bits as X
 import Data.ByteString as X (ByteString)
-import Data.Functor.Both as X (Both, runBothWith, both)
+import Data.Functor.Both as X (Both, both, runBothWith)
 import Data.IntMap as X (IntMap)
 import Data.IntSet as X (IntSet)
-import Data.Ix as X (Ix(..))
+import Data.Ix as X (Ix (..))
+import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty, some1)
 import Data.Map as X (Map)
-import Data.Monoid (Alt(..))
 import Data.Maybe as X
+import Data.Monoid (Alt (..))
 import Data.Sequence as X (Seq)
 import Data.Set as X (Set)
 import Data.Text as X (Text)
 import Data.These as X
 import Data.Union as X
-import Data.List.NonEmpty as X (
-    NonEmpty(..)
-  , nonEmpty
-  , some1
-  )
 
 import Debug.Trace as X
 
-import Control.Exception as X hiding (
-    evaluate
-  , throw
-  , throwIO
-  , throwTo
-  , assert
-  , Handler(..)
-  )
+import Control.Exception as X hiding (Handler (..), assert, evaluate, throw, throwIO, throwTo)
 
 -- Typeclasses
 import Control.Applicative as X
 import Control.Arrow as X ((&&&), (***))
 import Control.Monad as X hiding (fail, return, unless, when)
-import Control.Monad.Except as X (MonadError(..))
-import Control.Monad.Fail as X (MonadFail(..))
+import Control.Monad.Except as X (MonadError (..))
+import Control.Monad.Fail as X (MonadFail (..))
 import Data.Algebra as X
 import Data.Align.Generic as X (GAlign)
 import Data.Bifoldable as X
-import Data.Bifunctor as X (Bifunctor(..))
+import Data.Bifunctor as X (Bifunctor (..))
 import Data.Bitraversable as X
-import Data.Foldable as X hiding (product , sum)
-import Data.Functor as X (($>), void)
+import Data.Foldable as X hiding (product, sum)
 import Data.Function as X (fix, on, (&))
+import Data.Functor as X (void, ($>))
 import Data.Functor.Classes as X
 import Data.Functor.Classes.Generic as X
-import Data.Functor.Foldable as X (Base, Recursive(..), Corecursive(..))
+import Data.Functor.Foldable as X (Base, Corecursive (..), Recursive (..))
+import Data.Hashable as X (Hashable, hash, hashUsing, hashWithSalt)
 import Data.Mergeable as X (Mergeable)
-import Data.Monoid as X (Monoid(..), First(..), Last(..))
-import Data.Proxy as X (Proxy(..))
-import Data.Semigroup as X (Semigroup(..))
+import Data.Monoid as X (First (..), Last (..), Monoid (..))
+import Data.Proxy as X (Proxy (..))
+import Data.Semigroup as X (Semigroup (..))
 import Data.Traversable as X
 import Data.Typeable as X (Typeable)
-import Data.Hashable as X (
-    Hashable
-  , hash
-  , hashWithSalt
-  , hashUsing
-  )
 
 -- Generics
 import GHC.Generics as X hiding (moduleName)

src/Rendering/Imports.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Rendering.Imports
 ( renderToImports
 , ImportSummary(..)

src/Rendering/Symbol.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Rendering.Symbol
 ( renderSymbolTerms
 , renderToSymbols

test/Analysis/Go/Spec.hs

@@ -3,6 +3,7 @@ module Analysis.Go.Spec (spec) where
 
 import Data.Abstract.Value
 import Data.Map
+import Data.Either
 
 import SpecHelpers
 

test/Analysis/PHP/Spec.hs

@@ -3,29 +3,41 @@ module Analysis.PHP.Spec (spec) where
 
 import Data.Abstract.Value
 import Data.Map
+import Data.Map.Monoidal as Map
 
 import SpecHelpers
 
 
 spec :: Spec
 spec = parallel $ do
-  describe "evalutes PHP" $ do
-    it "include and require" $ do
+  describe "PHP" $ do
+    it "evaluates include and require" $ do
       env <- evaluate "main.php"
-      let expectedEnv = [ (qualifiedName ["foo"], addr 0)
-                        , (qualifiedName ["bar"], addr 1) ]
-      env `shouldBe` expectedEnv
+      env `shouldBe` [ (name "foo", addr 0)
+                     , (name "bar", addr 1) ]
 
-    it "include_once and require_once" $ do
+    it "evaluates include_once and require_once" $ do
       env <- evaluate "main_once.php"
-      let expectedEnv = [ (qualifiedName ["foo"], addr 0)
-                        , (qualifiedName ["bar"], addr 1) ]
-      env `shouldBe` expectedEnv
+      env `shouldBe` [ (name "foo", addr 0)
+                     , (name "bar", addr 1) ]
+
+    it "evaluates namespaces" $ do
+      ((_, env), Heap heap) <- evaluate' "namespaces.php"
+      env `shouldBe` [ (name "NS1", addr 0)
+                     , (name "Foo", addr 6) ]
+      Map.lookup (Precise 0) heap `shouldBe` ns "NS1" [ (name "Sub1", addr 1)
+                                                      , (name "b", addr 4)
+                                                      , (name "c", addr 5)
+                                                      ]
+      Map.lookup (Precise 1) heap `shouldBe` ns "Sub1" [ (name "Sub2", addr 2) ]
+      Map.lookup (Precise 2) heap `shouldBe` ns "Sub2" [ (name "f", addr 3) ]
 
   where
+    ns n = Just . Latest . Just . injValue . Namespace (name n)
     addr = Address . Precise
     fixtures = "test/fixtures/php/analysis/"
-    evaluate entry = snd . fst . fst . fst . fst <$>
+    evaluate entry = snd . fst <$> evaluate' entry
+    evaluate' entry = fst . fst . fst <$>
       evaluateFiles phpParser
       [ fixtures <> entry
       , fixtures <> "foo.php"

test/Analysis/Python/Spec.hs

@@ -36,11 +36,11 @@ spec = parallel $ do
 
     it "subclasses" $ do
       res <- evaluate' "subclass.py"
-      fst res `shouldBe` Right (injValue (String "\"bar\""))
+      join (fst res) `shouldBe` Right (injValue (String "\"bar\""))
 
     it "handles multiple inheritance left-to-right" $ do
       res <- evaluate' "multiple_inheritance.py"
-      fst res `shouldBe` Right (injValue (String "\"foo!\""))
+      join (fst res) `shouldBe` Right (injValue (String "\"foo!\""))
 
   where
     addr = Address . Precise

test/Analysis/Ruby/Spec.hs

@@ -30,7 +30,7 @@ spec = parallel $ do
 
     it "subclass" $ do
       res <- evaluate' "subclass.rb"
-      fst res `shouldBe` Right (injValue (String "\"<bar>\""))
+      join (fst res) `shouldBe` Right (injValue (String "\"<bar>\""))
 
     it "has prelude" $ do
       res <- evaluate' "preluded.rb"

test/Data/Functor/Listable.hs

@@ -156,7 +156,7 @@ instance Listable1 f => Listable2 (FreeF f) where
 instance (Listable1 f, Listable a) => Listable1 (FreeF f a) where
   liftTiers = liftTiers2 tiers
 
-instance (Functor f, Listable1 f) => Listable1 (Free.Free f) where
+instance Listable1 f => Listable1 (Free.Free f) where
   liftTiers pureTiers = go
     where go = liftCons1 (liftTiers2 pureTiers go) free
           free (FreeF.Free f) = Free.Free f

test/Doctests.hs

@@ -12,13 +12,16 @@ main = do
 
 extensions :: [String]
 extensions =
-  [ "DeriveFoldable"
+  [ "DataKinds"
+  , "DeriveFoldable"
   , "DeriveFunctor"
   , "DeriveGeneric"
   , "DeriveTraversable"
   , "FlexibleContexts"
   , "FlexibleInstances"
+  , "MultiParamTypeClasses"
   , "OverloadedStrings"
   , "RecordWildCards"
+  , "StandaloneDeriving"
   , "StrictData"
   ]

test/SpecHelpers.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators, TypeApplications #-}
+{-# LANGUAGE GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators, TypeApplications #-}
 module SpecHelpers (
   module X
 , diffFilePaths
@@ -34,6 +34,7 @@ import Data.Functor.Both as X (Both, runBothWith, both)
 import Data.Maybe as X
 import Data.Monoid as X (Monoid(..), First(..), Last(..))
 import Data.Semigroup as X (Semigroup(..))
+import Control.Monad as X
 
 import Test.Hspec as X (Spec, SpecWith, context, describe, it, xit, parallel, pendingWith, around, runIO)
 import Test.Hspec.Expectations.Pretty as X

test/fixtures/php/analysis/namespaces.php

@@ -0,0 +1,28 @@
+<?php
+
+namespace NS1\Sub1\Sub2
+{
+  function f() {
+    return 1;
+  }
+}
+
+namespace NS1
+{
+  function b() {
+    return "hi";
+  }
+}
+namespace NS1
+{
+  function c() {
+    return "x";
+  }
+}
+
+namespace Foo
+{
+  \NS1\Sub1\Sub2\f();
+  \NS1\b();
+  \NS1\c();
+}

vendor/effects

@@ -1 +1 @@
-Subproject commit 6aaaa39f18f38628a91d3ffd155c7f4099131d9e
+Subproject commit 7d4525db7b6a12c0a34da5f70a97db137c144c60

vendor/ghc-mod

@@ -1 +0,0 @@
-Subproject commit 7fb380dae0ae877a24ac8258fcd193cd6256a171