Analysis effects

.ghci.sample

@@ -1,10 +1,8 @@
 -- Consider copying this to your ~/.ghc/ghci.conf file:
 
 -- Pretty-printing
-:set -ignore-package pretty-simple -package pretty-simple
-:def! pretty \ _ -> pure ":set -interactive-print Text.Pretty.Simple.pPrint"
-:def! no-pretty \ _ -> pure ":set -interactive-print System.IO.print"
-:def! r \_ -> pure ":reload\n:pretty"
+:set -package-id prtty-smpl-3.1.1.0-c89f0500
+:set -interactive-print Text.Pretty.Simple.pPrint
 
 -- Turn on some language extensions you use a lot
 :seti -XFlexibleContexts -XOverloadedStrings -XTypeApplications
@@ -26,6 +24,3 @@
 
 -- Better typed holes
 :set -funclutter-valid-hole-fits -fabstract-refinement-hole-fits -frefinement-level-hole-fits=2
-
--- Enable pretty-printing immediately
-:pretty

.stylish-haskell.yaml

@@ -173,7 +173,7 @@ steps:
       #   `{-#LANGUAGE #-}'.
       #
       # Default: vertical.
-      style: compact
+      style: vertical
 
       # Align affects alignment of closing pragma brackets.
       #
@@ -183,7 +183,7 @@ steps:
       #   between actual import and closing bracket.
       #
       # Default: true
-      align: true
+      align: false
 
       # stylish-haskell can detect redundancy of some language pragmas. If this
       # is set to true, it will remove those redundant pragmas. Default: true.

script/ghci-flags

@@ -10,9 +10,6 @@ ghc_version="$(ghc --numeric-version)"
 # recent hie-bios requires us to output to the file at $HIE_BIOS_OUTPUT, but older builds & script/repl don’t set that var, so we default it to stdout
 output_file="${HIE_BIOS_OUTPUT:-/dev/stdout}"
 
-# do a build of dependencies up front to ensure they’re all available
-cabal v2-build -v0 all --only-dependencies
-
 build_products_dir="dist-newstyle/build/x86_64-osx/ghc-$ghc_version/build-repl"
 
 function flags {
@@ -43,6 +40,7 @@ function flags {
   echo "-isemantic-java/src"
   echo "-isemantic-json/src"
   echo "-isemantic-python/src"
+  echo "-isemantic-python/test"
   echo "-isemantic-ruby/src"
   echo "-isemantic-tags/src"
   echo "-iapp"

script/repl

@@ -6,5 +6,8 @@ set -e
 
 cd "$(dirname "$0")/.."
 
+# do a build of dependencies up front to ensure they’re all available
+cabal v2-build all --enable-benchmarks --enable-tests --only-dependencies
+
 # exec ghci with the appropriate flags, and without the $GHC_ENVIRONMENT variable interfering
 cabal v2-exec env -- -u GHC_ENVIRONMENT ghci -ghci-script=.ghci.repl $(script/ghci-flags) -no-ignore-dot-ghci $@

semantic-analysis/semantic-analysis.cabal

@@ -40,12 +40,19 @@ library
   import: common
   hs-source-dirs: src
   exposed-modules:
-    Analysis.Analysis
+    Analysis.Carrier.Env.Monovariant
+    Analysis.Carrier.Env.Precise
+    Analysis.Carrier.Heap.Monovariant
+    Analysis.Carrier.Heap.Precise
     Analysis.Concrete
+    Analysis.Effect.Domain
+    Analysis.Effect.Env
+    Analysis.Effect.Heap
     Analysis.File
     Analysis.FlowInsensitive
     Analysis.ImportGraph
-    Analysis.ScopeGraph
+    Analysis.Intro
+    Analysis.Name
     Analysis.Typecheck
     Control.Carrier.Fail.WithLoc
   build-depends:
@@ -62,3 +69,4 @@ library
     , semantic-source             ^>= 0
     , terminal-size               ^>= 0.3
     , text                        ^>= 1.2.3.1
+    , transformers                ^>= 0.5

semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+module Analysis.Carrier.Env.Monovariant
+( -- * Env carrier
+  EnvC(..)
+  -- * Env effect
+, module Analysis.Effect.Env
+) where
+
+import Analysis.Effect.Env
+import Analysis.Name
+import Control.Algebra
+import qualified Control.Monad.Fail as Fail
+
+newtype EnvC m a = EnvC { runEnv :: m a }
+  deriving (Applicative, Functor, Monad, Fail.MonadFail)
+
+instance Algebra sig m
+      => Algebra (Env Name :+: sig) (EnvC m) where
+  alg (L (Alloc name k))  = k name
+  alg (L (Bind _ _ m k))  = m >>= k
+  alg (L (Lookup name k)) = k (Just name)
+  alg (R other)           = EnvC (alg (handleCoercible other))

semantic-analysis/src/Analysis/Carrier/Env/Precise.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+module Analysis.Carrier.Env.Precise
+( -- * Env carrier
+  EnvC(..)
+  -- * Env effect
+, A.alloc
+, A.bind
+, A.lookupEnv
+, A.Env(..)
+) where
+
+import qualified Analysis.Effect.Env as A
+import Analysis.Name
+import Control.Algebra
+import Control.Effect.Fresh
+import Control.Effect.Reader
+import qualified Control.Monad.Fail as Fail
+import qualified Data.Map as Map
+
+type Precise = Int
+type Env = Map.Map Name Precise
+
+newtype EnvC m a = EnvC { runEnv :: m a }
+  deriving (Applicative, Functor, Monad, Fail.MonadFail)
+
+instance ( Has Fresh sig m
+         , Has (Reader Env) sig m
+         )
+      => Algebra (A.Env Precise :+: sig) (EnvC m) where
+  alg (L (A.Alloc _ k))          = fresh >>= k
+  alg (L (A.Bind name addr m k)) = local (Map.insert name addr) m >>= k
+  alg (L (A.Lookup name k))      = asks (Map.lookup name) >>= k
+  alg (R other)                  = EnvC (alg (handleCoercible other))

semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+module Analysis.Carrier.Heap.Monovariant
+( -- * Heap carrier
+  HeapC(..)
+  -- * Heap effect
+, module Analysis.Effect.Heap
+) where
+
+import Analysis.Effect.Heap
+import Control.Applicative (Alternative)
+import Control.Algebra
+import Control.Effect.State
+import Control.Monad ((>=>))
+import qualified Control.Monad.Fail as Fail
+import Data.List.NonEmpty (nonEmpty)
+import qualified Data.Map as Map
+import Data.Monoid (Alt(..))
+import qualified Data.Set as Set
+
+newtype HeapC addr value m a = HeapC { runHeap :: m a }
+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail)
+
+instance ( Alternative m
+         , Has (State (Map.Map addr (Set.Set value))) sig m
+         , Ord addr
+         , Ord value
+         )
+      => Algebra (Heap addr value :+: sig) (HeapC addr value m) where
+  alg (L (Deref  addr       k)) = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (getAlt . foldMap (Alt . pure . Just)) >>= k
+  alg (L (Assign addr value k)) = modify (Map.insertWith (<>) addr (Set.singleton value)) >> k
+  alg (R other)                 = HeapC (alg (handleCoercible other))

semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+module Analysis.Carrier.Heap.Precise
+( -- * Heap carrier
+  runHeap
+, HeapC(..)
+  -- * Heap effect
+, module Analysis.Effect.Heap
+) where
+
+import Analysis.Effect.Heap
+import Control.Algebra
+import Control.Carrier.State.Strict
+import qualified Control.Monad.Fail as Fail
+import qualified Data.IntMap as IntMap
+
+type Precise = Int
+
+runHeap :: HeapC value m a -> m (IntMap.IntMap value, a)
+runHeap (HeapC m) = runState mempty m
+
+newtype HeapC value m a = HeapC (StateC (IntMap.IntMap value) m a)
+  deriving (Applicative, Functor, Monad, Fail.MonadFail)
+
+instance (Algebra sig m, Effect sig)
+      => Algebra (Heap Precise value :+: State (IntMap.IntMap value) :+: sig) (HeapC value m) where
+  alg (L (Deref addr k))        = HeapC (gets (IntMap.lookup addr)) >>= k
+  alg (L (Assign addr value k)) = HeapC (modify (IntMap.insert addr value)) >> k
+  alg (R other)                 = HeapC (alg (handleCoercible other))