From 0115512f584d2eb65b1fb85f3d76e972194dff5b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 11:45:29 -0400
Subject: [PATCH 001/151] Simplify how we instantiate in unlam.

---
 semantic-core/src/Data/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 31f3912ca..3b2f2d76e 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -123,7 +123,7 @@ lams' :: (Foldable t, Carrier sig m, Member Core sig) => t User -> m User -> m U
 lams' names body = foldr lam' body names
 
 unlam :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
-unlam n (Term sig) | Just (Lam v b) <- prj sig = pure (Named v n, instantiate (const (pure n)) b)
+unlam n (Term sig) | Just (Lam v b) <- prj sig = pure (Named v n, instantiate1 (pure n) b)
 unlam _ _                                      = empty
 
 unseq :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)

From ebafd644d36af4dd3c39fdf08780a12333e09757 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 11:52:17 -0400
Subject: [PATCH 002/151] Move encloseIf back into Data.Core.Pretty.

---
 semantic-core/src/Data/Core/Pretty.hs | 4 ++++
 semantic-core/src/Data/Name.hs        | 5 -----
 2 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 92280c0fd..f53cb1aee 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -39,6 +39,10 @@ symbol  = annotate (Pretty.color Pretty.Yellow)
 strlit  = annotate (Pretty.colorDull Pretty.Green)
 primitive = keyword . mappend "#"
 
+encloseIf :: Monoid m => Bool -> m -> m -> m -> m
+encloseIf True  l r x = l <> x <> r
+encloseIf False _ _ x = x
+
 type Prec = Int
 
 data Style = Unicode | Ascii
diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs
index d7f644669..52dea6b19 100644
--- a/semantic-core/src/Data/Name.hs
+++ b/semantic-core/src/Data/Name.hs
@@ -10,7 +10,6 @@ module Data.Name
 , reservedNames
 , isSimpleCharacter
 , needsQuotation
-, encloseIf
 ) where
 
 import qualified Data.Char as Char
@@ -53,10 +52,6 @@ reservedNames = [ "#true", "#false", "let", "#frame", "if", "then", "else"
 needsQuotation :: User -> Bool
 needsQuotation u = HashSet.member (unpack u) reservedNames || Text.any (not . isSimpleCharacter) u
 
-encloseIf :: Monoid m => Bool -> m -> m -> m -> m
-encloseIf True  l r x = l <> x <> r
-encloseIf False _ _ x = x
-
 -- | A ‘simple’ character is, loosely defined, a character that is compatible
 -- with identifiers in most ASCII-oriented programming languages. This is defined
 -- as the alphanumeric set plus @$@ and @_@.

From de519912be333d38aba47adb09de630ed933ee0b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 11:53:09 -0400
Subject: [PATCH 003/151] Generalize encloseIf to any Semigroup.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index f53cb1aee..f0ee338b2 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -39,7 +39,7 @@ symbol  = annotate (Pretty.color Pretty.Yellow)
 strlit  = annotate (Pretty.colorDull Pretty.Green)
 primitive = keyword . mappend "#"
 
-encloseIf :: Monoid m => Bool -> m -> m -> m -> m
+encloseIf :: Semigroup m => Bool -> m -> m -> m -> m
 encloseIf True  l r x = l <> x <> r
 encloseIf False _ _ x = x
 

From 83cd9252639cb8c936eedbe4a174cd59396982e1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 12:03:50 -0400
Subject: [PATCH 004/151] Use Named to represent the binder.

---
 semantic-core/src/Analysis/Eval.hs    |  2 +-
 semantic-core/src/Data/Core.hs        | 10 +++++-----
 semantic-core/src/Data/Core/Pretty.hs |  6 +++---
 3 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index a90df3375..f588d4a2d 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -38,7 +38,7 @@ eval Analysis{..} eval = \case
   Term c -> case c of
     Let n -> alloc n >>= bind n >> unit
     a :>> b -> eval a >> eval b
-    Lam (Ignored n) b -> abstract eval n (instantiate1 (pure n) b)
+    Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)
     f :$ a -> do
       f' <- eval f
       a' <- eval a
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 3b2f2d76e..3be6a6c6a 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -52,7 +52,7 @@ data Core f a
   = Let User
   -- | Sequencing without binding; analogous to '>>' or '*>'.
   | f a :>> f a
-  | Lam (Ignored User) (Scope () f a)
+  | Lam (Named (Scope () f a))
   -- | Function application; analogous to '$'.
   | f a :$ f a
   | Unit
@@ -85,7 +85,7 @@ deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Co
 instance RightModule Core where
   Let u     >>=* _ = Let u
   (a :>> b) >>=* f = (a >>= f) :>> (b >>= f)
-  Lam v b   >>=* f = Lam v (b >>=* f)
+  Lam b     >>=* f = Lam ((>>=* f) <$> b)
   (a :$ b)  >>=* f = (a >>= f) :$ (b >>= f)
   Unit      >>=* _ = Unit
   Bool b    >>=* _ = Bool b
@@ -111,7 +111,7 @@ instance (Carrier sig m, Member Core sig) => Semigroup (Block m a) where
   Block a <> Block b = Block (send (a :>> b))
 
 lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
-lam (Named u n) b = send (Lam u (bind1 n b))
+lam (Named u n) b = send (Lam (Named u (bind1 n b)))
 
 lam' :: (Carrier sig m, Member Core sig) => User -> m User -> m User
 lam' u = lam (named' u)
@@ -123,8 +123,8 @@ lams' :: (Foldable t, Carrier sig m, Member Core sig) => t User -> m User -> m U
 lams' names body = foldr lam' body names
 
 unlam :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
-unlam n (Term sig) | Just (Lam v b) <- prj sig = pure (Named v n, instantiate1 (pure n) b)
-unlam _ _                                      = empty
+unlam n (Term sig) | Just (Lam b) <- prj sig = pure (n <$ b, instantiate1 (pure n) (namedValue b))
+unlam _ _                                    = empty
 
 unseq :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
 unseq (Term sig) | Just (a :>> b) <- prj sig = pure (a, b)
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index f0ee338b2..f913fb318 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -77,8 +77,8 @@ prettyCore style = run . runReader @Prec 0 . go
 
               pure . Pretty.align $ encloseIf (12 > prec) open close (Pretty.align body)
 
-            Lam n f -> inParens 11 $ do
-              (x, body) <- bind n f
+            Lam f -> inParens 11 $ do
+              (x, body) <- bind f
               pure (lambda <> name x <+> arrow <+> body)
 
             Frame    -> pure $ primitive "frame"
@@ -109,7 +109,7 @@ prettyCore style = run . runReader @Prec 0 . go
 
             -- Annotations are not pretty-printed, as it lowers the signal/noise ratio too profoundly.
             Ann _ c -> go c
-          where bind (Ignored x) f = (,) x <$> go (instantiate1 (pure x) f)
+          where bind (Named (Ignored x) f) = (,) x <$> go (instantiate1 (pure x) f)
         lambda = case style of
           Unicode -> symbol "λ"
           Ascii   -> symbol "\\"

From 218c8f3ba0a969101f654cf1a2ba08f313350006 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 12:18:48 -0400
Subject: [PATCH 005/151] Define records of simultaneously-bound fields.

---
 semantic-core/src/Analysis/Eval.hs    | 1 +
 semantic-core/src/Data/Core.hs        | 5 ++++-
 semantic-core/src/Data/Core/Pretty.hs | 5 +++++
 3 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index f588d4a2d..1bef13815 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -52,6 +52,7 @@ eval Analysis{..} eval = \case
     Load p -> eval p >>= asString >> unit -- FIXME: add a load command or something
     Edge e a -> ref a >>= edge e >> unit
     Frame -> frame
+    Record _ -> frame -- FIXME: evaluate the body of the record
     a :. b -> do
       a' <- ref a
       a' ... eval b
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 3be6a6c6a..eda66cabc 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -35,7 +35,7 @@ import Control.Applicative (Alternative (..))
 import Control.Effect.Carrier
 import Control.Monad.Module
 import Data.Foldable (foldl')
-import Data.List.NonEmpty
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.Loc
 import Data.Name
 import Data.Scope
@@ -64,6 +64,8 @@ data Core f a
   | Edge Edge (f a)
   -- | Allocation of a new frame.
   | Frame
+  -- | A record holding simultaneously-bound, potentially mutually-recursive definitions.
+  | Record [Named (Scope Int f a)]
   | f a :. f a
   -- | Assignment of a value to the reference returned by the lhs.
   | f a := f a
@@ -94,6 +96,7 @@ instance RightModule Core where
   Load b    >>=* f = Load (b >>= f)
   Edge e b  >>=* f = Edge e (b >>= f)
   Frame     >>=* _ = Frame
+  Record fs >>=* f = Record (map (fmap (>>=* f)) fs)
   (a :. b)  >>=* f = (a >>= f) :. (b >>= f)
   (a := b)  >>=* f = (a >>= f) := (b >>= f)
   Ann l b   >>=* f = Ann l (b >>= f)
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index f913fb318..ba9156aad 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -18,6 +18,7 @@ import           Data.Text.Prettyprint.Doc (Pretty (..), annotate, softline, (<+
 import qualified Data.Text.Prettyprint.Doc as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
+import           Data.Traversable (for)
 
 showCore :: Term Core User -> String
 showCore = Pretty.renderString . Pretty.layoutSmart Pretty.defaultLayoutOptions . Pretty.unAnnotate . prettyCore Ascii
@@ -81,6 +82,10 @@ prettyCore style = run . runReader @Prec 0 . go
               (x, body) <- bind f
               pure (lambda <> name x <+> arrow <+> body)
 
+            Record fs -> do
+              fs' <- for fs $ \ (Named (Ignored x) v) -> (name x <+> symbol "=" <+>) <$> go (instantiate (pure . namedName . (fs !!)) v)
+              pure $ Pretty.encloseSep Pretty.lbrace Pretty.rbrace Pretty.semi fs'
+
             Frame    -> pure $ primitive "frame"
             Unit     -> pure $ primitive "unit"
             Bool b   -> pure $ primitive (if b then "true" else "false")

From 00beb2dbcecdd9deaa881482d83ce9355e2b6244 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 12:31:00 -0400
Subject: [PATCH 006/151] Define a smart constructor for records.

---
 semantic-core/src/Data/Core.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index eda66cabc..177809486 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -23,6 +23,7 @@ module Data.Core
 , load
 , edge
 , frame
+, record
 , (...)
 , (.=)
 , ann
@@ -35,6 +36,7 @@ import Control.Applicative (Alternative (..))
 import Control.Effect.Carrier
 import Control.Monad.Module
 import Data.Foldable (foldl')
+import Data.List (elemIndex)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Loc
 import Data.Name
@@ -180,6 +182,10 @@ edge e b = send (Edge e b)
 frame :: (Carrier sig m, Member Core sig) => m a
 frame = send Frame
 
+record :: (Eq a, Carrier sig m, Member Core sig) => [(Named a, m a)] -> m a
+record fs = send (Record (map bind' fs))
+  where bind' (n, f) = bind (`elemIndex` map (namedValue . fst) fs) f <$ n
+
 (...) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
 a ... b = send (a :. b)
 

From e259bc0e914b58974d186d0433fc6da6eda52d23 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:03:31 -0400
Subject: [PATCH 007/151] Define a recursive binder.

---
 semantic-core/src/Analysis/Eval.hs    | 5 +++++
 semantic-core/src/Data/Core.hs        | 2 ++
 semantic-core/src/Data/Core/Pretty.hs | 3 +++
 3 files changed, 10 insertions(+)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 1bef13815..0e993697f 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -37,6 +37,11 @@ eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
   Term c -> case c of
     Let n -> alloc n >>= bind n >> unit
+    Rec (Named (Ignored n) b) -> do
+      addr <- alloc n
+      bind n addr
+      v <- eval (instantiate1 (pure n) b)
+      v <$ assign addr v
     a :>> b -> eval a >> eval b
     Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)
     f :$ a -> do
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 177809486..19e0bf085 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -52,6 +52,7 @@ data Edge = Lexical | Import
 
 data Core f a
   = Let User
+  | Rec (Named (Scope () f a))
   -- | Sequencing without binding; analogous to '>>' or '*>'.
   | f a :>> f a
   | Lam (Named (Scope () f a))
@@ -88,6 +89,7 @@ deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Co
 
 instance RightModule Core where
   Let u     >>=* _ = Let u
+  Rec b     >>=* f = Rec ((>>=* f) <$> b)
   (a :>> b) >>=* f = (a >>= f) :>> (b >>= f)
   Lam b     >>=* f = Lam ((>>=* f) <$> b)
   (a :$ b)  >>=* f = (a >>= f) :$ (b >>= f)
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index ba9156aad..7019342a4 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -66,6 +66,9 @@ prettyCore style = run . runReader @Prec 0 . go
           Var v -> pure (name v)
           Term t -> case t of
             Let a -> pure $ keyword "let" <+> name a
+            Rec b -> inParens 11 $ do
+              (x, body) <- bind b
+              pure (keyword "rec" <+> name x <+> symbol "=" <+> body)
             a :>> b -> do
               prec <- ask @Prec
               fore <- with 12 (go a)

From f373ca410f6eca6a87ddd6de10cf79ad05c2cc8f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:16:41 -0400
Subject: [PATCH 008/151] Define a smart constructor for recursive bindings.

---
 semantic-core/src/Data/Core.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 19e0bf085..a73fdba4e 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -4,6 +4,7 @@ module Data.Core
 ( Core(..)
 , Edge(..)
 , let'
+, rec
 , block
 , lam
 , lam'
@@ -109,6 +110,9 @@ instance RightModule Core where
 let' :: (Carrier sig m, Member Core sig) => User -> m a
 let' = send . Let
 
+rec :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
+rec (Named u n) b = send (Rec (Named u (bind1 n b)))
+
 block :: (Foldable t, Carrier sig m, Member Core sig) => t (m a) -> m a
 block = maybe unit getBlock . foldMap (Just . Block)
 

From 1398c995a079b2f1604f64c5edd816693d431155 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:21:39 -0400
Subject: [PATCH 009/151] Redefine records as a flat list of bindings.

---
 semantic-core/src/Data/Core.hs        | 10 ++++------
 semantic-core/src/Data/Core/Pretty.hs |  2 +-
 2 files changed, 5 insertions(+), 7 deletions(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index a73fdba4e..ddae5eb70 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -37,7 +37,6 @@ import Control.Applicative (Alternative (..))
 import Control.Effect.Carrier
 import Control.Monad.Module
 import Data.Foldable (foldl')
-import Data.List (elemIndex)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Loc
 import Data.Name
@@ -69,7 +68,7 @@ data Core f a
   -- | Allocation of a new frame.
   | Frame
   -- | A record holding simultaneously-bound, potentially mutually-recursive definitions.
-  | Record [Named (Scope Int f a)]
+  | Record [(User, f a)]
   | f a :. f a
   -- | Assignment of a value to the reference returned by the lhs.
   | f a := f a
@@ -101,7 +100,7 @@ instance RightModule Core where
   Load b    >>=* f = Load (b >>= f)
   Edge e b  >>=* f = Edge e (b >>= f)
   Frame     >>=* _ = Frame
-  Record fs >>=* f = Record (map (fmap (>>=* f)) fs)
+  Record fs >>=* f = Record (map (fmap (>>= f)) fs)
   (a :. b)  >>=* f = (a >>= f) :. (b >>= f)
   (a := b)  >>=* f = (a >>= f) := (b >>= f)
   Ann l b   >>=* f = Ann l (b >>= f)
@@ -188,9 +187,8 @@ edge e b = send (Edge e b)
 frame :: (Carrier sig m, Member Core sig) => m a
 frame = send Frame
 
-record :: (Eq a, Carrier sig m, Member Core sig) => [(Named a, m a)] -> m a
-record fs = send (Record (map bind' fs))
-  where bind' (n, f) = bind (`elemIndex` map (namedValue . fst) fs) f <$ n
+record :: (Carrier sig m, Member Core sig) => [(User, m a)] -> m a
+record fs = send (Record fs)
 
 (...) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
 a ... b = send (a :. b)
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 7019342a4..7c931f0bb 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -86,7 +86,7 @@ prettyCore style = run . runReader @Prec 0 . go
               pure (lambda <> name x <+> arrow <+> body)
 
             Record fs -> do
-              fs' <- for fs $ \ (Named (Ignored x) v) -> (name x <+> symbol "=" <+>) <$> go (instantiate (pure . namedName . (fs !!)) v)
+              fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
               pure $ Pretty.encloseSep Pretty.lbrace Pretty.rbrace Pretty.semi fs'
 
             Frame    -> pure $ primitive "frame"

From 2606e1eff101ec9b77dc21f975a28458d80aafd0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:26:08 -0400
Subject: [PATCH 010/151] :fire: a redundant where clause.

---
 semantic-core/src/Data/Core/Parser.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 41fd795b1..726d86c3f 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -93,7 +93,7 @@ lvalue = choice
 -- * Literals
 
 name :: (TokenParsing m, Monad m) => m (Named User)
-name = named' <$> identifier <?> "name" where
+name = named' <$> identifier <?> "name"
 
 lit :: (TokenParsing m, Monad m) => m (Term Core User)
 lit = let x `given` n = x <$ reserved n in choice

From 3459b3b058a12b5854f4473577f5b01ed48df732 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:28:48 -0400
Subject: [PATCH 011/151] Parse recursive bindings.

---
 semantic-core/src/Data/Core/Parser.hs | 4 ++++
 semantic-core/src/Data/Name.hs        | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 726d86c3f..ef752cfa9 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -60,6 +60,7 @@ atom = choice
   , edge
   , lit
   , ident
+  , rec
   , assign
   , parens expr
   ]
@@ -74,6 +75,9 @@ ifthenelse = Core.if'
   <* reserved "else" <*> core
   <?> "if-then-else statement"
 
+rec :: (TokenParsing m, Monad m) => m (Term Core User)
+rec = Core.rec <$ reserved "rec" <*> name <* symbolic '=' <*> core <?> "recursive binding"
+
 assign :: (TokenParsing m, Monad m) => m (Term Core User)
 assign = (Core..=) <$> try (lvalue <* symbolic '=') <*> core <?> "assignment"
 
diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs
index 52dea6b19..d5174bbdb 100644
--- a/semantic-core/src/Data/Name.hs
+++ b/semantic-core/src/Data/Name.hs
@@ -45,7 +45,7 @@ instance Ord (Ignored a) where compare _ _ = EQ
 
 reservedNames :: HashSet String
 reservedNames = [ "#true", "#false", "let", "#frame", "if", "then", "else"
-                , "lexical", "import", "#unit", "load"]
+                , "lexical", "import", "#unit", "load", "rec"]
 
 -- | Returns true if any character would require quotation or if the
 -- name conflicts with a Core primitive.

From 972a52dcbfd7070de5da36a6debee0f33da00b6e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:32:08 -0400
Subject: [PATCH 012/151] Prefix records during pretty-printing.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 7c931f0bb..3d2c282d6 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -87,7 +87,7 @@ prettyCore style = run . runReader @Prec 0 . go
 
             Record fs -> do
               fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
-              pure $ Pretty.encloseSep Pretty.lbrace Pretty.rbrace Pretty.semi fs'
+              pure $ primitive "record" <+> Pretty.encloseSep Pretty.lbrace Pretty.rbrace Pretty.semi fs'
 
             Frame    -> pure $ primitive "frame"
             Unit     -> pure $ primitive "unit"

From 79f573795deedfa6272468e33716ecd2b8c713f3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:36:22 -0400
Subject: [PATCH 013/151] Parse records.

---
 semantic-core/src/Data/Core/Parser.hs | 4 ++++
 semantic-core/src/Data/Name.hs        | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index ef752cfa9..5011dfc4e 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -105,10 +105,14 @@ lit = let x `given` n = x <$ reserved n in choice
   , Core.bool False `given` "#false"
   , Core.unit       `given` "#unit"
   , Core.frame      `given` "#frame"
+  , record
   , between (string "\"") (string "\"") (Core.string . fromString <$> many ('"' <$ string "\\\"" <|> noneOf "\""))
   , lambda
   ] <?> "literal"
 
+record :: (TokenParsing m, Monad m) => m (Term Core User)
+record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic '=' <*> core) semi)
+
 lambda :: (TokenParsing m, Monad m) => m (Term Core User)
 lambda = Core.lam <$ lambduh <*> name <* arrow <*> core <?> "lambda" where
   lambduh = symbolic 'λ' <|> symbolic '\\'
diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs
index d5174bbdb..d2bb8f2b7 100644
--- a/semantic-core/src/Data/Name.hs
+++ b/semantic-core/src/Data/Name.hs
@@ -45,7 +45,7 @@ instance Ord (Ignored a) where compare _ _ = EQ
 
 reservedNames :: HashSet String
 reservedNames = [ "#true", "#false", "let", "#frame", "if", "then", "else"
-                , "lexical", "import", "#unit", "load", "rec"]
+                , "lexical", "import", "#unit", "load", "rec", "#record"]
 
 -- | Returns true if any character would require quotation or if the
 -- name conflicts with a Core primitive.

From cbf9f431dda43d247210ccac9a0fd9e60cebdfb2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:44:54 -0400
Subject: [PATCH 014/151] Define a smart-constructor for :>>.

---
 semantic-core/src/Data/Core.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index ddae5eb70..751044e2c 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -5,6 +5,7 @@ module Data.Core
 , Edge(..)
 , let'
 , rec
+, (>>>)
 , block
 , lam
 , lam'
@@ -112,6 +113,9 @@ let' = send . Let
 rec :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
 rec (Named u n) b = send (Rec (Named u (bind1 n b)))
 
+(>>>) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
+a >>> b = send (a :>> b)
+
 block :: (Foldable t, Carrier sig m, Member Core sig) => t (m a) -> m a
 block = maybe unit getBlock . foldMap (Just . Block)
 

From 8c06d7bf0eda6001e3aef94bd4c84c5b6473430e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 14:58:31 -0400
Subject: [PATCH 015/151] Reintroduce assignment syntax.

---
 semantic-core/src/Analysis/Eval.hs    | 14 +++++++----
 semantic-core/src/Data/Core.hs        | 35 +++++++++++++++------------
 semantic-core/src/Data/Core/Pretty.hs | 15 ++++++++++++
 3 files changed, 43 insertions(+), 21 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 0e993697f..ef111a31b 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -43,6 +43,12 @@ eval Analysis{..} eval = \case
       v <- eval (instantiate1 (pure n) b)
       v <$ assign addr v
     a :>> b -> eval a >> eval b
+    Named (Ignored n) a :>>= b -> do
+      a' <- eval a
+      addr <- alloc n
+      bind n addr
+      assign addr a'
+      eval (instantiate1 (pure n) b)
     Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)
     f :$ a -> do
       f' <- eval f
@@ -119,11 +125,9 @@ prog4 = fromBody $ block
 
 prog5 :: File (Term Core User)
 prog5 = fromBody $ block
-  [ let' "mkPoint" .= lam' "_x" (lam' "_y" (block
-    [ let' "this" .= Core.frame
-    , pure "this" Core.... let' "x" .= pure "_x"
-    , pure "this" Core.... let' "y" .= pure "_y"
-    , pure "this"
+  [ let' "mkPoint" .= lam' "_x" (lam' "_y" (Core.record
+    [ ("x", pure "_x")
+    , ("y", pure "_y")
     ]))
   , let' "point" .= pure "mkPoint" $$ Core.bool True $$ Core.bool False
   , pure "point" Core.... pure "x"
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 751044e2c..c13c2f197 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -56,6 +56,7 @@ data Core f a
   | Rec (Named (Scope () f a))
   -- | Sequencing without binding; analogous to '>>' or '*>'.
   | f a :>> f a
+  | Named (f a) :>>= Scope () f a
   | Lam (Named (Scope () f a))
   -- | Function application; analogous to '$'.
   | f a :$ f a
@@ -77,6 +78,7 @@ data Core f a
   deriving (Foldable, Functor, Generic1, Traversable)
 
 infixr 1 :>>
+infixr 1 :>>=
 infixl 9 :$
 infixl 4 :.
 infix  3 :=
@@ -89,22 +91,23 @@ deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
 deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Core f a)
 
 instance RightModule Core where
-  Let u     >>=* _ = Let u
-  Rec b     >>=* f = Rec ((>>=* f) <$> b)
-  (a :>> b) >>=* f = (a >>= f) :>> (b >>= f)
-  Lam b     >>=* f = Lam ((>>=* f) <$> b)
-  (a :$ b)  >>=* f = (a >>= f) :$ (b >>= f)
-  Unit      >>=* _ = Unit
-  Bool b    >>=* _ = Bool b
-  If c t e  >>=* f = If (c >>= f) (t >>= f) (e >>= f)
-  String s  >>=* _ = String s
-  Load b    >>=* f = Load (b >>= f)
-  Edge e b  >>=* f = Edge e (b >>= f)
-  Frame     >>=* _ = Frame
-  Record fs >>=* f = Record (map (fmap (>>= f)) fs)
-  (a :. b)  >>=* f = (a >>= f) :. (b >>= f)
-  (a := b)  >>=* f = (a >>= f) := (b >>= f)
-  Ann l b   >>=* f = Ann l (b >>= f)
+  Let u      >>=* _ = Let u
+  Rec b      >>=* f = Rec ((>>=* f) <$> b)
+  (a :>> b)  >>=* f = (a >>= f) :>> (b >>= f)
+  (a :>>= b) >>=* f = ((>>= f) <$> a) :>>= (b >>=* f)
+  Lam b      >>=* f = Lam ((>>=* f) <$> b)
+  (a :$ b)   >>=* f = (a >>= f) :$ (b >>= f)
+  Unit       >>=* _ = Unit
+  Bool b     >>=* _ = Bool b
+  If c t e   >>=* f = If (c >>= f) (t >>= f) (e >>= f)
+  String s   >>=* _ = String s
+  Load b     >>=* f = Load (b >>= f)
+  Edge e b   >>=* f = Edge e (b >>= f)
+  Frame      >>=* _ = Frame
+  Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
+  (a :. b)   >>=* f = (a >>= f) :. (b >>= f)
+  (a := b)   >>=* f = (a >>= f) := (b >>= f)
+  Ann l b    >>=* f = Ann l (b >>= f)
 
 
 let' :: (Carrier sig m, Member Core sig) => User -> m a
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 3d2c282d6..d1aa497d6 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -81,6 +81,18 @@ prettyCore style = run . runReader @Prec 0 . go
 
               pure . Pretty.align $ encloseIf (12 > prec) open close (Pretty.align body)
 
+            Named (Ignored x) a :>>= b -> do
+              prec <- ask @Prec
+              fore <- with 12 (go a)
+              aft  <- with 12 (go (instantiate1 (pure x) b))
+
+              let open  = symbol ("{" <> softline)
+                  close = symbol (softline <> "}")
+                  separator = ";" <> Pretty.line
+                  body = name x <+> arrowL <+> fore <> separator <> aft
+
+              pure . Pretty.align $ encloseIf (12 > prec) open close (Pretty.align body)
+
             Lam f -> inParens 11 $ do
               (x, body) <- bind f
               pure (lambda <> name x <+> arrow <+> body)
@@ -124,6 +136,9 @@ prettyCore style = run . runReader @Prec 0 . go
         arrow = case style of
           Unicode -> symbol "→"
           Ascii   -> symbol "->"
+        arrowL = case style of
+          Unicode -> symbol "←"
+          Ascii   -> symbol "<-"
 
 
 appending :: Functor f => AnsiDoc -> f AnsiDoc -> f AnsiDoc

From a10cdc938023e2a91ed3e7d0f09903db30fe9e12 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 15:00:39 -0400
Subject: [PATCH 016/151] =?UTF-8?q?Use=20>>>=20to=20define=20Block?=
 =?UTF-8?q?=E2=80=99s=20Semigroup=20instance.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index c13c2f197..61eb9cad9 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -125,7 +125,7 @@ block = maybe unit getBlock . foldMap (Just . Block)
 newtype Block m a = Block { getBlock :: m a }
 
 instance (Carrier sig m, Member Core sig) => Semigroup (Block m a) where
-  Block a <> Block b = Block (send (a :>> b))
+  Block a <> Block b = Block (a >>> b)
 
 lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
 lam (Named u n) b = send (Lam (Named u (bind1 n b)))

From 15a125ba3bd8bd272b0b5bc121b40661dc0d2fe2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 15:01:01 -0400
Subject: [PATCH 017/151] Give fixity & precedence for >>>.

---
 semantic-core/src/Data/Core.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 61eb9cad9..f1984d75f 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -119,6 +119,8 @@ rec (Named u n) b = send (Rec (Named u (bind1 n b)))
 (>>>) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
 a >>> b = send (a :>> b)
 
+infixr 1 >>>
+
 block :: (Foldable t, Carrier sig m, Member Core sig) => t (m a) -> m a
 block = maybe unit getBlock . foldMap (Just . Block)
 

From 6f5e578d0f9ff3fea6b278d6f361a300e3011a83 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 15:04:27 -0400
Subject: [PATCH 018/151] Define a smart constructor for local bindings.

---
 semantic-core/src/Data/Core.hs | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index f1984d75f..5d77bd7e0 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -7,6 +7,8 @@ module Data.Core
 , rec
 , (>>>)
 , block
+, (>>>=)
+, (:<-)(..)
 , lam
 , lam'
 , lams
@@ -129,6 +131,15 @@ newtype Block m a = Block { getBlock :: m a }
 instance (Carrier sig m, Member Core sig) => Semigroup (Block m a) where
   Block a <> Block b = Block (a >>> b)
 
+(>>>=) :: (Eq a, Carrier sig m, Member Core sig) => (Named a :<- m a) -> m a -> m a
+Named u n :<- a >>>= b = send (Named u a :>>= bind1 n b)
+
+infixr 1 >>>=
+
+data a :<- b = a :<- b
+  deriving (Eq, Ord, Show)
+
+
 lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
 lam (Named u n) b = send (Lam (Named u (bind1 n b)))
 

From e809a2935be5f5a89221131f87d2cd666c5610a5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 15:06:27 -0400
Subject: [PATCH 019/151] :memo: :>>=.

---
 semantic-core/src/Data/Core.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 5d77bd7e0..70443858e 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -58,6 +58,7 @@ data Core f a
   | Rec (Named (Scope () f a))
   -- | Sequencing without binding; analogous to '>>' or '*>'.
   | f a :>> f a
+  -- | Sequencing with binding; analogous to '>>='.
   | Named (f a) :>>= Scope () f a
   | Lam (Named (Scope () f a))
   -- | Function application; analogous to '$'.

From 38efb33327d5ceb07a5a782ec862a5aa459d66b1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 15:19:34 -0400
Subject: [PATCH 020/151] Move unseq & unseqs up under >>>.

---
 semantic-core/src/Data/Core.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 70443858e..add6e3037 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -132,6 +132,16 @@ newtype Block m a = Block { getBlock :: m a }
 instance (Carrier sig m, Member Core sig) => Semigroup (Block m a) where
   Block a <> Block b = Block (a >>> b)
 
+unseq :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
+unseq (Term sig) | Just (a :>> b) <- prj sig = pure (a, b)
+unseq _                                      = empty
+
+unseqs :: Member Core sig => Term sig a -> NonEmpty (Term sig a)
+unseqs = go
+  where go t = case unseq t of
+          Just (l, r) -> go l <> go r
+          Nothing     -> t :| []
+
 (>>>=) :: (Eq a, Carrier sig m, Member Core sig) => (Named a :<- m a) -> m a -> m a
 Named u n :<- a >>>= b = send (Named u a :>>= bind1 n b)
 
@@ -157,16 +167,6 @@ unlam :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a ->
 unlam n (Term sig) | Just (Lam b) <- prj sig = pure (n <$ b, instantiate1 (pure n) (namedValue b))
 unlam _ _                                    = empty
 
-unseq :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
-unseq (Term sig) | Just (a :>> b) <- prj sig = pure (a, b)
-unseq _                                      = empty
-
-unseqs :: Member Core sig => Term sig a -> NonEmpty (Term sig a)
-unseqs = go
-  where go t = case unseq t of
-          Just (l, r) -> go l <> go r
-          Nothing     -> t :| []
-
 ($$) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
 f $$ a = send (f :$ a)
 

From ef24642f266d687a964344692dc237496c1abe8c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 15:25:33 -0400
Subject: [PATCH 021/151] Give fixity & precedence for :<-.

---
 semantic-core/src/Data/Core.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index add6e3037..f2f516316 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -150,6 +150,8 @@ infixr 1 >>>=
 data a :<- b = a :<- b
   deriving (Eq, Ord, Show)
 
+infix 2 :<-
+
 
 lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
 lam (Named u n) b = send (Lam (Named u (bind1 n b)))

From bff499e9349e8e9ae90bcaecc84075abe2f18737 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 15:31:19 -0400
Subject: [PATCH 022/151] :memo: :..

---
 semantic-core/src/Data/Core.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index f2f516316..5dae5283e 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -74,6 +74,7 @@ data Core f a
   | Frame
   -- | A record holding simultaneously-bound, potentially mutually-recursive definitions.
   | Record [(User, f a)]
+  -- | Projection from a record.
   | f a :. f a
   -- | Assignment of a value to the reference returned by the lhs.
   | f a := f a

From f24ef8b0a48851dc1327397093ea84a247c687bb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 19 Jul 2019 15:31:47 -0400
Subject: [PATCH 023/151] Correct the docs for Record.

---
 semantic-core/src/Data/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 5dae5283e..5ee2f59dc 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -72,7 +72,7 @@ data Core f a
   | Edge Edge (f a)
   -- | Allocation of a new frame.
   | Frame
-  -- | A record holding simultaneously-bound, potentially mutually-recursive definitions.
+  -- | A record mapping some keys to some values.
   | Record [(User, f a)]
   -- | Projection from a record.
   | f a :. f a

From b5a06248539db771da95049e7f0ff48d838a6ac9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 09:42:09 -0400
Subject: [PATCH 024/151] :fire: redundant parens.

---
 semantic-core/src/Analysis/Eval.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index ef111a31b..dd1442cf8 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -157,7 +157,7 @@ ruby = fromBody . ann . block $
       ]))))
 
   , ann (let' "(Object)" .= Core.frame)
-  , ann (pure "(Object)" Core.... ann (Core.edge Import (pure ("Class"))))
+  , ann (pure "(Object)" Core.... ann (Core.edge Import (pure "Class")))
   , ann (let' "Object" .= Core.frame)
   , ann (pure "Object" Core.... block
     [ ann (Core.edge Import (pure "(Object)"))

From db448e6847ede74c038b216ba8f045fd3deeb3f5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:07:27 -0400
Subject: [PATCH 025/151] :fire: Let & Frame.

---
 semantic-core/src/Analysis/Eval.hs    | 142 +++++++++++---------------
 semantic-core/src/Data/Core.hs        |  15 +--
 semantic-core/src/Data/Core/Parser.hs |   4 +-
 semantic-core/src/Data/Core/Pretty.hs |   2 -
 semantic-core/src/Data/Name.hs        |   2 +-
 5 files changed, 62 insertions(+), 103 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index dd1442cf8..0ef3668fb 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -36,7 +36,6 @@ eval :: ( Carrier sig m
 eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
   Term c -> case c of
-    Let n -> alloc n >>= bind n >> unit
     Rec (Named (Ignored n) b) -> do
       addr <- alloc n
       bind n addr
@@ -62,7 +61,6 @@ eval Analysis{..} eval = \case
     String s -> string s
     Load p -> eval p >>= asString >> unit -- FIXME: add a load command or something
     Edge e a -> ref a >>= edge e >> unit
-    Frame -> frame
     Record _ -> frame -- FIXME: evaluate the body of the record
     a :. b -> do
       a' <- ref a
@@ -82,9 +80,6 @@ eval Analysis{..} eval = \case
         ref = \case
           Var n -> lookupEnv' n
           Term c -> case c of
-            Let n -> do
-              addr <- alloc n
-              addr <$ bind n addr
             If c t e -> do
               c' <- eval c >>= asBool
               if c' then ref t else ref e
@@ -96,13 +91,11 @@ eval Analysis{..} eval = \case
 
 
 prog1 :: File (Term Core User)
-prog1 = fromBody . lam' foo $ block
-  [ let' bar .= pure foo
-  , Core.if' (pure bar)
+prog1 = fromBody $ lam' "foo"
+  (    named' "bar" :<- pure "foo"
+  >>>= Core.if' (pure "bar")
     (Core.bool False)
-    (Core.bool True)
-  ]
-  where (foo, bar) = ("foo", "bar")
+    (Core.bool True))
 
 prog2 :: File (Term Core User)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
@@ -115,106 +108,89 @@ prog3 = fromBody $ lams' [foo, bar, quux]
   where (foo, bar, quux) = ("foo", "bar", "quux")
 
 prog4 :: File (Term Core User)
-prog4 = fromBody $ block
-  [ let' foo .= Core.bool True
-  , Core.if' (pure foo)
+prog4 = fromBody
+  (    named' "foo" :<- Core.bool True
+  >>>= Core.if' (pure "foo")
     (Core.bool True)
-    (Core.bool False)
-  ]
-  where foo = "foo"
+    (Core.bool False))
 
 prog5 :: File (Term Core User)
-prog5 = fromBody $ block
-  [ let' "mkPoint" .= lam' "_x" (lam' "_y" (Core.record
+prog5 = fromBody
+  (    named' "mkPoint" :<- lam' "_x" (lam' "_y" (Core.record
     [ ("x", pure "_x")
     , ("y", pure "_y")
     ]))
-  , let' "point" .= pure "mkPoint" $$ Core.bool True $$ Core.bool False
-  , pure "point" Core.... pure "x"
-  , pure "point" Core.... pure "y" .= pure "point" Core.... pure "x"
-  ]
+  >>>= named' "point" :<- pure "mkPoint" $$ Core.bool True $$ Core.bool False
+  >>>= pure "point" Core.... pure "x"
+  >>>  pure "point" Core.... pure "y" .= pure "point" Core.... pure "x")
 
 prog6 :: [File (Term Core User)]
 prog6 =
-  [ File (Loc "dep"  (locSpan (fromJust here))) $ block
-    [ let' "dep" .= Core.frame
-    , pure "dep" Core.... (let' "var" .= Core.bool True)
-    ]
+  [ File (Loc "dep"  (locSpan (fromJust here))) $ record
+    [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
   , File (Loc "main" (locSpan (fromJust here))) $ block
     [ load (Core.string "dep")
-    , let' "thing" .= pure "dep" Core.... pure "var"
+    , record [ ("thing", pure "dep" Core.... pure "var") ]
     ]
   ]
 
 ruby :: File (Term Core User)
-ruby = fromBody . ann . block $
-  [ ann (let' "Class" .= Core.frame)
-  , ann (pure "Class" Core....
-    (ann (let' "new" .= lam' "self" (block
-      [ ann (let' "instance" .= Core.frame)
-      , ann (pure "instance" Core.... Core.edge Import (pure "self"))
-      , ann (pure "instance" $$$ "initialize")
-      ]))))
-
-  , ann (let' "(Object)" .= Core.frame)
-  , ann (pure "(Object)" Core.... ann (Core.edge Import (pure "Class")))
-  , ann (let' "Object" .= Core.frame)
-  , ann (pure "Object" Core.... block
-    [ ann (Core.edge Import (pure "(Object)"))
-    , ann (let' "nil?" .= lam' "_" false)
-    , ann (let' "initialize" .= lam' "self" (pure "self"))
-    , ann (let' __semantic_truthy .= lam' "_" (Core.bool True))
+ruby = fromBody . ann $ record
+  [ ("Class", Core.record
+    [ (__semantic_super, pure "Object")
+    , ("new", lam' "self"
+      (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
+      >>>= pure "instance" $$$ "initialize"))
     ])
 
-  , ann (pure "Class" Core.... Core.edge Import (pure "Object"))
-
-  , ann (let' "(NilClass)" .= Core.frame)
-  , ann (pure "(NilClass)" Core.... block
-    [ ann (Core.edge Import (pure "Class"))
-    , ann (Core.edge Import (pure "(Object)"))
-    ])
-  , ann (let' "NilClass" .= Core.frame)
-  , ann (pure "NilClass" Core.... block
-    [ ann (Core.edge Import (pure "(NilClass)"))
-    , ann (Core.edge Import (pure "Object"))
-    , ann (let' "nil?" .= lam' "_" true)
-    , ann (let' __semantic_truthy .= lam' "_" (Core.bool False))
+  , ("(Object)", Core.record [ (__semantic_super, pure "Class") ])
+  , ("Object", Core.record
+    [ (__semantic_super, pure "(Object)")
+    , ("nil?", lam' "_" (pure "false"))
+    , ("initialize", lam' "self" (pure "self"))
+    , (__semantic_truthy, lam' "_" (Core.bool True))
     ])
 
-  , ann (let' "(TrueClass)" .= Core.frame)
-  , ann (pure "(TrueClass)" Core.... block
-    [ ann (Core.edge Import (pure "Class"))
-    , ann (Core.edge Import (pure "(Object)"))
+  , ("(NilClass)", Core.record
+    -- FIXME: what should we do about multiple import edges like this
+    [ (__semantic_super, pure "Class")
+    , (__semantic_super, pure "(Object)")
     ])
-  , ann (let' "TrueClass" .= Core.frame)
-  , ann (pure "TrueClass" Core.... block
-    [ ann (Core.edge Import (pure "(TrueClass)"))
-    , ann (Core.edge Import (pure "Object"))
+  , ("NilClass", Core.record
+    [ (__semantic_super, pure "(NilClass)")
+    , (__semantic_super, pure "Object")
+    , ("nil?", lam' "_" (pure "true"))
+    , (__semantic_truthy, lam' "_" (Core.bool False))
     ])
 
-  , ann (let' "(FalseClass)" .= Core.frame)
-  , ann (pure "(FalseClass)" Core.... block
-    [ ann (Core.edge Import (pure "Class"))
-    , ann (Core.edge Import (pure "(Object)"))
+  , ("(TrueClass)", Core.record
+    [ (__semantic_super, pure "Class")
+    , (__semantic_super, pure "(Object)")
     ])
-  , ann (let' "FalseClass" .= Core.frame)
-  , ann (pure "FalseClass" Core.... block
-    [ ann (Core.edge Import (pure "(FalseClass)"))
-    , ann (Core.edge Import (pure "Object"))
-    , ann (let' __semantic_truthy .= lam' "_" (Core.bool False))
+  , ("TrueClass", Core.record
+    [ (__semantic_super, pure "(TrueClass)")
+    , (__semantic_super, pure "Object")
     ])
 
-  , ann (let' "nil"   .= pure "NilClass"   $$$ "new")
-  , ann (let' "true"  .= pure "TrueClass"  $$$ "new")
-  , ann (let' "false" .= pure "FalseClass" $$$ "new")
+  , ("(FalseClass)", Core.record
+    [ (__semantic_super, pure "Class")
+    , (__semantic_super, pure "(Object)")
+    ])
+  , ("FalseClass", Core.record
+    [ (__semantic_super, pure "(FalseClass)")
+    , (__semantic_super, pure "Object")
+    , (__semantic_truthy, lam' "_" (Core.bool False))
+    ])
 
-  , ann (let' "require" .= lam' "path" (Core.load (pure "path")))
+  , ("nil"  , pure "NilClass"   $$$ "new")
+  , ("true" , pure "TrueClass"  $$$ "new")
+  , ("false", pure "FalseClass" $$$ "new")
+
+  , ("require", lam' "path" (Core.load (pure "path")))
   ]
-  where -- _nil  = pure "nil"
-        true  = pure "true"
-        false = pure "false"
-        self $$$ method = annWith callStack $ lam' "_x" (pure "_x" Core.... pure method $$ pure "_x") $$ self
+  where self $$$ method = annWith callStack $ lam' "_x" (pure "_x" Core.... pure method $$ pure "_x") $$ self
 
+        __semantic_super  = "__semantic_super"
         __semantic_truthy = "__semantic_truthy"
 
 
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 5ee2f59dc..696b08d33 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -3,7 +3,6 @@
 module Data.Core
 ( Core(..)
 , Edge(..)
-, let'
 , rec
 , (>>>)
 , block
@@ -26,7 +25,6 @@ module Data.Core
 , string
 , load
 , edge
-, frame
 , record
 , (...)
 , (.=)
@@ -54,8 +52,7 @@ data Edge = Lexical | Import
   deriving (Eq, Ord, Show)
 
 data Core f a
-  = Let User
-  | Rec (Named (Scope () f a))
+  = Rec (Named (Scope () f a))
   -- | Sequencing without binding; analogous to '>>' or '*>'.
   | f a :>> f a
   -- | Sequencing with binding; analogous to '>>='.
@@ -70,8 +67,6 @@ data Core f a
   -- | Load the specified file (by path).
   | Load (f a)
   | Edge Edge (f a)
-  -- | Allocation of a new frame.
-  | Frame
   -- | A record mapping some keys to some values.
   | Record [(User, f a)]
   -- | Projection from a record.
@@ -95,7 +90,6 @@ deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
 deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Core f a)
 
 instance RightModule Core where
-  Let u      >>=* _ = Let u
   Rec b      >>=* f = Rec ((>>=* f) <$> b)
   (a :>> b)  >>=* f = (a >>= f) :>> (b >>= f)
   (a :>>= b) >>=* f = ((>>= f) <$> a) :>>= (b >>=* f)
@@ -107,16 +101,12 @@ instance RightModule Core where
   String s   >>=* _ = String s
   Load b     >>=* f = Load (b >>= f)
   Edge e b   >>=* f = Edge e (b >>= f)
-  Frame      >>=* _ = Frame
   Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
   (a :. b)   >>=* f = (a >>= f) :. (b >>= f)
   (a := b)   >>=* f = (a >>= f) := (b >>= f)
   Ann l b    >>=* f = Ann l (b >>= f)
 
 
-let' :: (Carrier sig m, Member Core sig) => User -> m a
-let' = send . Let
-
 rec :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
 rec (Named u n) b = send (Rec (Named u (bind1 n b)))
 
@@ -208,9 +198,6 @@ load = send . Load
 edge :: (Carrier sig m, Member Core sig) => Edge -> m a -> m a
 edge e b = send (Edge e b)
 
-frame :: (Carrier sig m, Member Core sig) => m a
-frame = send Frame
-
 record :: (Carrier sig m, Member Core sig) => [(User, m a)] -> m a
 record fs = send (Record fs)
 
diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 5011dfc4e..a7494dafa 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -89,8 +89,7 @@ edge = kw <*> expr where kw = choice [ Core.edge Lexical <$ reserved "lexical"
 
 lvalue :: (TokenParsing m, Monad m) => m (Term Core User)
 lvalue = choice
-  [ Core.let' . namedValue <$ reserved "let" <*> name
-  , ident
+  [ ident
   , parens expr
   ]
 
@@ -104,7 +103,6 @@ lit = let x `given` n = x <$ reserved n in choice
   [ Core.bool True  `given` "#true"
   , Core.bool False `given` "#false"
   , Core.unit       `given` "#unit"
-  , Core.frame      `given` "#frame"
   , record
   , between (string "\"") (string "\"") (Core.string . fromString <$> many ('"' <$ string "\\\"" <|> noneOf "\""))
   , lambda
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index d1aa497d6..e1b55880b 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -65,7 +65,6 @@ prettyCore style = run . runReader @Prec 0 . go
   where go = \case
           Var v -> pure (name v)
           Term t -> case t of
-            Let a -> pure $ keyword "let" <+> name a
             Rec b -> inParens 11 $ do
               (x, body) <- bind b
               pure (keyword "rec" <+> name x <+> symbol "=" <+> body)
@@ -101,7 +100,6 @@ prettyCore style = run . runReader @Prec 0 . go
               fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
               pure $ primitive "record" <+> Pretty.encloseSep Pretty.lbrace Pretty.rbrace Pretty.semi fs'
 
-            Frame    -> pure $ primitive "frame"
             Unit     -> pure $ primitive "unit"
             Bool b   -> pure $ primitive (if b then "true" else "false")
             String s -> pure . strlit $ Pretty.viaShow s
diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs
index d2bb8f2b7..63d2c54a9 100644
--- a/semantic-core/src/Data/Name.hs
+++ b/semantic-core/src/Data/Name.hs
@@ -44,7 +44,7 @@ instance Ord (Ignored a) where compare _ _ = EQ
 
 
 reservedNames :: HashSet String
-reservedNames = [ "#true", "#false", "let", "#frame", "if", "then", "else"
+reservedNames = [ "#true", "#false", "if", "then", "else"
                 , "lexical", "import", "#unit", "load", "rec", "#record"]
 
 -- | Returns true if any character would require quotation or if the

From 1d50aecd9e9f8ee3475c1aa6f847865de9ce7d90 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:09:26 -0400
Subject: [PATCH 026/151] Define prog5 using lams.

---
 semantic-core/src/Analysis/Eval.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 0ef3668fb..4e8d68a6a 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -116,10 +116,10 @@ prog4 = fromBody
 
 prog5 :: File (Term Core User)
 prog5 = fromBody
-  (    named' "mkPoint" :<- lam' "_x" (lam' "_y" (Core.record
+  (    named' "mkPoint" :<- lams' ["_x", "_y"] (Core.record
     [ ("x", pure "_x")
     , ("y", pure "_y")
-    ]))
+    ])
   >>>= named' "point" :<- pure "mkPoint" $$ Core.bool True $$ Core.bool False
   >>>= pure "point" Core.... pure "x"
   >>>  pure "point" Core.... pure "y" .= pure "point" Core.... pure "x")

From 2a5c1818d1faa3c4409d6046a72bea201e2b6e1c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:12:48 -0400
Subject: [PATCH 027/151] :fire: lam'/lams'.

---
 semantic-core/src/Analysis/Eval.hs | 31 +++++++++++++++---------------
 semantic-core/src/Data/Core.hs     |  8 --------
 2 files changed, 15 insertions(+), 24 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 4e8d68a6a..e19c0e184 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -91,7 +91,7 @@ eval Analysis{..} eval = \case
 
 
 prog1 :: File (Term Core User)
-prog1 = fromBody $ lam' "foo"
+prog1 = fromBody $ lam (named' "foo")
   (    named' "bar" :<- pure "foo"
   >>>= Core.if' (pure "bar")
     (Core.bool False)
@@ -101,11 +101,10 @@ prog2 :: File (Term Core User)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
 
 prog3 :: File (Term Core User)
-prog3 = fromBody $ lams' [foo, bar, quux]
-  (Core.if' (pure quux)
-    (pure bar)
-    (pure foo))
-  where (foo, bar, quux) = ("foo", "bar", "quux")
+prog3 = fromBody $ lams [named' "foo", named' "bar", named' "quux"]
+  (Core.if' (pure "quux")
+    (pure "bar")
+    (pure "foo"))
 
 prog4 :: File (Term Core User)
 prog4 = fromBody
@@ -116,7 +115,7 @@ prog4 = fromBody
 
 prog5 :: File (Term Core User)
 prog5 = fromBody
-  (    named' "mkPoint" :<- lams' ["_x", "_y"] (Core.record
+  (    named' "mkPoint" :<- lams [named' "_x", named' "_y"] (Core.record
     [ ("x", pure "_x")
     , ("y", pure "_y")
     ])
@@ -138,7 +137,7 @@ ruby :: File (Term Core User)
 ruby = fromBody . ann $ record
   [ ("Class", Core.record
     [ (__semantic_super, pure "Object")
-    , ("new", lam' "self"
+    , ("new", lam (named' "self")
       (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
       >>>= pure "instance" $$$ "initialize"))
     ])
@@ -146,9 +145,9 @@ ruby = fromBody . ann $ record
   , ("(Object)", Core.record [ (__semantic_super, pure "Class") ])
   , ("Object", Core.record
     [ (__semantic_super, pure "(Object)")
-    , ("nil?", lam' "_" (pure "false"))
-    , ("initialize", lam' "self" (pure "self"))
-    , (__semantic_truthy, lam' "_" (Core.bool True))
+    , ("nil?", lam (named' "_") (pure "false"))
+    , ("initialize", lam (named' "self") (pure "self"))
+    , (__semantic_truthy, lam (named' "_") (Core.bool True))
     ])
 
   , ("(NilClass)", Core.record
@@ -159,8 +158,8 @@ ruby = fromBody . ann $ record
   , ("NilClass", Core.record
     [ (__semantic_super, pure "(NilClass)")
     , (__semantic_super, pure "Object")
-    , ("nil?", lam' "_" (pure "true"))
-    , (__semantic_truthy, lam' "_" (Core.bool False))
+    , ("nil?", lam (named' "_") (pure "true"))
+    , (__semantic_truthy, lam (named' "_") (Core.bool False))
     ])
 
   , ("(TrueClass)", Core.record
@@ -179,16 +178,16 @@ ruby = fromBody . ann $ record
   , ("FalseClass", Core.record
     [ (__semantic_super, pure "(FalseClass)")
     , (__semantic_super, pure "Object")
-    , (__semantic_truthy, lam' "_" (Core.bool False))
+    , (__semantic_truthy, lam (named' "_") (Core.bool False))
     ])
 
   , ("nil"  , pure "NilClass"   $$$ "new")
   , ("true" , pure "TrueClass"  $$$ "new")
   , ("false", pure "FalseClass" $$$ "new")
 
-  , ("require", lam' "path" (Core.load (pure "path")))
+  , ("require", lam (named' "path") (Core.load (pure "path")))
   ]
-  where self $$$ method = annWith callStack $ lam' "_x" (pure "_x" Core.... pure method $$ pure "_x") $$ self
+  where self $$$ method = annWith callStack $ lam (named' "_x") (pure "_x" Core.... pure method $$ pure "_x") $$ self
 
         __semantic_super  = "__semantic_super"
         __semantic_truthy = "__semantic_truthy"
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 696b08d33..762849881 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -9,9 +9,7 @@ module Data.Core
 , (>>>=)
 , (:<-)(..)
 , lam
-, lam'
 , lams
-, lams'
 , unlam
 , unseq
 , unseqs
@@ -147,15 +145,9 @@ infix 2 :<-
 lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
 lam (Named u n) b = send (Lam (Named u (bind1 n b)))
 
-lam' :: (Carrier sig m, Member Core sig) => User -> m User -> m User
-lam' u = lam (named' u)
-
 lams :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Named a) -> m a -> m a
 lams names body = foldr lam body names
 
-lams' :: (Foldable t, Carrier sig m, Member Core sig) => t User -> m User -> m User
-lams' names body = foldr lam' body names
-
 unlam :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
 unlam n (Term sig) | Just (Lam b) <- prj sig = pure (n <$ b, instantiate1 (pure n) (namedValue b))
 unlam _ _                                    = empty

From c175bc355333b3270d3b794ffc6db1600b16d181 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:18:02 -0400
Subject: [PATCH 028/151] Bind the global scope recursively.

---
 semantic-core/src/Analysis/Eval.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index e19c0e184..24c38ba49 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -134,7 +134,7 @@ prog6 =
   ]
 
 ruby :: File (Term Core User)
-ruby = fromBody . ann $ record
+ruby = fromBody . ann . rec (named' __semantic_global) $ record
   [ ("Class", Core.record
     [ (__semantic_super, pure "Object")
     , ("new", lam (named' "self")
@@ -189,6 +189,7 @@ ruby = fromBody . ann $ record
   ]
   where self $$$ method = annWith callStack $ lam (named' "_x") (pure "_x" Core.... pure method $$ pure "_x") $$ self
 
+        __semantic_global = "__semantic_global"
         __semantic_super  = "__semantic_super"
         __semantic_truthy = "__semantic_truthy"
 

From c9b328eff5fdba160e1e81b62daee2dae11d9076 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:18:17 -0400
Subject: [PATCH 029/151] :fire: a bunch of redundant prefixes.

---
 semantic-core/src/Analysis/Eval.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 24c38ba49..84df890f5 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -115,7 +115,7 @@ prog4 = fromBody
 
 prog5 :: File (Term Core User)
 prog5 = fromBody
-  (    named' "mkPoint" :<- lams [named' "_x", named' "_y"] (Core.record
+  (    named' "mkPoint" :<- lams [named' "_x", named' "_y"] (record
     [ ("x", pure "_x")
     , ("y", pure "_y")
     ])
@@ -126,7 +126,7 @@ prog5 = fromBody
 prog6 :: [File (Term Core User)]
 prog6 =
   [ File (Loc "dep"  (locSpan (fromJust here))) $ record
-    [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
+    [ ("dep", record [ ("var", Core.bool True) ]) ]
   , File (Loc "main" (locSpan (fromJust here))) $ block
     [ load (Core.string "dep")
     , record [ ("thing", pure "dep" Core.... pure "var") ]
@@ -135,47 +135,47 @@ prog6 =
 
 ruby :: File (Term Core User)
 ruby = fromBody . ann . rec (named' __semantic_global) $ record
-  [ ("Class", Core.record
+  [ ("Class", record
     [ (__semantic_super, pure "Object")
     , ("new", lam (named' "self")
-      (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
+      (    named' "instance" :<- record [ (__semantic_super, pure "self") ]
       >>>= pure "instance" $$$ "initialize"))
     ])
 
-  , ("(Object)", Core.record [ (__semantic_super, pure "Class") ])
-  , ("Object", Core.record
+  , ("(Object)", record [ (__semantic_super, pure "Class") ])
+  , ("Object", record
     [ (__semantic_super, pure "(Object)")
     , ("nil?", lam (named' "_") (pure "false"))
     , ("initialize", lam (named' "self") (pure "self"))
     , (__semantic_truthy, lam (named' "_") (Core.bool True))
     ])
 
-  , ("(NilClass)", Core.record
+  , ("(NilClass)", record
     -- FIXME: what should we do about multiple import edges like this
     [ (__semantic_super, pure "Class")
     , (__semantic_super, pure "(Object)")
     ])
-  , ("NilClass", Core.record
+  , ("NilClass", record
     [ (__semantic_super, pure "(NilClass)")
     , (__semantic_super, pure "Object")
     , ("nil?", lam (named' "_") (pure "true"))
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
     ])
 
-  , ("(TrueClass)", Core.record
+  , ("(TrueClass)", record
     [ (__semantic_super, pure "Class")
     , (__semantic_super, pure "(Object)")
     ])
-  , ("TrueClass", Core.record
+  , ("TrueClass", record
     [ (__semantic_super, pure "(TrueClass)")
     , (__semantic_super, pure "Object")
     ])
 
-  , ("(FalseClass)", Core.record
+  , ("(FalseClass)", record
     [ (__semantic_super, pure "Class")
     , (__semantic_super, pure "(Object)")
     ])
-  , ("FalseClass", Core.record
+  , ("FalseClass", record
     [ (__semantic_super, pure "(FalseClass)")
     , (__semantic_super, pure "Object")
     , (__semantic_truthy, lam (named' "_") (Core.bool False))

From 94546f7e757b34dcbf91704c0c49608dc1f21295 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:24:07 -0400
Subject: [PATCH 030/151] Define a helper for binding multiple local variables
 in a sequence.

---
 semantic-core/src/Analysis/Eval.hs | 11 ++++++-----
 semantic-core/src/Data/Core.hs     |  4 ++++
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 84df890f5..9a39bde4b 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -114,14 +114,15 @@ prog4 = fromBody
     (Core.bool False))
 
 prog5 :: File (Term Core User)
-prog5 = fromBody
-  (    named' "mkPoint" :<- lams [named' "_x", named' "_y"] (record
+prog5 = fromBody $ binds
+  [ named' "mkPoint" :<- lams [named' "_x", named' "_y"] (record
     [ ("x", pure "_x")
     , ("y", pure "_y")
     ])
-  >>>= named' "point" :<- pure "mkPoint" $$ Core.bool True $$ Core.bool False
-  >>>= pure "point" Core.... pure "x"
-  >>>  pure "point" Core.... pure "y" .= pure "point" Core.... pure "x")
+  , named' "point" :<- pure "mkPoint" $$ Core.bool True $$ Core.bool False
+  ]
+  (   pure "point" Core.... pure "x"
+  >>> pure "point" Core.... pure "y" .= pure "point" Core.... pure "x")
 
 prog6 :: [File (Term Core User)]
 prog6 =
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 762849881..6e9ac3961 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -7,6 +7,7 @@ module Data.Core
 , (>>>)
 , block
 , (>>>=)
+, binds
 , (:<-)(..)
 , lam
 , lams
@@ -136,6 +137,9 @@ Named u n :<- a >>>= b = send (Named u a :>>= bind1 n b)
 
 infixr 1 >>>=
 
+binds :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Named a :<- m a) -> m a -> m a
+binds bindings body = foldr (>>>=) body bindings
+
 data a :<- b = a :<- b
   deriving (Eq, Ord, Show)
 

From c495b4bf0791b5bbdce4e9a9062942768966cad8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:28:41 -0400
Subject: [PATCH 031/151] :fire: Edge.

---
 semantic-core/src/Analysis/Eval.hs    | 1 -
 semantic-core/src/Data/Core.hs        | 6 ------
 semantic-core/src/Data/Core/Parser.hs | 7 ++-----
 semantic-core/src/Data/Core/Pretty.hs | 2 --
 semantic-core/src/Data/Name.hs        | 2 +-
 5 files changed, 3 insertions(+), 15 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 9a39bde4b..199ccf759 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -60,7 +60,6 @@ eval Analysis{..} eval = \case
       if c' then eval t else eval e
     String s -> string s
     Load p -> eval p >>= asString >> unit -- FIXME: add a load command or something
-    Edge e a -> ref a >>= edge e >> unit
     Record _ -> frame -- FIXME: evaluate the body of the record
     a :. b -> do
       a' <- ref a
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 6e9ac3961..e5d4aacc0 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -23,7 +23,6 @@ module Data.Core
 , if'
 , string
 , load
-, edge
 , record
 , (...)
 , (.=)
@@ -65,7 +64,6 @@ data Core f a
   | String Text
   -- | Load the specified file (by path).
   | Load (f a)
-  | Edge Edge (f a)
   -- | A record mapping some keys to some values.
   | Record [(User, f a)]
   -- | Projection from a record.
@@ -99,7 +97,6 @@ instance RightModule Core where
   If c t e   >>=* f = If (c >>= f) (t >>= f) (e >>= f)
   String s   >>=* _ = String s
   Load b     >>=* f = Load (b >>= f)
-  Edge e b   >>=* f = Edge e (b >>= f)
   Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
   (a :. b)   >>=* f = (a >>= f) :. (b >>= f)
   (a := b)   >>=* f = (a >>= f) := (b >>= f)
@@ -191,9 +188,6 @@ string = send . String
 load :: (Carrier sig m, Member Core sig) => m a -> m a
 load = send . Load
 
-edge :: (Carrier sig m, Member Core sig) => Edge -> m a -> m a
-edge e b = send (Edge e b)
-
 record :: (Carrier sig m, Member Core sig) => [(User, m a)] -> m a
 record fs = send (Record fs)
 
diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index a7494dafa..2a0047f2c 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -10,7 +10,7 @@ module Data.Core.Parser
 
 import           Control.Applicative
 import qualified Data.Char as Char
-import           Data.Core (Core, Edge(..))
+import           Data.Core (Core)
 import qualified Data.Core as Core
 import           Data.Name
 import           Data.String
@@ -82,10 +82,7 @@ assign :: (TokenParsing m, Monad m) => m (Term Core User)
 assign = (Core..=) <$> try (lvalue <* symbolic '=') <*> core <?> "assignment"
 
 edge :: (TokenParsing m, Monad m) => m (Term Core User)
-edge = kw <*> expr where kw = choice [ Core.edge Lexical <$ reserved "lexical"
-                                     , Core.edge Import  <$ reserved "import"
-                                     , Core.load         <$ reserved "load"
-                                     ]
+edge = Core.load <$ reserved "load" <*> expr
 
 lvalue :: (TokenParsing m, Monad m) => m (Term Core User)
 lvalue = choice
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index e1b55880b..12719633e 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -113,8 +113,6 @@ prettyCore style = run . runReader @Prec 0 . go
               pure $ Pretty.sep [con', tru', fal']
 
             Load p   -> "load" `appending` go p
-            Edge Lexical n -> "lexical" `appending` go n
-            Edge Import n -> "import" `appending` go n
             item :. body   -> inParens 4 $ do
               f <- go item
               g <- go body
diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs
index 63d2c54a9..e4eaabd69 100644
--- a/semantic-core/src/Data/Name.hs
+++ b/semantic-core/src/Data/Name.hs
@@ -45,7 +45,7 @@ instance Ord (Ignored a) where compare _ _ = EQ
 
 reservedNames :: HashSet String
 reservedNames = [ "#true", "#false", "if", "then", "else"
-                , "lexical", "import", "#unit", "load", "rec", "#record"]
+                , "#unit", "load", "rec", "#record"]
 
 -- | Returns true if any character would require quotation or if the
 -- name conflicts with a Core primitive.

From 85c1815b9fb66eb8d05ce199efdf57949c5829a0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:32:50 -0400
Subject: [PATCH 032/151] Look up globals in the global scope.

---
 semantic-core/src/Analysis/Eval.hs | 43 +++++++++++++++---------------
 1 file changed, 22 insertions(+), 21 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 199ccf759..6b6fcb2ee 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -136,58 +136,59 @@ prog6 =
 ruby :: File (Term Core User)
 ruby = fromBody . ann . rec (named' __semantic_global) $ record
   [ ("Class", record
-    [ (__semantic_super, pure "Object")
+    [ (__semantic_super, pure __semantic_global ... "Object")
     , ("new", lam (named' "self")
       (    named' "instance" :<- record [ (__semantic_super, pure "self") ]
       >>>= pure "instance" $$$ "initialize"))
     ])
 
-  , ("(Object)", record [ (__semantic_super, pure "Class") ])
+  , ("(Object)", record [ (__semantic_super, pure __semantic_global ... "Class") ])
   , ("Object", record
-    [ (__semantic_super, pure "(Object)")
-    , ("nil?", lam (named' "_") (pure "false"))
+    [ (__semantic_super, pure __semantic_global ... "(Object)")
+    , ("nil?", lam (named' "_") (pure __semantic_global ... "false"))
     , ("initialize", lam (named' "self") (pure "self"))
     , (__semantic_truthy, lam (named' "_") (Core.bool True))
     ])
 
   , ("(NilClass)", record
     -- FIXME: what should we do about multiple import edges like this
-    [ (__semantic_super, pure "Class")
-    , (__semantic_super, pure "(Object)")
+    [ (__semantic_super, pure __semantic_global ... "Class")
+    , (__semantic_super, pure __semantic_global ... "(Object)")
     ])
   , ("NilClass", record
-    [ (__semantic_super, pure "(NilClass)")
-    , (__semantic_super, pure "Object")
-    , ("nil?", lam (named' "_") (pure "true"))
+    [ (__semantic_super, pure __semantic_global ... "(NilClass)")
+    , (__semantic_super, pure __semantic_global ... "Object")
+    , ("nil?", lam (named' "_") (pure __semantic_global ... "true"))
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
     ])
 
   , ("(TrueClass)", record
-    [ (__semantic_super, pure "Class")
-    , (__semantic_super, pure "(Object)")
+    [ (__semantic_super, pure __semantic_global ... "Class")
+    , (__semantic_super, pure __semantic_global ... "(Object)")
     ])
   , ("TrueClass", record
-    [ (__semantic_super, pure "(TrueClass)")
-    , (__semantic_super, pure "Object")
+    [ (__semantic_super, pure __semantic_global ... "(TrueClass)")
+    , (__semantic_super, pure __semantic_global ... "Object")
     ])
 
   , ("(FalseClass)", record
-    [ (__semantic_super, pure "Class")
-    , (__semantic_super, pure "(Object)")
+    [ (__semantic_super, pure __semantic_global ... "Class")
+    , (__semantic_super, pure __semantic_global ... "(Object)")
     ])
   , ("FalseClass", record
-    [ (__semantic_super, pure "(FalseClass)")
-    , (__semantic_super, pure "Object")
+    [ (__semantic_super, pure __semantic_global ... "(FalseClass)")
+    , (__semantic_super, pure __semantic_global ... "Object")
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
     ])
 
-  , ("nil"  , pure "NilClass"   $$$ "new")
-  , ("true" , pure "TrueClass"  $$$ "new")
-  , ("false", pure "FalseClass" $$$ "new")
+  , ("nil"  , pure __semantic_global ... "NilClass"   $$$ "new")
+  , ("true" , pure __semantic_global ... "TrueClass"  $$$ "new")
+  , ("false", pure __semantic_global ... "FalseClass" $$$ "new")
 
   , ("require", lam (named' "path") (Core.load (pure "path")))
   ]
-  where self $$$ method = annWith callStack $ lam (named' "_x") (pure "_x" Core.... pure method $$ pure "_x") $$ self
+  where self $$$ method = annWith callStack $ lam (named' "_x") (pure "_x" ... method $$ pure "_x") $$ self
+        record ... field = annWith callStack $ record Core.... pure field
 
         __semantic_global = "__semantic_global"
         __semantic_super  = "__semantic_super"

From 5e8a2c27c6a27981a30cd53a0a659c53cc613e9c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:38:08 -0400
Subject: [PATCH 033/151] Note that :>>= is sequential let.

---
 semantic-core/src/Data/Core.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index e5d4aacc0..422fe1554 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -54,6 +54,8 @@ data Core f a
   -- | Sequencing without binding; analogous to '>>' or '*>'.
   | f a :>> f a
   -- | Sequencing with binding; analogous to '>>='.
+  --
+  --   Bindings made with :>>= are sequential, i.e. the name is not bound within the value, only within the consequence.
   | Named (f a) :>>= Scope () f a
   | Lam (Named (Scope () f a))
   -- | Function application; analogous to '$'.

From b851621c6f22d1ef54708d6925b412df5635905b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:40:17 -0400
Subject: [PATCH 034/151] :memo: Rec.

---
 semantic-core/src/Data/Core.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 422fe1554..643eb9435 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -50,6 +50,9 @@ data Edge = Lexical | Import
   deriving (Eq, Ord, Show)
 
 data Core f a
+  -- | Recursive local binding of a name in a scope; strict evaluation of the name in the body will diverge.
+  --
+  --   Simultaneous (and therefore potentially mutually-recursive) bidnings can be made by binding a 'Record' recursively within 'Rec' and projecting from it with ':.'.
   = Rec (Named (Scope () f a))
   -- | Sequencing without binding; analogous to '>>' or '*>'.
   | f a :>> f a

From 8373e3a7bbca9505d98c067350aee49409c664c4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:42:36 -0400
Subject: [PATCH 035/151] :fire: a redundant qualifier.

---
 semantic-core/src/Analysis/Typecheck.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 998dc301b..7eea3baba 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -73,7 +73,7 @@ instance RightModule Polytype where
 
 
 forAll :: (Eq a, Carrier sig m, Member Polytype sig) => a -> m a -> m a
-forAll n body = send (PForAll (Data.Scope.bind1 n body))
+forAll n body = send (PForAll (bind1 n body))
 
 forAlls :: (Eq a, Carrier sig m, Member Polytype sig, Foldable t) => t a -> m a -> m a
 forAlls ns body = foldr forAll body ns

From d5afd8434ed30a7b6fb72136743db2e209395181 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:43:17 -0400
Subject: [PATCH 036/151] Rename bind* to abstract*.

---
 semantic-core/src/Analysis/Typecheck.hs |  2 +-
 semantic-core/src/Data/Core.hs          |  6 +++---
 semantic-core/src/Data/Scope.hs         | 18 +++++++++---------
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 7eea3baba..7d13f9534 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -73,7 +73,7 @@ instance RightModule Polytype where
 
 
 forAll :: (Eq a, Carrier sig m, Member Polytype sig) => a -> m a -> m a
-forAll n body = send (PForAll (bind1 n body))
+forAll n body = send (PForAll (abstract1 n body))
 
 forAlls :: (Eq a, Carrier sig m, Member Polytype sig, Foldable t) => t a -> m a -> m a
 forAlls ns body = foldr forAll body ns
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 643eb9435..a8a913099 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -109,7 +109,7 @@ instance RightModule Core where
 
 
 rec :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
-rec (Named u n) b = send (Rec (Named u (bind1 n b)))
+rec (Named u n) b = send (Rec (Named u (abstract1 n b)))
 
 (>>>) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
 a >>> b = send (a :>> b)
@@ -135,7 +135,7 @@ unseqs = go
           Nothing     -> t :| []
 
 (>>>=) :: (Eq a, Carrier sig m, Member Core sig) => (Named a :<- m a) -> m a -> m a
-Named u n :<- a >>>= b = send (Named u a :>>= bind1 n b)
+Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
 
 infixr 1 >>>=
 
@@ -149,7 +149,7 @@ infix 2 :<-
 
 
 lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
-lam (Named u n) b = send (Lam (Named u (bind1 n b)))
+lam (Named u n) b = send (Lam (Named u (abstract1 n b)))
 
 lams :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Named a) -> m a -> m a
 lams names body = foldr lam body names
diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 3f591a2d2..fd75bc83b 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -6,9 +6,9 @@ module Data.Scope
 , Scope(..)
 , fromScope
 , toScope
-, bind1
-, bind
-, bindEither
+, abstract1
+, abstract
+, abstractEither
 , instantiate1
 , instantiate
 , instantiateEither
@@ -86,14 +86,14 @@ toScope = Scope . fmap (fmap pure)
 
 
 -- | Bind occurrences of a variable in a term, producing a term in which the variable is bound.
-bind1 :: (Applicative f, Eq a) => a -> f a -> Scope () f a
-bind1 n = bind (guard . (== n))
+abstract1 :: (Applicative f, Eq a) => a -> f a -> Scope () f a
+abstract1 n = abstract (guard . (== n))
 
-bind :: Applicative f => (b -> Maybe a) -> f b -> Scope a f b
-bind f = bindEither (matchMaybe f)
+abstract :: Applicative f => (b -> Maybe a) -> f b -> Scope a f b
+abstract f = abstractEither (matchMaybe f)
 
-bindEither :: Applicative f => (b -> Either a c) -> f b -> Scope a f c
-bindEither f = Scope . fmap (match f) -- FIXME: succ as little of the expression as possible, cf https://twitter.com/ollfredo/status/1145776391826358273
+abstractEither :: Applicative f => (b -> Either a c) -> f b -> Scope a f c
+abstractEither f = Scope . fmap (match f) -- FIXME: succ as little of the expression as possible, cf https://twitter.com/ollfredo/status/1145776391826358273
 
 
 -- | Substitute a term for the free variable in a given term, producing a closed term.

From 2c13ed8b5315bc67aad08f01163d62a0efca0ca5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 10:44:49 -0400
Subject: [PATCH 037/151] =?UTF-8?q?Don=E2=80=99t=20build=20a=20lambda=20fo?=
 =?UTF-8?q?r=20method=20calls.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Analysis/Eval.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 6b6fcb2ee..a2a281842 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -187,7 +187,7 @@ ruby = fromBody . ann . rec (named' __semantic_global) $ record
 
   , ("require", lam (named' "path") (Core.load (pure "path")))
   ]
-  where self $$$ method = annWith callStack $ lam (named' "_x") (pure "_x" ... method $$ pure "_x") $$ self
+  where self $$$ method = annWith callStack $ named' "_x" :<- self >>>= pure "_x" ... method $$ pure "_x"
         record ... field = annWith callStack $ record Core.... pure field
 
         __semantic_global = "__semantic_global"

From fb318fa56c0a888f8c59b8c099471a79c7380ebe Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:00:42 -0400
Subject: [PATCH 038/151] Tidier frame-pushing.

---
 semantic-core/src/Analysis/Concrete.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 761a697dd..d19818250 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -109,7 +109,7 @@ concreteAnalysis = Analysis{..}
         apply eval (Closure loc name body parentAddr) a = do
           frameAddr <- fresh
           assign frameAddr (Obj (Frame [(Core.Lexical, parentAddr)] mempty))
-          local (const loc) . (frameAddr ...) $ do
+          local (const loc) $ frameAddr ... do
             addr <- alloc name
             assign addr a
             bind name addr

From 4cc6520d578fa7c372422c87a38cce55e9a09149 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:04:25 -0400
Subject: [PATCH 039/151] Define :. as strictly projection.

---
 semantic-core/src/Analysis/Concrete.hs    |  7 +++++--
 semantic-core/src/Analysis/Eval.hs        | 16 ++++++++--------
 semantic-core/src/Analysis/ImportGraph.hs |  2 +-
 semantic-core/src/Analysis/Typecheck.hs   |  2 +-
 semantic-core/src/Data/Core.hs            |  6 +++---
 semantic-core/src/Data/Core/Parser.hs     |  9 +++++----
 semantic-core/src/Data/Core/Pretty.hs     |  3 +--
 7 files changed, 24 insertions(+), 21 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index d19818250..be77d887c 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -109,7 +109,7 @@ concreteAnalysis = Analysis{..}
         apply eval (Closure loc name body parentAddr) a = do
           frameAddr <- fresh
           assign frameAddr (Obj (Frame [(Core.Lexical, parentAddr)] mempty))
-          local (const loc) $ frameAddr ... do
+          local (const loc) . local (const (FrameId frameAddr)) $ do
             addr <- alloc name
             assign addr a
             bind name addr
@@ -130,7 +130,10 @@ concreteAnalysis = Analysis{..}
         -- FIXME: throw an error
         -- FIXME: support dynamic imports
         edge e addr = modifyCurrentFrame (\ (Frame ps fs) -> Frame ((e, addr) : ps) fs)
-        addr ... m = local (const (FrameId addr)) m
+        addr ... n = do
+          val <- deref addr
+          heap <- get
+          pure (val >>= lookupConcrete heap n)
 
         updateFrameSlots f frame = frame { frameSlots = f (frameSlots frame) }
 
diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index a2a281842..093bd20f9 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RecordWildCards #-}
 module Analysis.Eval
 ( eval
 , prog1
@@ -63,7 +63,7 @@ eval Analysis{..} eval = \case
     Record _ -> frame -- FIXME: evaluate the body of the record
     a :. b -> do
       a' <- ref a
-      a' ... eval b
+      a' ... b >>= maybe (freeVariable (show b)) (deref' b)
     a := b -> do
       b' <- eval b
       addr <- ref a
@@ -84,7 +84,7 @@ eval Analysis{..} eval = \case
               if c' then ref t else ref e
             a :. b -> do
               a' <- ref a
-              a' ... ref b
+              a' ... b >>= maybe (freeVariable (show b)) pure
             Ann loc c -> local (const loc) (ref c)
             c -> invalidRef (show c)
 
@@ -120,8 +120,8 @@ prog5 = fromBody $ binds
     ])
   , named' "point" :<- pure "mkPoint" $$ Core.bool True $$ Core.bool False
   ]
-  (   pure "point" Core.... pure "x"
-  >>> pure "point" Core.... pure "y" .= pure "point" Core.... pure "x")
+  (   pure "point" Core.... "x"
+  >>> pure "point" Core.... "y" .= pure "point" Core.... "x")
 
 prog6 :: [File (Term Core User)]
 prog6 =
@@ -129,7 +129,7 @@ prog6 =
     [ ("dep", record [ ("var", Core.bool True) ]) ]
   , File (Loc "main" (locSpan (fromJust here))) $ block
     [ load (Core.string "dep")
-    , record [ ("thing", pure "dep" Core.... pure "var") ]
+    , record [ ("thing", pure "dep" Core.... "var") ]
     ]
   ]
 
@@ -188,7 +188,7 @@ ruby = fromBody . ann . rec (named' __semantic_global) $ record
   , ("require", lam (named' "path") (Core.load (pure "path")))
   ]
   where self $$$ method = annWith callStack $ named' "_x" :<- self >>>= pure "_x" ... method $$ pure "_x"
-        record ... field = annWith callStack $ record Core.... pure field
+        record ... field = annWith callStack $ record Core.... field
 
         __semantic_global = "__semantic_global"
         __semantic_super  = "__semantic_super"
@@ -210,5 +210,5 @@ data Analysis address value m = Analysis
   , asString    :: value -> m Text
   , frame       :: m value
   , edge        :: Edge -> address -> m ()
-  , (...)       :: forall a . address -> m a -> m a
+  , (...)       :: address -> User -> m (Maybe address)
   }
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 7247462f1..242773987 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -105,4 +105,4 @@ importGraphAnalysis = Analysis{..}
           Loc{locPath=from} <- ask
           () <$ pure (Value Abstract (Map.singleton from (Set.singleton to)))
         edge _ _ = pure ()
-        _ ... m = m
+        _ ... m = pure (Just m)
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 7d13f9534..8b5b45a5f 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -151,7 +151,7 @@ typecheckingAnalysis = Analysis{..}
         asString s = unify (Term String) s $> mempty
         frame = fail "unimplemented"
         edge _ _ = pure ()
-        _ ... m = m
+        _ ... m = pure (Just m)
 
 
 data Constraint = Term Monotype Meta :===: Term Monotype Meta
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index a8a913099..f7b161faf 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -72,7 +72,7 @@ data Core f a
   -- | A record mapping some keys to some values.
   | Record [(User, f a)]
   -- | Projection from a record.
-  | f a :. f a
+  | f a :. User
   -- | Assignment of a value to the reference returned by the lhs.
   | f a := f a
   | Ann Loc (f a)
@@ -103,7 +103,7 @@ instance RightModule Core where
   String s   >>=* _ = String s
   Load b     >>=* f = Load (b >>= f)
   Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
-  (a :. b)   >>=* f = (a >>= f) :. (b >>= f)
+  (a :. b)   >>=* f = (a >>= f) :. b
   (a := b)   >>=* f = (a >>= f) := (b >>= f)
   Ann l b    >>=* f = Ann l (b >>= f)
 
@@ -196,7 +196,7 @@ load = send . Load
 record :: (Carrier sig m, Member Core sig) => [(User, m a)] -> m a
 record fs = send (Record fs)
 
-(...) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
+(...) :: (Carrier sig m, Member Core sig) => m a -> User -> m a
 a ... b = send (a :. b)
 
 infixl 4 ...
diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 2a0047f2c..56a52a3ee 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -12,6 +12,7 @@ import           Control.Applicative
 import qualified Data.Char as Char
 import           Data.Core (Core)
 import qualified Data.Core as Core
+import           Data.Foldable (foldl')
 import           Data.Name
 import           Data.String
 import           Data.Term
@@ -48,10 +49,10 @@ core :: (TokenParsing m, Monad m) => m (Term Core User)
 core = expr
 
 expr :: (TokenParsing m, Monad m) => m (Term Core User)
-expr = atom `chainl1` go where
-  go = choice [ (Core....) <$ dot
-              , (Core.$$)  <$ notFollowedBy dot
-              ]
+expr = prj `chainl1` (pure (Core.$$))
+
+prj :: (TokenParsing m, Monad m) => m (Term Core User)
+prj = foldl' (Core....) <$> atom <*> many (namedValue <$> (dot *> name))
 
 atom :: (TokenParsing m, Monad m) => m (Term Core User)
 atom = choice
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 12719633e..279a15788 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -115,8 +115,7 @@ prettyCore style = run . runReader @Prec 0 . go
             Load p   -> "load" `appending` go p
             item :. body   -> inParens 4 $ do
               f <- go item
-              g <- go body
-              pure (f <> symbol "." <> g)
+              pure (f <> symbol "." <> name body)
 
             lhs := rhs -> inParens 3 $ do
               f <- go lhs

From cd3f73afdbb17ee24470a3bb33ea80b39523a8c5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:08:22 -0400
Subject: [PATCH 040/151] bind acts locally.

---
 semantic-core/src/Analysis/Concrete.hs    |  5 ++---
 semantic-core/src/Analysis/Eval.hs        | 10 ++++------
 semantic-core/src/Analysis/ImportGraph.hs |  5 ++---
 semantic-core/src/Analysis/Typecheck.hs   |  2 +-
 4 files changed, 9 insertions(+), 13 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index be77d887c..563429986 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -94,7 +94,7 @@ concreteAnalysis :: ( Carrier sig m
                  => Analysis Precise Concrete m
 concreteAnalysis = Analysis{..}
   where alloc _ = fresh
-        bind name addr = modifyCurrentFrame (updateFrameSlots (Map.insert name addr))
+        bind name addr m = modifyCurrentFrame (updateFrameSlots (Map.insert name addr)) >> m
         lookupEnv n = do
           FrameId frameAddr <- ask
           val <- deref frameAddr
@@ -112,8 +112,7 @@ concreteAnalysis = Analysis{..}
           local (const loc) . local (const (FrameId frameAddr)) $ do
             addr <- alloc name
             assign addr a
-            bind name addr
-            eval body
+            bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure Unit
         bool b = pure (Bool b)
diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 093bd20f9..bfbc9bf29 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards #-}
 module Analysis.Eval
 ( eval
 , prog1
@@ -38,16 +38,14 @@ eval Analysis{..} eval = \case
   Term c -> case c of
     Rec (Named (Ignored n) b) -> do
       addr <- alloc n
-      bind n addr
-      v <- eval (instantiate1 (pure n) b)
+      v <- bind n addr (eval (instantiate1 (pure n) b))
       v <$ assign addr v
     a :>> b -> eval a >> eval b
     Named (Ignored n) a :>>= b -> do
       a' <- eval a
       addr <- alloc n
-      bind n addr
       assign addr a'
-      eval (instantiate1 (pure n) b)
+      bind n addr (eval (instantiate1 (pure n) b))
     Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)
     f :$ a -> do
       f' <- eval f
@@ -197,7 +195,7 @@ ruby = fromBody . ann . rec (named' __semantic_global) $ record
 
 data Analysis address value m = Analysis
   { alloc       :: User -> m address
-  , bind        :: User -> address -> m ()
+  , bind        :: forall a . User -> address -> m a -> m a
   , lookupEnv   :: User -> m (Maybe address)
   , deref       :: address -> m (Maybe value)
   , assign      :: address -> value -> m ()
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 242773987..ac0906a3b 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -80,7 +80,7 @@ importGraphAnalysis :: ( Alternative m
                     => Analysis User Value m
 importGraphAnalysis = Analysis{..}
   where alloc = pure
-        bind _ _ = pure ()
+        bind _ _ m = m
         lookupEnv = pure . Just
         deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] Set.toList
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
@@ -91,8 +91,7 @@ importGraphAnalysis = Analysis{..}
         apply eval (Value (Closure loc name body _) _) a = local (const loc) $ do
           addr <- alloc name
           assign addr a
-          bind name addr
-          eval body
+          bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure mempty
         bool _ = pure mempty
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 8b5b45a5f..3d59dc534 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -127,7 +127,7 @@ typecheckingAnalysis
   => Analysis User (Term Monotype Meta) m
 typecheckingAnalysis = Analysis{..}
   where alloc = pure
-        bind _ _ = pure ()
+        bind _ _ m = m
         lookupEnv = pure . Just
         deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] Set.toList
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))

From c613b0cef2ce390ded074c2139905f0455dbf752 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:10:00 -0400
Subject: [PATCH 041/151] :fire: the edge instruction.

---
 semantic-core/src/Analysis/Concrete.hs    | 1 -
 semantic-core/src/Analysis/Eval.hs        | 1 -
 semantic-core/src/Analysis/ImportGraph.hs | 4 ----
 semantic-core/src/Analysis/Typecheck.hs   | 1 -
 4 files changed, 7 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 563429986..6cd5e7db4 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -128,7 +128,6 @@ concreteAnalysis = Analysis{..}
           pure (Obj (Frame [(Core.Lexical, lexical)] mempty))
         -- FIXME: throw an error
         -- FIXME: support dynamic imports
-        edge e addr = modifyCurrentFrame (\ (Frame ps fs) -> Frame ((e, addr) : ps) fs)
         addr ... n = do
           val <- deref addr
           heap <- get
diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index bfbc9bf29..a7c2e8f45 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -207,6 +207,5 @@ data Analysis address value m = Analysis
   , string      :: Text -> m value
   , asString    :: value -> m Text
   , frame       :: m value
-  , edge        :: Edge -> address -> m ()
   , (...)       :: address -> User -> m (Maybe address)
   }
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index ac0906a3b..dc0963ebd 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -100,8 +100,4 @@ importGraphAnalysis = Analysis{..}
         asString (Value (String s) _) = pure s
         asString _ = pure mempty
         frame = pure mempty
-        edge Core.Import to = do -- FIXME: figure out some other way to do this
-          Loc{locPath=from} <- ask
-          () <$ pure (Value Abstract (Map.singleton from (Set.singleton to)))
-        edge _ _ = pure ()
         _ ... m = pure (Just m)
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 3d59dc534..c51e5f41c 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -150,7 +150,6 @@ typecheckingAnalysis = Analysis{..}
         string _ = pure (Term String)
         asString s = unify (Term String) s $> mempty
         frame = fail "unimplemented"
-        edge _ _ = pure ()
         _ ... m = pure (Just m)
 
 

From b0bc2cf25ba34c8e46c8abffd19300fa1611162f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:10:33 -0400
Subject: [PATCH 042/151] Note a FIXME.

---
 semantic-core/src/Analysis/Concrete.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 6cd5e7db4..c3cf78db2 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -141,6 +141,7 @@ concreteAnalysis = Analysis{..}
           assign addr (Obj (f frame))
 
 
+-- FIXME: follow super edges
 lookupConcrete :: Heap -> User -> Concrete -> Maybe Precise
 lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value

From 5f2160296731ebdb564c51c5a9c02fb3bf6d0cc2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:15:44 -0400
Subject: [PATCH 043/151] :fire: some redundant FIXMEs.

---
 semantic-core/src/Analysis/Concrete.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index c3cf78db2..b6971672c 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -126,8 +126,6 @@ concreteAnalysis = Analysis{..}
         frame = do
           lexical <- asks unFrameId
           pure (Obj (Frame [(Core.Lexical, lexical)] mempty))
-        -- FIXME: throw an error
-        -- FIXME: support dynamic imports
         addr ... n = do
           val <- deref addr
           heap <- get

From 8bc79bd8046568e4b1e6394716df91805a6d2b8f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:18:34 -0400
Subject: [PATCH 044/151] Define and implement a record operation.

---
 semantic-core/src/Analysis/Concrete.hs    |  8 ++++++
 semantic-core/src/Analysis/Eval.hs        | 33 ++++++++++++-----------
 semantic-core/src/Analysis/ImportGraph.hs |  1 +
 semantic-core/src/Analysis/Typecheck.hs   |  1 +
 4 files changed, 27 insertions(+), 16 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index b6971672c..a088953a7 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -31,6 +31,7 @@ import           Data.Monoid (Alt(..))
 import           Data.Name
 import           Data.Term
 import           Data.Text (Text, pack)
+import           Data.Traversable (for)
 import           Prelude hiding (fail)
 
 type Precise = Int
@@ -126,6 +127,13 @@ concreteAnalysis = Analysis{..}
         frame = do
           lexical <- asks unFrameId
           pure (Obj (Frame [(Core.Lexical, lexical)] mempty))
+        record fields = do
+          lexical <- asks unFrameId
+          fields' <- for fields $ \ (name, value) -> do
+            addr <- alloc name
+            assign addr value
+            pure (name, addr)
+          pure (Obj (Frame [(Core.Lexical, lexical)] (Map.fromList fields')))
         addr ... n = do
           val <- deref addr
           heap <- get
diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index a7c2e8f45..813db846f 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -58,7 +58,7 @@ eval Analysis{..} eval = \case
       if c' then eval t else eval e
     String s -> string s
     Load p -> eval p >>= asString >> unit -- FIXME: add a load command or something
-    Record _ -> frame -- FIXME: evaluate the body of the record
+    Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
       a' ... b >>= maybe (freeVariable (show b)) (deref' b)
@@ -112,7 +112,7 @@ prog4 = fromBody
 
 prog5 :: File (Term Core User)
 prog5 = fromBody $ binds
-  [ named' "mkPoint" :<- lams [named' "_x", named' "_y"] (record
+  [ named' "mkPoint" :<- lams [named' "_x", named' "_y"] (Core.record
     [ ("x", pure "_x")
     , ("y", pure "_y")
     ])
@@ -123,57 +123,57 @@ prog5 = fromBody $ binds
 
 prog6 :: [File (Term Core User)]
 prog6 =
-  [ File (Loc "dep"  (locSpan (fromJust here))) $ record
-    [ ("dep", record [ ("var", Core.bool True) ]) ]
+  [ File (Loc "dep"  (locSpan (fromJust here))) $ Core.record
+    [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
   , File (Loc "main" (locSpan (fromJust here))) $ block
     [ load (Core.string "dep")
-    , record [ ("thing", pure "dep" Core.... "var") ]
+    , Core.record [ ("thing", pure "dep" Core.... "var") ]
     ]
   ]
 
 ruby :: File (Term Core User)
-ruby = fromBody . ann . rec (named' __semantic_global) $ record
-  [ ("Class", record
+ruby = fromBody . ann . rec (named' __semantic_global) $ Core.record
+  [ ("Class", Core.record
     [ (__semantic_super, pure __semantic_global ... "Object")
     , ("new", lam (named' "self")
-      (    named' "instance" :<- record [ (__semantic_super, pure "self") ]
+      (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
       >>>= pure "instance" $$$ "initialize"))
     ])
 
-  , ("(Object)", record [ (__semantic_super, pure __semantic_global ... "Class") ])
-  , ("Object", record
+  , ("(Object)", Core.record [ (__semantic_super, pure __semantic_global ... "Class") ])
+  , ("Object", Core.record
     [ (__semantic_super, pure __semantic_global ... "(Object)")
     , ("nil?", lam (named' "_") (pure __semantic_global ... "false"))
     , ("initialize", lam (named' "self") (pure "self"))
     , (__semantic_truthy, lam (named' "_") (Core.bool True))
     ])
 
-  , ("(NilClass)", record
+  , ("(NilClass)", Core.record
     -- FIXME: what should we do about multiple import edges like this
     [ (__semantic_super, pure __semantic_global ... "Class")
     , (__semantic_super, pure __semantic_global ... "(Object)")
     ])
-  , ("NilClass", record
+  , ("NilClass", Core.record
     [ (__semantic_super, pure __semantic_global ... "(NilClass)")
     , (__semantic_super, pure __semantic_global ... "Object")
     , ("nil?", lam (named' "_") (pure __semantic_global ... "true"))
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
     ])
 
-  , ("(TrueClass)", record
+  , ("(TrueClass)", Core.record
     [ (__semantic_super, pure __semantic_global ... "Class")
     , (__semantic_super, pure __semantic_global ... "(Object)")
     ])
-  , ("TrueClass", record
+  , ("TrueClass", Core.record
     [ (__semantic_super, pure __semantic_global ... "(TrueClass)")
     , (__semantic_super, pure __semantic_global ... "Object")
     ])
 
-  , ("(FalseClass)", record
+  , ("(FalseClass)", Core.record
     [ (__semantic_super, pure __semantic_global ... "Class")
     , (__semantic_super, pure __semantic_global ... "(Object)")
     ])
-  , ("FalseClass", record
+  , ("FalseClass", Core.record
     [ (__semantic_super, pure __semantic_global ... "(FalseClass)")
     , (__semantic_super, pure __semantic_global ... "Object")
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
@@ -207,5 +207,6 @@ data Analysis address value m = Analysis
   , string      :: Text -> m value
   , asString    :: value -> m Text
   , frame       :: m value
+  , record      :: [(User, value)] -> m value
   , (...)       :: address -> User -> m (Maybe address)
   }
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index dc0963ebd..b7cb07a8e 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -100,4 +100,5 @@ importGraphAnalysis = Analysis{..}
         asString (Value (String s) _) = pure s
         asString _ = pure mempty
         frame = pure mempty
+        record fields = pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index c51e5f41c..f0680ce28 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -150,6 +150,7 @@ typecheckingAnalysis = Analysis{..}
         string _ = pure (Term String)
         asString s = unify (Term String) s $> mempty
         frame = fail "unimplemented"
+        record _ = fail "unimplemented"
         _ ... m = pure (Just m)
 
 

From fea81ee213fc95193919720ad85a6e7d76aad15b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:19:09 -0400
Subject: [PATCH 045/151] :fire: the frame operation.

---
 semantic-core/src/Analysis/Concrete.hs    | 3 ---
 semantic-core/src/Analysis/Eval.hs        | 1 -
 semantic-core/src/Analysis/ImportGraph.hs | 1 -
 semantic-core/src/Analysis/Typecheck.hs   | 1 -
 4 files changed, 6 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index a088953a7..245f3fb01 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -124,9 +124,6 @@ concreteAnalysis = Analysis{..}
         asString v          = fail $ "Cannot coerce " <> show v <> " to String"
         -- FIXME: differential inheritance (reference fields instead of copying)
         -- FIXME: copy non-lexical parents deeply?
-        frame = do
-          lexical <- asks unFrameId
-          pure (Obj (Frame [(Core.Lexical, lexical)] mempty))
         record fields = do
           lexical <- asks unFrameId
           fields' <- for fields $ \ (name, value) -> do
diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 813db846f..2c28f2fd9 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -206,7 +206,6 @@ data Analysis address value m = Analysis
   , asBool      :: value -> m Bool
   , string      :: Text -> m value
   , asString    :: value -> m Text
-  , frame       :: m value
   , record      :: [(User, value)] -> m value
   , (...)       :: address -> User -> m (Maybe address)
   }
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index b7cb07a8e..5e87e38ec 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -99,6 +99,5 @@ importGraphAnalysis = Analysis{..}
         string s = pure (Value (String s) mempty)
         asString (Value (String s) _) = pure s
         asString _ = pure mempty
-        frame = pure mempty
         record fields = pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index f0680ce28..287981301 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -149,7 +149,6 @@ typecheckingAnalysis = Analysis{..}
         asBool b = unify (Term Bool) b >> pure True <|> pure False
         string _ = pure (Term String)
         asString s = unify (Term String) s $> mempty
-        frame = fail "unimplemented"
         record _ = fail "unimplemented"
         _ ... m = pure (Just m)
 

From 6c5240bfbab92bd555c9fb7afaec5ef74f899bd4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:23:59 -0400
Subject: [PATCH 046/151] Bind and look names up in an Env.

---
 semantic-core/src/Analysis/Concrete.hs | 17 ++++-------------
 1 file changed, 4 insertions(+), 13 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 245f3fb01..abea5f241 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -83,10 +83,12 @@ runFile :: ( Carrier sig m
 runFile file = traverse run file
   where run = runReader (fileLoc file)
             . runFailWithLoc
+            . runReader (mempty :: Env)
             . fix (eval concreteAnalysis)
 
 concreteAnalysis :: ( Carrier sig m
                     , Member Fresh sig
+                    , Member (Reader Env) sig
                     , Member (Reader Loc) sig
                     , Member (Reader FrameId) sig
                     , Member (State Heap) sig
@@ -95,12 +97,8 @@ concreteAnalysis :: ( Carrier sig m
                  => Analysis Precise Concrete m
 concreteAnalysis = Analysis{..}
   where alloc _ = fresh
-        bind name addr m = modifyCurrentFrame (updateFrameSlots (Map.insert name addr)) >> m
-        lookupEnv n = do
-          FrameId frameAddr <- ask
-          val <- deref frameAddr
-          heap <- get
-          pure (val >>= lookupConcrete heap n)
+        bind name addr m = local (Map.insert name addr) m
+        lookupEnv n = asks (Map.lookup n)
         deref = gets . IntMap.lookup
         assign addr value = modify (IntMap.insert addr value)
         abstract _ name body = do
@@ -136,13 +134,6 @@ concreteAnalysis = Analysis{..}
           heap <- get
           pure (val >>= lookupConcrete heap n)
 
-        updateFrameSlots f frame = frame { frameSlots = f (frameSlots frame) }
-
-        modifyCurrentFrame f = do
-          addr <- asks unFrameId
-          Just (Obj frame) <- deref addr
-          assign addr (Obj (f frame))
-
 
 -- FIXME: follow super edges
 lookupConcrete :: Heap -> User -> Concrete -> Maybe Precise

From d41d7757fe52d69942ba310ff832fd6f5e9168ae Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:28:38 -0400
Subject: [PATCH 047/151] =?UTF-8?q?Don=E2=80=99t=20stratify=20frames=20thr?=
 =?UTF-8?q?ough=20the=20heap.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Analysis/Concrete.hs | 26 +++++++++-----------------
 1 file changed, 9 insertions(+), 17 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index abea5f241..ede5b0523 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -41,7 +41,7 @@ newtype FrameId = FrameId { unFrameId :: Precise }
   deriving (Eq, Ord, Show)
 
 data Concrete
-  = Closure Loc User (Term Core.Core User) Precise
+  = Closure Loc User (Term Core.Core User)
   | Unit
   | Bool Bool
   | String Text
@@ -75,7 +75,6 @@ concrete
 runFile :: ( Carrier sig m
            , Effect sig
            , Member Fresh sig
-           , Member (Reader FrameId) sig
            , Member (State Heap) sig
            )
         => File (Term Core.Core User)
@@ -90,7 +89,6 @@ concreteAnalysis :: ( Carrier sig m
                     , Member Fresh sig
                     , Member (Reader Env) sig
                     , Member (Reader Loc) sig
-                    , Member (Reader FrameId) sig
                     , Member (State Heap) sig
                     , MonadFail m
                     )
@@ -103,12 +101,9 @@ concreteAnalysis = Analysis{..}
         assign addr value = modify (IntMap.insert addr value)
         abstract _ name body = do
           loc <- ask
-          FrameId parentAddr <- ask
-          pure (Closure loc name body parentAddr)
-        apply eval (Closure loc name body parentAddr) a = do
-          frameAddr <- fresh
-          assign frameAddr (Obj (Frame [(Core.Lexical, parentAddr)] mempty))
-          local (const loc) . local (const (FrameId frameAddr)) $ do
+          pure (Closure loc name body)
+        apply eval (Closure loc name body) a = do
+          local (const loc) $ do
             addr <- alloc name
             assign addr a
             bind name addr (eval body)
@@ -123,12 +118,11 @@ concreteAnalysis = Analysis{..}
         -- FIXME: differential inheritance (reference fields instead of copying)
         -- FIXME: copy non-lexical parents deeply?
         record fields = do
-          lexical <- asks unFrameId
           fields' <- for fields $ \ (name, value) -> do
             addr <- alloc name
             assign addr value
             pure (name, addr)
-          pure (Obj (Frame [(Core.Lexical, lexical)] (Map.fromList fields')))
+          pure (Obj (Frame [] (Map.fromList fields')))
         addr ... n = do
           val <- deref addr
           heap <- get
@@ -153,10 +147,8 @@ lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
         maybeA = maybe empty pure
 
 
-runHeap :: (Carrier sig m, Member Fresh sig) => ReaderC FrameId (StateC Heap m) a -> m (Heap, a)
-runHeap m = do
-  addr <- fresh
-  runState (IntMap.singleton addr (Obj (Frame [] mempty))) (runReader (FrameId addr) m)
+runHeap :: StateC Heap m a -> m (Heap, a)
+runHeap = runState mempty
 
 
 -- | 'heapGraph', 'heapValueGraph', and 'heapAddressGraph' allow us to conveniently export SVGs of the heap:
@@ -171,7 +163,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Unit -> G.empty
           Bool _ -> G.empty
           String _ -> G.empty
-          Closure _ _ _ parentAddr -> edge (Left Core.Lexical) parentAddr
+          Closure _ _ _ -> G.empty
           Obj frame -> fromFrame frame
         fromFrame (Frame es ss) = foldr (G.overlay . uncurry (edge . Left)) (foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList ss)) es
 
@@ -193,7 +185,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure (Loc p (Span s e)) n _ -> "\\\\ " <> n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Obj _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 

From 384c221ef639e17c6577930e174a8482c0fb0097 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:31:47 -0400
Subject: [PATCH 048/151] :fire: frameEdges.

---
 semantic-core/src/Analysis/Concrete.hs | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index ede5b0523..368d005d9 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -27,7 +27,6 @@ import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import           Data.Loc
 import qualified Data.Map as Map
-import           Data.Monoid (Alt(..))
 import           Data.Name
 import           Data.Term
 import           Data.Text (Text, pack)
@@ -52,9 +51,8 @@ objectFrame :: Concrete -> Maybe Frame
 objectFrame (Obj frame) = Just frame
 objectFrame _           = Nothing
 
-data Frame = Frame
-  { frameEdges :: [(Core.Edge, Precise)]
-  , frameSlots :: Env
+newtype Frame = Frame
+  { frameSlots :: Env
   }
   deriving (Eq, Ord, Show)
 
@@ -122,7 +120,7 @@ concreteAnalysis = Analysis{..}
             addr <- alloc name
             assign addr value
             pure (name, addr)
-          pure (Obj (Frame [] (Map.fromList fields')))
+          pure (Obj (Frame (Map.fromList fields')))
         addr ... n = do
           val <- deref addr
           heap <- get
@@ -135,9 +133,9 @@ lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value
         inConcrete = inFrame <=< maybeA . objectFrame
         -- look up the name in a specific 'Frame', with slots taking precedence over parents
-        inFrame (Frame ps fs) = maybeA (Map.lookup name fs) <|> getAlt (foldMap (Alt . inAddress . snd) ps)
+        inFrame (Frame fs) = maybeA (Map.lookup name fs)
         -- look up the name in the value an address points to, if we haven’t already visited it
-        inAddress addr = do
+        _inAddress addr = do
           visited <- get
           guard (addr `IntSet.notMember` visited)
           -- FIXME: throw an error if we can’t deref @addr@
@@ -165,7 +163,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           String _ -> G.empty
           Closure _ _ _ -> G.empty
           Obj frame -> fromFrame frame
-        fromFrame (Frame es ss) = foldr (G.overlay . uncurry (edge . Left)) (foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList ss)) es
+        fromFrame (Frame ss) = foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList ss)
 
 heapValueGraph :: Heap -> G.Graph Concrete
 heapValueGraph h = heapGraph (const id) (const fromAddr) h

From 9b6f7dd148a155d82f1fdb22fe861a92e2dbedd2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:32:58 -0400
Subject: [PATCH 049/151] Obj holds an Env, not a Frame.

---
 semantic-core/src/Analysis/Concrete.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 368d005d9..dbdcad287 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -44,10 +44,10 @@ data Concrete
   | Unit
   | Bool Bool
   | String Text
-  | Obj Frame
+  | Obj Env
   deriving (Eq, Ord, Show)
 
-objectFrame :: Concrete -> Maybe Frame
+objectFrame :: Concrete -> Maybe Env
 objectFrame (Obj frame) = Just frame
 objectFrame _           = Nothing
 
@@ -120,7 +120,7 @@ concreteAnalysis = Analysis{..}
             addr <- alloc name
             assign addr value
             pure (name, addr)
-          pure (Obj (Frame (Map.fromList fields')))
+          pure (Obj (Map.fromList fields'))
         addr ... n = do
           val <- deref addr
           heap <- get
@@ -133,7 +133,7 @@ lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value
         inConcrete = inFrame <=< maybeA . objectFrame
         -- look up the name in a specific 'Frame', with slots taking precedence over parents
-        inFrame (Frame fs) = maybeA (Map.lookup name fs)
+        inFrame fs = maybeA (Map.lookup name fs)
         -- look up the name in the value an address points to, if we haven’t already visited it
         _inAddress addr = do
           visited <- get
@@ -162,8 +162,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Bool _ -> G.empty
           String _ -> G.empty
           Closure _ _ _ -> G.empty
-          Obj frame -> fromFrame frame
-        fromFrame (Frame ss) = foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList ss)
+          Obj frame -> foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList frame)
 
 heapValueGraph :: Heap -> G.Graph Concrete
 heapValueGraph h = heapGraph (const id) (const fromAddr) h

From 958d32fb52dc8e4e4ab2c63cb450b27365f458c4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:43:28 -0400
Subject: [PATCH 050/151] Follow edges through the graph.

---
 semantic-core/src/Analysis/Concrete.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index dbdcad287..4b048504e 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -127,15 +127,14 @@ concreteAnalysis = Analysis{..}
           pure (val >>= lookupConcrete heap n)
 
 
--- FIXME: follow super edges
 lookupConcrete :: Heap -> User -> Concrete -> Maybe Precise
 lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value
         inConcrete = inFrame <=< maybeA . objectFrame
         -- look up the name in a specific 'Frame', with slots taking precedence over parents
-        inFrame fs = maybeA (Map.lookup name fs)
+        inFrame fs = maybeA (Map.lookup name fs) <|> (maybeA (Map.lookup "__semantic_super" fs) >>= inAddress)
         -- look up the name in the value an address points to, if we haven’t already visited it
-        _inAddress addr = do
+        inAddress addr = do
           visited <- get
           guard (addr `IntSet.notMember` visited)
           -- FIXME: throw an error if we can’t deref @addr@

From 1abddf42b39b60116334f0b83a549908ce308575 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:50:42 -0400
Subject: [PATCH 051/151] Annotate each binding.

---
 semantic-core/src/Analysis/Eval.hs | 34 +++++++++++++++---------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 2c28f2fd9..100f6706d 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -133,51 +133,51 @@ prog6 =
 
 ruby :: File (Term Core User)
 ruby = fromBody . ann . rec (named' __semantic_global) $ Core.record
-  [ ("Class", Core.record
+  [ ("Class", ann (Core.record
     [ (__semantic_super, pure __semantic_global ... "Object")
     , ("new", lam (named' "self")
       (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
       >>>= pure "instance" $$$ "initialize"))
-    ])
+    ]))
 
-  , ("(Object)", Core.record [ (__semantic_super, pure __semantic_global ... "Class") ])
-  , ("Object", Core.record
+  , ("(Object)", ann (Core.record [ (__semantic_super, pure __semantic_global ... "Class") ]))
+  , ("Object", ann (Core.record
     [ (__semantic_super, pure __semantic_global ... "(Object)")
     , ("nil?", lam (named' "_") (pure __semantic_global ... "false"))
     , ("initialize", lam (named' "self") (pure "self"))
     , (__semantic_truthy, lam (named' "_") (Core.bool True))
-    ])
+    ]))
 
-  , ("(NilClass)", Core.record
+  , ("(NilClass)", ann (Core.record
     -- FIXME: what should we do about multiple import edges like this
     [ (__semantic_super, pure __semantic_global ... "Class")
     , (__semantic_super, pure __semantic_global ... "(Object)")
-    ])
-  , ("NilClass", Core.record
+    ]))
+  , ("NilClass", ann (Core.record
     [ (__semantic_super, pure __semantic_global ... "(NilClass)")
     , (__semantic_super, pure __semantic_global ... "Object")
     , ("nil?", lam (named' "_") (pure __semantic_global ... "true"))
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
-    ])
+    ]))
 
-  , ("(TrueClass)", Core.record
+  , ("(TrueClass)", ann (Core.record
     [ (__semantic_super, pure __semantic_global ... "Class")
     , (__semantic_super, pure __semantic_global ... "(Object)")
-    ])
-  , ("TrueClass", Core.record
+    ]))
+  , ("TrueClass", ann (Core.record
     [ (__semantic_super, pure __semantic_global ... "(TrueClass)")
     , (__semantic_super, pure __semantic_global ... "Object")
-    ])
+    ]))
 
-  , ("(FalseClass)", Core.record
+  , ("(FalseClass)", ann (Core.record
     [ (__semantic_super, pure __semantic_global ... "Class")
     , (__semantic_super, pure __semantic_global ... "(Object)")
-    ])
-  , ("FalseClass", Core.record
+    ]))
+  , ("FalseClass", ann (Core.record
     [ (__semantic_super, pure __semantic_global ... "(FalseClass)")
     , (__semantic_super, pure __semantic_global ... "Object")
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
-    ])
+    ]))
 
   , ("nil"  , pure __semantic_global ... "NilClass"   $$$ "new")
   , ("true" , pure __semantic_global ... "TrueClass"  $$$ "new")

From 9ffd3f87e5a7a3e13d100cf8aa60492f53f6def7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:51:06 -0400
Subject: [PATCH 052/151] Annotate the entire prelude, not just the composition
 with ann.

---
 semantic-core/src/Analysis/Eval.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 100f6706d..188440e6a 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -132,7 +132,7 @@ prog6 =
   ]
 
 ruby :: File (Term Core User)
-ruby = fromBody . ann . rec (named' __semantic_global) $ Core.record
+ruby = fromBody $ ann (rec (named' __semantic_global) (Core.record
   [ ("Class", ann (Core.record
     [ (__semantic_super, pure __semantic_global ... "Object")
     , ("new", lam (named' "self")
@@ -184,7 +184,7 @@ ruby = fromBody . ann . rec (named' __semantic_global) $ Core.record
   , ("false", pure __semantic_global ... "FalseClass" $$$ "new")
 
   , ("require", lam (named' "path") (Core.load (pure "path")))
-  ]
+  ]))
   where self $$$ method = annWith callStack $ named' "_x" :<- self >>>= pure "_x" ... method $$ pure "_x"
         record ... field = annWith callStack $ record Core.... field
 

From 77cb532ae4184091958a558b19febc4ce391ac0d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 11:57:11 -0400
Subject: [PATCH 053/151] Annotate prog5 deeply.

---
 semantic-core/src/Analysis/Eval.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 188440e6a..99973455e 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -111,15 +111,15 @@ prog4 = fromBody
     (Core.bool False))
 
 prog5 :: File (Term Core User)
-prog5 = fromBody $ binds
-  [ named' "mkPoint" :<- lams [named' "_x", named' "_y"] (Core.record
-    [ ("x", pure "_x")
-    , ("y", pure "_y")
-    ])
-  , named' "point" :<- pure "mkPoint" $$ Core.bool True $$ Core.bool False
+prog5 = fromBody $ ann (binds
+  [ named' "mkPoint" :<- lams [named' "_x", named' "_y"] (ann (Core.record
+    [ ("x", ann (pure "_x"))
+    , ("y", ann (pure "_y"))
+    ]))
+  , named' "point" :<- ann (ann (ann (pure "mkPoint") $$ ann (Core.bool True)) $$ ann (Core.bool False))
   ]
-  (   pure "point" Core.... "x"
-  >>> pure "point" Core.... "y" .= pure "point" Core.... "x")
+  (ann (   ann (ann (pure "point") Core.... "x")
+       >>> ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x"))))
 
 prog6 :: [File (Term Core User)]
 prog6 =

From 2a600397b244e4ce9d1d29b9098fd7641da45ead Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 12:06:15 -0400
Subject: [PATCH 054/151] Closures close over their lexical environment once
 more.

---
 semantic-core/src/Analysis/Concrete.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 4b048504e..bbe43a77e 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -40,7 +40,7 @@ newtype FrameId = FrameId { unFrameId :: Precise }
   deriving (Eq, Ord, Show)
 
 data Concrete
-  = Closure Loc User (Term Core.Core User)
+  = Closure Loc User (Term Core.Core User) Env
   | Unit
   | Bool Bool
   | String Text
@@ -99,12 +99,13 @@ concreteAnalysis = Analysis{..}
         assign addr value = modify (IntMap.insert addr value)
         abstract _ name body = do
           loc <- ask
-          pure (Closure loc name body)
-        apply eval (Closure loc name body) a = do
+          env <- ask
+          pure (Closure loc name body env)
+        apply eval (Closure loc name body env) a = do
           local (const loc) $ do
             addr <- alloc name
             assign addr a
-            bind name addr (eval body)
+            local (const (Map.insert name addr env)) (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure Unit
         bool b = pure (Bool b)
@@ -160,7 +161,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Unit -> G.empty
           Bool _ -> G.empty
           String _ -> G.empty
-          Closure _ _ _ -> G.empty
+          Closure _ _ _ env -> foldr (G.overlay . edge (Left Core.Lexical)) G.empty env
           Obj frame -> foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList frame)
 
 heapValueGraph :: Heap -> G.Graph Concrete
@@ -181,7 +182,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure (Loc p (Span s e)) n _ -> "\\\\ " <> n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Obj _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 

From d29928827dafcaa43fd3404032f2c93fc782745a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 12:07:51 -0400
Subject: [PATCH 055/151] Only close over the free variables.

---
 semantic-core/src/Analysis/Concrete.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index bbe43a77e..7bffbdc1d 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -28,6 +28,7 @@ import qualified Data.IntSet as IntSet
 import           Data.Loc
 import qualified Data.Map as Map
 import           Data.Name
+import qualified Data.Set as Set
 import           Data.Term
 import           Data.Text (Text, pack)
 import           Data.Traversable (for)
@@ -99,7 +100,7 @@ concreteAnalysis = Analysis{..}
         assign addr value = modify (IntMap.insert addr value)
         abstract _ name body = do
           loc <- ask
-          env <- ask
+          env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
           pure (Closure loc name body env)
         apply eval (Closure loc name body env) a = do
           local (const loc) $ do

From a1f41e155be2444d1a787c2fe1fcd06ced6427f3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 12:08:20 -0400
Subject: [PATCH 056/151] Rename Obj to Record.

---
 semantic-core/src/Analysis/Concrete.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 7bffbdc1d..2b29cc795 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -45,12 +45,12 @@ data Concrete
   | Unit
   | Bool Bool
   | String Text
-  | Obj Env
+  | Record Env
   deriving (Eq, Ord, Show)
 
 objectFrame :: Concrete -> Maybe Env
-objectFrame (Obj frame) = Just frame
-objectFrame _           = Nothing
+objectFrame (Record frame) = Just frame
+objectFrame _              = Nothing
 
 newtype Frame = Frame
   { frameSlots :: Env
@@ -122,7 +122,7 @@ concreteAnalysis = Analysis{..}
             addr <- alloc name
             assign addr value
             pure (name, addr)
-          pure (Obj (Map.fromList fields'))
+          pure (Record (Map.fromList fields'))
         addr ... n = do
           val <- deref addr
           heap <- get
@@ -163,7 +163,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Bool _ -> G.empty
           String _ -> G.empty
           Closure _ _ _ env -> foldr (G.overlay . edge (Left Core.Lexical)) G.empty env
-          Obj frame -> foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList frame)
+          Record frame -> foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList frame)
 
 heapValueGraph :: Heap -> G.Graph Concrete
 heapValueGraph h = heapGraph (const id) (const fromAddr) h
@@ -184,7 +184,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Bool b -> pack $ show b
           String s -> pack $ show s
           Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
-          Obj _ -> "{}"
+          Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 
 data EdgeType

From 900bdbe426926b38b90a6c134e9cae96f479d2b2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 12:08:41 -0400
Subject: [PATCH 057/151] Rename objectFrame to recordFrame.

---
 semantic-core/src/Analysis/Concrete.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 2b29cc795..10e054b83 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -48,9 +48,9 @@ data Concrete
   | Record Env
   deriving (Eq, Ord, Show)
 
-objectFrame :: Concrete -> Maybe Env
-objectFrame (Record frame) = Just frame
-objectFrame _              = Nothing
+recordFrame :: Concrete -> Maybe Env
+recordFrame (Record frame) = Just frame
+recordFrame _              = Nothing
 
 newtype Frame = Frame
   { frameSlots :: Env
@@ -132,7 +132,7 @@ concreteAnalysis = Analysis{..}
 lookupConcrete :: Heap -> User -> Concrete -> Maybe Precise
 lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value
-        inConcrete = inFrame <=< maybeA . objectFrame
+        inConcrete = inFrame <=< maybeA . recordFrame
         -- look up the name in a specific 'Frame', with slots taking precedence over parents
         inFrame fs = maybeA (Map.lookup name fs) <|> (maybeA (Map.lookup "__semantic_super" fs) >>= inAddress)
         -- look up the name in the value an address points to, if we haven’t already visited it

From acfcee116f56ff897f27491d4c3feeeef0ce8048 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 13:05:01 -0400
Subject: [PATCH 058/151] Bind the Ruby prelude sequentially.

---
 semantic-core/src/Analysis/Eval.hs | 96 ++++++++++++++++++------------
 1 file changed, 58 insertions(+), 38 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 99973455e..152eb09d3 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -132,59 +132,79 @@ prog6 =
   ]
 
 ruby :: File (Term Core User)
-ruby = fromBody $ ann (rec (named' __semantic_global) (Core.record
-  [ ("Class", ann (Core.record
-    [ (__semantic_super, pure __semantic_global ... "Object")
-    , ("new", lam (named' "self")
+ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (binds
+  [ named' "Class" :<- ann (Core.record
+    [ ("new", lam (named' "self")
       (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
       >>>= pure "instance" $$$ "initialize"))
-    ]))
+    ])
 
-  , ("(Object)", ann (Core.record [ (__semantic_super, pure __semantic_global ... "Class") ]))
-  , ("Object", ann (Core.record
-    [ (__semantic_super, pure __semantic_global ... "(Object)")
+  , named' "(Object)" :<- ann (Core.record [ (__semantic_super, pure "Class") ])
+  , named' "Object" :<- ann (Core.record
+    [ (__semantic_super, pure "(Object)")
     , ("nil?", lam (named' "_") (pure __semantic_global ... "false"))
     , ("initialize", lam (named' "self") (pure "self"))
     , (__semantic_truthy, lam (named' "_") (Core.bool True))
-    ]))
+    ])
 
-  , ("(NilClass)", ann (Core.record
+  , named' "(NilClass)" :<- ann (Core.record
     -- FIXME: what should we do about multiple import edges like this
-    [ (__semantic_super, pure __semantic_global ... "Class")
-    , (__semantic_super, pure __semantic_global ... "(Object)")
-    ]))
-  , ("NilClass", ann (Core.record
-    [ (__semantic_super, pure __semantic_global ... "(NilClass)")
-    , (__semantic_super, pure __semantic_global ... "Object")
+    [ (__semantic_super, pure "Class")
+    , (__semantic_super, pure "(Object)")
+    ])
+  , named' "NilClass" :<- ann (Core.record
+    [ (__semantic_super, pure "(NilClass)")
+    , (__semantic_super, pure "Object")
     , ("nil?", lam (named' "_") (pure __semantic_global ... "true"))
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
-    ]))
+    ])
 
-  , ("(TrueClass)", ann (Core.record
-    [ (__semantic_super, pure __semantic_global ... "Class")
-    , (__semantic_super, pure __semantic_global ... "(Object)")
-    ]))
-  , ("TrueClass", ann (Core.record
-    [ (__semantic_super, pure __semantic_global ... "(TrueClass)")
-    , (__semantic_super, pure __semantic_global ... "Object")
-    ]))
+  , named' "(TrueClass)" :<- ann (Core.record
+    [ (__semantic_super, pure "Class")
+    , (__semantic_super, pure "(Object)")
+    ])
+  , named' "TrueClass" :<- ann (Core.record
+    [ (__semantic_super, pure "(TrueClass)")
+    , (__semantic_super, pure "Object")
+    ])
 
-  , ("(FalseClass)", ann (Core.record
-    [ (__semantic_super, pure __semantic_global ... "Class")
-    , (__semantic_super, pure __semantic_global ... "(Object)")
-    ]))
-  , ("FalseClass", ann (Core.record
-    [ (__semantic_super, pure __semantic_global ... "(FalseClass)")
-    , (__semantic_super, pure __semantic_global ... "Object")
+  , named' "(FalseClass)" :<- ann (Core.record
+    [ (__semantic_super, pure "Class")
+    , (__semantic_super, pure "(Object)")
+    ])
+  , named' "FalseClass" :<- ann (Core.record
+    [ (__semantic_super, pure "(FalseClass)")
+    , (__semantic_super, pure "Object")
     , (__semantic_truthy, lam (named' "_") (Core.bool False))
-    ]))
+    ])
 
-  , ("nil"  , pure __semantic_global ... "NilClass"   $$$ "new")
-  , ("true" , pure __semantic_global ... "TrueClass"  $$$ "new")
-  , ("false", pure __semantic_global ... "FalseClass" $$$ "new")
+  , named' "nil"   :<- pure "NilClass"   $$$ "new"
+  , named' "true"  :<- pure "TrueClass"  $$$ "new"
+  , named' "false" :<- pure "FalseClass" $$$ "new"
 
-  , ("require", lam (named' "path") (Core.load (pure "path")))
-  ]))
+  , named' "require" :<- lam (named' "path") (Core.load (pure "path"))
+  ]
+  (Core.record (map ((,) <*> pure)
+    [ "Class"
+    , "(Object)"
+    , "Object"
+    , "(NilClass)"
+    , "NilClass"
+    , "(TrueClass)"
+    , "TrueClass"
+    , "(FalseClass)"
+    , "FalseClass"
+    , "nil"
+    , "true"
+    , "false"
+    , "require"
+
+    , "nil"
+    , "true"
+    , "false"
+
+    , "require"
+    ]))))
   where self $$$ method = annWith callStack $ named' "_x" :<- self >>>= pure "_x" ... method $$ pure "_x"
         record ... field = annWith callStack $ record Core.... field
 

From 3f7ac5eb50adddb9e815b31a70a94226a310f527 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 13:06:46 -0400
Subject: [PATCH 059/151] Compute the fields of the record.

---
 semantic-core/src/Analysis/Eval.hs | 116 ++++++++++++-----------------
 1 file changed, 49 insertions(+), 67 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 152eb09d3..ee414405a 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -133,79 +133,61 @@ prog6 =
 
 ruby :: File (Term Core User)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (binds
-  [ named' "Class" :<- ann (Core.record
-    [ ("new", lam (named' "self")
-      (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
-      >>>= pure "instance" $$$ "initialize"))
-    ])
+  bindings
+  (Core.record (map (\ (Named _ v :<- _) -> (v, pure v)) bindings))))
+  where bindings =
+          [ named' "Class" :<- ann (Core.record
+            [ ("new", lam (named' "self")
+              (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
+              >>>= pure "instance" $$$ "initialize"))
+            ])
 
-  , named' "(Object)" :<- ann (Core.record [ (__semantic_super, pure "Class") ])
-  , named' "Object" :<- ann (Core.record
-    [ (__semantic_super, pure "(Object)")
-    , ("nil?", lam (named' "_") (pure __semantic_global ... "false"))
-    , ("initialize", lam (named' "self") (pure "self"))
-    , (__semantic_truthy, lam (named' "_") (Core.bool True))
-    ])
+          , named' "(Object)" :<- ann (Core.record [ (__semantic_super, pure "Class") ])
+          , named' "Object" :<- ann (Core.record
+            [ (__semantic_super, pure "(Object)")
+            , ("nil?", lam (named' "_") (pure __semantic_global ... "false"))
+            , ("initialize", lam (named' "self") (pure "self"))
+            , (__semantic_truthy, lam (named' "_") (Core.bool True))
+            ])
 
-  , named' "(NilClass)" :<- ann (Core.record
-    -- FIXME: what should we do about multiple import edges like this
-    [ (__semantic_super, pure "Class")
-    , (__semantic_super, pure "(Object)")
-    ])
-  , named' "NilClass" :<- ann (Core.record
-    [ (__semantic_super, pure "(NilClass)")
-    , (__semantic_super, pure "Object")
-    , ("nil?", lam (named' "_") (pure __semantic_global ... "true"))
-    , (__semantic_truthy, lam (named' "_") (Core.bool False))
-    ])
+          , named' "(NilClass)" :<- ann (Core.record
+            -- FIXME: what should we do about multiple import edges like this
+            [ (__semantic_super, pure "Class")
+            , (__semantic_super, pure "(Object)")
+            ])
+          , named' "NilClass" :<- ann (Core.record
+            [ (__semantic_super, pure "(NilClass)")
+            , (__semantic_super, pure "Object")
+            , ("nil?", lam (named' "_") (pure __semantic_global ... "true"))
+            , (__semantic_truthy, lam (named' "_") (Core.bool False))
+            ])
 
-  , named' "(TrueClass)" :<- ann (Core.record
-    [ (__semantic_super, pure "Class")
-    , (__semantic_super, pure "(Object)")
-    ])
-  , named' "TrueClass" :<- ann (Core.record
-    [ (__semantic_super, pure "(TrueClass)")
-    , (__semantic_super, pure "Object")
-    ])
+          , named' "(TrueClass)" :<- ann (Core.record
+            [ (__semantic_super, pure "Class")
+            , (__semantic_super, pure "(Object)")
+            ])
+          , named' "TrueClass" :<- ann (Core.record
+            [ (__semantic_super, pure "(TrueClass)")
+            , (__semantic_super, pure "Object")
+            ])
 
-  , named' "(FalseClass)" :<- ann (Core.record
-    [ (__semantic_super, pure "Class")
-    , (__semantic_super, pure "(Object)")
-    ])
-  , named' "FalseClass" :<- ann (Core.record
-    [ (__semantic_super, pure "(FalseClass)")
-    , (__semantic_super, pure "Object")
-    , (__semantic_truthy, lam (named' "_") (Core.bool False))
-    ])
+          , named' "(FalseClass)" :<- ann (Core.record
+            [ (__semantic_super, pure "Class")
+            , (__semantic_super, pure "(Object)")
+            ])
+          , named' "FalseClass" :<- ann (Core.record
+            [ (__semantic_super, pure "(FalseClass)")
+            , (__semantic_super, pure "Object")
+            , (__semantic_truthy, lam (named' "_") (Core.bool False))
+            ])
 
-  , named' "nil"   :<- pure "NilClass"   $$$ "new"
-  , named' "true"  :<- pure "TrueClass"  $$$ "new"
-  , named' "false" :<- pure "FalseClass" $$$ "new"
+          , named' "nil"   :<- pure "NilClass"   $$$ "new"
+          , named' "true"  :<- pure "TrueClass"  $$$ "new"
+          , named' "false" :<- pure "FalseClass" $$$ "new"
 
-  , named' "require" :<- lam (named' "path") (Core.load (pure "path"))
-  ]
-  (Core.record (map ((,) <*> pure)
-    [ "Class"
-    , "(Object)"
-    , "Object"
-    , "(NilClass)"
-    , "NilClass"
-    , "(TrueClass)"
-    , "TrueClass"
-    , "(FalseClass)"
-    , "FalseClass"
-    , "nil"
-    , "true"
-    , "false"
-    , "require"
-
-    , "nil"
-    , "true"
-    , "false"
-
-    , "require"
-    ]))))
-  where self $$$ method = annWith callStack $ named' "_x" :<- self >>>= pure "_x" ... method $$ pure "_x"
+          , named' "require" :<- lam (named' "path") (Core.load (pure "path"))
+          ]
+        self $$$ method = annWith callStack $ named' "_x" :<- self >>>= pure "_x" ... method $$ pure "_x"
         record ... field = annWith callStack $ record Core.... field
 
         __semantic_global = "__semantic_global"

From 37caa4d759793847b8687e1822c75dfcff3e7aaf Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 13:23:21 -0400
Subject: [PATCH 060/151] Annotate the Ruby prelude deeply.

---
 semantic-core/src/Analysis/Eval.hs | 99 ++++++++++++++++--------------
 1 file changed, 53 insertions(+), 46 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index ee414405a..0d6120899 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -134,61 +134,68 @@ prog6 =
 ruby :: File (Term Core User)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (binds
   bindings
-  (Core.record (map (\ (Named _ v :<- _) -> (v, pure v)) bindings))))
+  (record (map (\ (v :<- _) -> (v, var v)) bindings))))
   where bindings =
-          [ named' "Class" :<- ann (Core.record
-            [ ("new", lam (named' "self")
-              (    named' "instance" :<- Core.record [ (__semantic_super, pure "self") ]
-              >>>= pure "instance" $$$ "initialize"))
-            ])
+          [ "Class" :<- record
+            [ ("new", lam "self"
+              (    "instance" :<- record [ (__semantic_super, var "self") ]
+              >>>= var "instance" $$$ "initialize"))
+            ]
 
-          , named' "(Object)" :<- ann (Core.record [ (__semantic_super, pure "Class") ])
-          , named' "Object" :<- ann (Core.record
-            [ (__semantic_super, pure "(Object)")
-            , ("nil?", lam (named' "_") (pure __semantic_global ... "false"))
-            , ("initialize", lam (named' "self") (pure "self"))
-            , (__semantic_truthy, lam (named' "_") (Core.bool True))
-            ])
+          , "(Object)" :<- record [ (__semantic_super, var "Class") ]
+          , "Object" :<- record
+            [ (__semantic_super, var "(Object)")
+            , ("nil?", lam "_" (var __semantic_global ... "false"))
+            , ("initialize", lam "self" (var "self"))
+            , (__semantic_truthy, lam "_" (bool True))
+            ]
 
-          , named' "(NilClass)" :<- ann (Core.record
+          , "(NilClass)" :<- record
             -- FIXME: what should we do about multiple import edges like this
-            [ (__semantic_super, pure "Class")
-            , (__semantic_super, pure "(Object)")
-            ])
-          , named' "NilClass" :<- ann (Core.record
-            [ (__semantic_super, pure "(NilClass)")
-            , (__semantic_super, pure "Object")
-            , ("nil?", lam (named' "_") (pure __semantic_global ... "true"))
-            , (__semantic_truthy, lam (named' "_") (Core.bool False))
-            ])
+            [ (__semantic_super, var "Class")
+            , (__semantic_super, var "(Object)")
+            ]
+          , "NilClass" :<- record
+            [ (__semantic_super, var "(NilClass)")
+            , (__semantic_super, var "Object")
+            , ("nil?", lam "_" (var __semantic_global ... "true"))
+            , (__semantic_truthy, lam "_" (bool False))
+            ]
 
-          , named' "(TrueClass)" :<- ann (Core.record
-            [ (__semantic_super, pure "Class")
-            , (__semantic_super, pure "(Object)")
-            ])
-          , named' "TrueClass" :<- ann (Core.record
-            [ (__semantic_super, pure "(TrueClass)")
-            , (__semantic_super, pure "Object")
-            ])
+          , "(TrueClass)" :<- record
+            [ (__semantic_super, var "Class")
+            , (__semantic_super, var "(Object)")
+            ]
+          , "TrueClass" :<- record
+            [ (__semantic_super, var "(TrueClass)")
+            , (__semantic_super, var "Object")
+            ]
 
-          , named' "(FalseClass)" :<- ann (Core.record
-            [ (__semantic_super, pure "Class")
-            , (__semantic_super, pure "(Object)")
-            ])
-          , named' "FalseClass" :<- ann (Core.record
-            [ (__semantic_super, pure "(FalseClass)")
-            , (__semantic_super, pure "Object")
-            , (__semantic_truthy, lam (named' "_") (Core.bool False))
-            ])
+          , "(FalseClass)" :<- record
+            [ (__semantic_super, var "Class")
+            , (__semantic_super, var "(Object)")
+            ]
+          , "FalseClass" :<- record
+            [ (__semantic_super, var "(FalseClass)")
+            , (__semantic_super, var "Object")
+            , (__semantic_truthy, lam "_" (bool False))
+            ]
 
-          , named' "nil"   :<- pure "NilClass"   $$$ "new"
-          , named' "true"  :<- pure "TrueClass"  $$$ "new"
-          , named' "false" :<- pure "FalseClass" $$$ "new"
+          , "nil"   :<- var "NilClass"   $$$ "new"
+          , "true"  :<- var "TrueClass"  $$$ "new"
+          , "false" :<- var "FalseClass" $$$ "new"
 
-          , named' "require" :<- lam (named' "path") (Core.load (pure "path"))
+          , "require" :<- lam "path" (Core.load (var "path"))
           ]
-        self $$$ method = annWith callStack $ named' "_x" :<- self >>>= pure "_x" ... method $$ pure "_x"
-        record ... field = annWith callStack $ record Core.... field
+        self $$$ method = annWith callStack ("_x" :<- self >>>= var "_x" ... method $$ var "_x")
+        record ... field = annWith callStack (record Core.... field)
+        record bindings = annWith callStack (Core.record bindings)
+        var x = annWith callStack (pure x)
+        lam v b = annWith callStack (Core.lam (named' v) b)
+        v :<- a >>>= b = annWith callStack (named' v :<- a Core.>>>= b)
+        infixr 1 >>>=
+        binds bindings body = foldr (>>>=) body bindings
+        bool b = annWith callStack (Core.bool b)
 
         __semantic_global = "__semantic_global"
         __semantic_super  = "__semantic_super"

From 0c80fd246c74eb9ad82723bbf3f8c923713774ae Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 13:32:52 -0400
Subject: [PATCH 061/151] Set the super field.

---
 semantic-core/src/Analysis/Eval.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 0d6120899..482a05956 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -134,10 +134,12 @@ prog6 =
 ruby :: File (Term Core User)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (binds
   bindings
-  (record (map (\ (v :<- _) -> (v, var v)) bindings))))
+  (   var "Class" ... __semantic_super .= var "Object"
+  >>> record (map (\ (v :<- _) -> (v, var v)) bindings))))
   where bindings =
           [ "Class" :<- record
-            [ ("new", lam "self"
+            [ (__semantic_super, Core.record [])
+            , ("new", lam "self"
               (    "instance" :<- record [ (__semantic_super, var "self") ]
               >>>= var "instance" $$$ "initialize"))
             ]
@@ -192,10 +194,13 @@ ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (binds
         record bindings = annWith callStack (Core.record bindings)
         var x = annWith callStack (pure x)
         lam v b = annWith callStack (Core.lam (named' v) b)
+        a >>> b = annWith callStack (a Core.>>> b)
+        infixr 1 >>>
         v :<- a >>>= b = annWith callStack (named' v :<- a Core.>>>= b)
         infixr 1 >>>=
         binds bindings body = foldr (>>>=) body bindings
         bool b = annWith callStack (Core.bool b)
+        a .= b = annWith callStack (a Core..= b)
 
         __semantic_global = "__semantic_global"
         __semantic_super  = "__semantic_super"

From 69b21510b25e11c912c9ab07a05e5b6d45d83d0e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 13:38:02 -0400
Subject: [PATCH 062/151] Implement typechecking for records.

---
 semantic-core/src/Analysis/Typecheck.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 287981301..f2bf86596 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -122,7 +122,6 @@ typecheckingAnalysis
      , Member Fresh sig
      , Member (State (Set.Set Constraint)) sig
      , Member (State (Heap User (Term Monotype Meta))) sig
-     , MonadFail m
      )
   => Analysis User (Term Monotype Meta) m
 typecheckingAnalysis = Analysis{..}
@@ -149,7 +148,7 @@ typecheckingAnalysis = Analysis{..}
         asBool b = unify (Term Bool) b >> pure True <|> pure False
         string _ = pure (Term String)
         asString s = unify (Term String) s $> mempty
-        record _ = fail "unimplemented"
+        record fields = pure (Term (Record (Map.fromList fields)))
         _ ... m = pure (Just m)
 
 

From 325dc9d8a29a166a6400ffb787f39ebb98a2f9d1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:19:17 -0400
Subject: [PATCH 063/151] :fire: some redundant FIXMEs.

---
 semantic-core/src/Analysis/Concrete.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 10e054b83..05f052229 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -115,8 +115,6 @@ concreteAnalysis = Analysis{..}
         string s = pure (String s)
         asString (String s) = pure s
         asString v          = fail $ "Cannot coerce " <> show v <> " to String"
-        -- FIXME: differential inheritance (reference fields instead of copying)
-        -- FIXME: copy non-lexical parents deeply?
         record fields = do
           fields' <- for fields $ \ (name, value) -> do
             addr <- alloc name

From 45a3d6f0c1036d04bcacdc754caabdec4dd8045d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:24:40 -0400
Subject: [PATCH 064/151] Fix the generators.

---
 semantic-core/test/Generators.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index 667830b95..1dd8b0909 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -51,7 +51,7 @@ lambda bod = do
   Gen.subterm bod (lam arg)
 
 atoms :: MonadGen m => [m (Term Core User)]
-atoms = [boolean, variable, pure unit, pure frame]
+atoms = [boolean, variable, pure unit]
 
 literal :: MonadGen m => m (Term Core User)
 literal = Gen.recursive Gen.choice atoms [lambda literal]

From 95226623bfef354b145168cb269b11e610487760 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:26:49 -0400
Subject: [PATCH 065/151] :fire: redundant specs.

---
 semantic-core/test/Spec.hs | 8 --------
 1 file changed, 8 deletions(-)

diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs
index 6680cd750..bd8ab0fb6 100644
--- a/semantic-core/test/Spec.hs
+++ b/semantic-core/test/Spec.hs
@@ -79,12 +79,6 @@ assert_unicode_lambda_parse = "λa → a" `parsesInto` lam (named' "a") a
 assert_quoted_name_parse :: Assertion
 assert_quoted_name_parse = "#{(NilClass)}" `parsesInto` pure "(NilClass)"
 
-assert_let_dot_precedence :: Assertion
-assert_let_dot_precedence = "let a = f.g.h" `parsesInto` (let' "a" .= (f ... g ... h))
-
-assert_let_in_push_precedence :: Assertion
-assert_let_in_push_precedence = "f.let g = h" `parsesInto` (f ... (let' "g" .= h))
-
 parserSpecs :: TestTree
 parserSpecs = testGroup "Parsing: simple specs"
   [ testCase "true/false" assert_booleans_parse
@@ -95,8 +89,6 @@ parserSpecs = testGroup "Parsing: simple specs"
   , testCase "lambda with ASCII syntax" assert_ascii_lambda_parse
   , testCase "lambda with unicode syntax" assert_unicode_lambda_parse
   , testCase "quoted names" assert_quoted_name_parse
-  , testCase "let + dot precedence" assert_let_dot_precedence
-  , testCase "let in push" assert_let_in_push_precedence
   ]
 
 assert_roundtrips :: File (Term Core User) -> Assertion

From ed94f7e5c32ed944636099a8ca49b3251ceb1fa2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:27:03 -0400
Subject: [PATCH 066/151] Fix the expectation for projections.

---
 semantic-core/test/Spec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs
index bd8ab0fb6..b8e8672ae 100644
--- a/semantic-core/test/Spec.hs
+++ b/semantic-core/test/Spec.hs
@@ -68,7 +68,7 @@ assert_application_left_associative :: Assertion
 assert_application_left_associative = "f g h" `parsesInto` (f $$ g $$ h)
 
 assert_push_left_associative :: Assertion
-assert_push_left_associative = "f.g.h" `parsesInto` (f ... g ... h)
+assert_push_left_associative = "f.g.h" `parsesInto` (f ... "g" ... "h")
 
 assert_ascii_lambda_parse :: Assertion
 assert_ascii_lambda_parse = "\\a -> a" `parsesInto` lam (named' "a") a

From a25d97125004c5f7ddf6edee354c3a415834a003 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:32:05 -0400
Subject: [PATCH 067/151] Better pretty-printing of parse errors.

---
 semantic-core/test/Spec.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs
index b8e8672ae..9ea3f2a17 100644
--- a/semantic-core/test/Spec.hs
+++ b/semantic-core/test/Spec.hs
@@ -92,7 +92,9 @@ parserSpecs = testGroup "Parsing: simple specs"
   ]
 
 assert_roundtrips :: File (Term Core User) -> Assertion
-assert_roundtrips (File _ core) = parseEither Parse.core (showCore core) @?= Right (stripAnnotations core)
+assert_roundtrips (File _ core) = case parseEither Parse.core (showCore core) of
+  Right v -> v @?= stripAnnotations core
+  Left e -> assertFailure e
 
 parserExamples :: TestTree
 parserExamples = testGroup "Parsing: Eval.hs examples"

From 724ae1763f54a113e2038869f30e1ff31b40e872 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:42:46 -0400
Subject: [PATCH 068/151] Allow binds to process non-binding statements.

---
 semantic-core/src/Analysis/Eval.hs | 4 ++--
 semantic-core/src/Data/Core.hs     | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 482a05956..29bcd6782 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -112,11 +112,11 @@ prog4 = fromBody
 
 prog5 :: File (Term Core User)
 prog5 = fromBody $ ann (binds
-  [ named' "mkPoint" :<- lams [named' "_x", named' "_y"] (ann (Core.record
+  [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
     , ("y", ann (pure "_y"))
     ]))
-  , named' "point" :<- ann (ann (ann (pure "mkPoint") $$ ann (Core.bool True)) $$ ann (Core.bool False))
+  , Just (named' "point") :<- ann (ann (ann (pure "mkPoint") $$ ann (Core.bool True)) $$ ann (Core.bool False))
   ]
   (ann (   ann (ann (pure "point") Core.... "x")
        >>> ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x"))))
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index f7b161faf..bf9aedf66 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -139,8 +139,8 @@ Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
 
 infixr 1 >>>=
 
-binds :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Named a :<- m a) -> m a -> m a
-binds bindings body = foldr (>>>=) body bindings
+binds :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a -> m a
+binds bindings body = foldr (\ (n :<- a) -> maybe (a >>>) ((>>>=) . (:<- a)) n) body bindings
 
 data a :<- b = a :<- b
   deriving (Eq, Ord, Show)

From 0797316eadc838f8d4241e9e1c0df18d5abb2aea Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:43:56 -0400
Subject: [PATCH 069/151] Rename binds to do'.

---
 semantic-core/src/Analysis/Eval.hs | 6 +++---
 semantic-core/src/Data/Core.hs     | 6 +++---
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 29bcd6782..96ceaa066 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -111,7 +111,7 @@ prog4 = fromBody
     (Core.bool False))
 
 prog5 :: File (Term Core User)
-prog5 = fromBody $ ann (binds
+prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
     , ("y", ann (pure "_y"))
@@ -132,7 +132,7 @@ prog6 =
   ]
 
 ruby :: File (Term Core User)
-ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (binds
+ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do'
   bindings
   (   var "Class" ... __semantic_super .= var "Object"
   >>> record (map (\ (v :<- _) -> (v, var v)) bindings))))
@@ -198,7 +198,7 @@ ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (binds
         infixr 1 >>>
         v :<- a >>>= b = annWith callStack (named' v :<- a Core.>>>= b)
         infixr 1 >>>=
-        binds bindings body = foldr (>>>=) body bindings
+        do' bindings body = foldr (>>>=) body bindings
         bool b = annWith callStack (Core.bool b)
         a .= b = annWith callStack (a Core..= b)
 
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index bf9aedf66..dfd060ec0 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -7,7 +7,7 @@ module Data.Core
 , (>>>)
 , block
 , (>>>=)
-, binds
+, do'
 , (:<-)(..)
 , lam
 , lams
@@ -139,8 +139,8 @@ Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
 
 infixr 1 >>>=
 
-binds :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a -> m a
-binds bindings body = foldr (\ (n :<- a) -> maybe (a >>>) ((>>>=) . (:<- a)) n) body bindings
+do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a -> m a
+do' bindings body = foldr (\ (n :<- a) -> maybe (a >>>) ((>>>=) . (:<- a)) n) body bindings
 
 data a :<- b = a :<- b
   deriving (Eq, Ord, Show)

From 1ce41531482abdd9cd18a8142ca42ad8360a9561 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:52:54 -0400
Subject: [PATCH 070/151] =?UTF-8?q?do'=20doesn=E2=80=99t=20take=20an=20exp?=
 =?UTF-8?q?licit=20body.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Analysis/Eval.hs | 6 +++---
 semantic-core/src/Data/Core.hs     | 6 ++++--
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 96ceaa066..db2b15c9d 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -117,9 +117,9 @@ prog5 = fromBody $ ann (do'
     , ("y", ann (pure "_y"))
     ]))
   , Just (named' "point") :<- ann (ann (ann (pure "mkPoint") $$ ann (Core.bool True)) $$ ann (Core.bool False))
-  ]
-  (ann (   ann (ann (pure "point") Core.... "x")
-       >>> ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x"))))
+  , Nothing :<- ann (ann (pure "point") Core.... "x")
+  , Nothing :<- ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x")
+  ])
 
 prog6 :: [File (Term Core User)]
 prog6 =
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index dfd060ec0..64bc1c9d6 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -38,6 +38,7 @@ import Control.Monad.Module
 import Data.Foldable (foldl')
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Loc
+import Data.Maybe (fromMaybe)
 import Data.Name
 import Data.Scope
 import Data.Stack
@@ -139,8 +140,9 @@ Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
 
 infixr 1 >>>=
 
-do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a -> m a
-do' bindings body = foldr (\ (n :<- a) -> maybe (a >>>) ((>>>=) . (:<- a)) n) body bindings
+do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a
+do' bindings = fromMaybe unit (foldr bind Nothing bindings)
+  where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a
 
 data a :<- b = a :<- b
   deriving (Eq, Ord, Show)

From b8bcad0126980a016624a85f9f1d574f05f9c725 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 14:53:54 -0400
Subject: [PATCH 071/151] Use do' instead of block.

---
 semantic-core/src/Analysis/Eval.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index db2b15c9d..f6a1aff94 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -125,10 +125,10 @@ prog6 :: [File (Term Core User)]
 prog6 =
   [ File (Loc "dep"  (locSpan (fromJust here))) $ Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
-  , File (Loc "main" (locSpan (fromJust here))) $ block
+  , File (Loc "main" (locSpan (fromJust here))) $ do' (map (Nothing :<-)
     [ load (Core.string "dep")
     , Core.record [ ("thing", pure "dep" Core.... "var") ]
-    ]
+    ])
   ]
 
 ruby :: File (Term Core User)

From a39e7730eacdc77198f3aae196dc87f5933c0d60 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 15:02:10 -0400
Subject: [PATCH 072/151] Follow the do' model for the Ruby prelude.

---
 semantic-core/src/Analysis/Eval.hs | 42 ++++++++++++++++--------------
 1 file changed, 22 insertions(+), 20 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index f6a1aff94..2e68a8530 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -11,6 +11,7 @@ module Analysis.Eval
 , Analysis(..)
 ) where
 
+import Control.Applicative (Alternative (..))
 import Control.Effect.Fail
 import Control.Effect.Reader
 import Control.Monad ((>=>))
@@ -18,7 +19,7 @@ import Data.Core as Core
 import Data.File
 import Data.Functor
 import Data.Loc
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
 import Data.Name
 import Data.Scope
 import Data.Term
@@ -132,62 +133,62 @@ prog6 =
   ]
 
 ruby :: File (Term Core User)
-ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do'
-  bindings
-  (   var "Class" ... __semantic_super .= var "Object"
-  >>> record (map (\ (v :<- _) -> (v, var v)) bindings))))
-  where bindings =
-          [ "Class" :<- record
+ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
+  where statements =
+          [ Just "Class" :<- record
             [ (__semantic_super, Core.record [])
             , ("new", lam "self"
               (    "instance" :<- record [ (__semantic_super, var "self") ]
               >>>= var "instance" $$$ "initialize"))
             ]
 
-          , "(Object)" :<- record [ (__semantic_super, var "Class") ]
-          , "Object" :<- record
+          , Just "(Object)" :<- record [ (__semantic_super, var "Class") ]
+          , Just "Object" :<- record
             [ (__semantic_super, var "(Object)")
             , ("nil?", lam "_" (var __semantic_global ... "false"))
             , ("initialize", lam "self" (var "self"))
             , (__semantic_truthy, lam "_" (bool True))
             ]
 
-          , "(NilClass)" :<- record
+          , Just "(NilClass)" :<- record
             -- FIXME: what should we do about multiple import edges like this
             [ (__semantic_super, var "Class")
             , (__semantic_super, var "(Object)")
             ]
-          , "NilClass" :<- record
+          , Just "NilClass" :<- record
             [ (__semantic_super, var "(NilClass)")
             , (__semantic_super, var "Object")
             , ("nil?", lam "_" (var __semantic_global ... "true"))
             , (__semantic_truthy, lam "_" (bool False))
             ]
 
-          , "(TrueClass)" :<- record
+          , Just "(TrueClass)" :<- record
             [ (__semantic_super, var "Class")
             , (__semantic_super, var "(Object)")
             ]
-          , "TrueClass" :<- record
+          , Just "TrueClass" :<- record
             [ (__semantic_super, var "(TrueClass)")
             , (__semantic_super, var "Object")
             ]
 
-          , "(FalseClass)" :<- record
+          , Just "(FalseClass)" :<- record
             [ (__semantic_super, var "Class")
             , (__semantic_super, var "(Object)")
             ]
-          , "FalseClass" :<- record
+          , Just "FalseClass" :<- record
             [ (__semantic_super, var "(FalseClass)")
             , (__semantic_super, var "Object")
             , (__semantic_truthy, lam "_" (bool False))
             ]
 
-          , "nil"   :<- var "NilClass"   $$$ "new"
-          , "true"  :<- var "TrueClass"  $$$ "new"
-          , "false" :<- var "FalseClass" $$$ "new"
+          , Just "nil"   :<- var "NilClass"   $$$ "new"
+          , Just "true"  :<- var "TrueClass"  $$$ "new"
+          , Just "false" :<- var "FalseClass" $$$ "new"
 
-          , "require" :<- lam "path" (Core.load (var "path"))
+          , Just "require" :<- lam "path" (Core.load (var "path"))
+
+          , Nothing :<- var "Class" ... __semantic_super .= var "Object"
+          , Nothing :<- record (statements >>= \ (v :<- _) -> maybe [] (\ v -> [(v, var v)]) v)
           ]
         self $$$ method = annWith callStack ("_x" :<- self >>>= var "_x" ... method $$ var "_x")
         record ... field = annWith callStack (record Core.... field)
@@ -198,7 +199,8 @@ ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do'
         infixr 1 >>>
         v :<- a >>>= b = annWith callStack (named' v :<- a Core.>>>= b)
         infixr 1 >>>=
-        do' bindings body = foldr (>>>=) body bindings
+        do' bindings = fromMaybe Core.unit (foldr bind Nothing bindings)
+          where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a
         bool b = annWith callStack (Core.bool b)
         a .= b = annWith callStack (a Core..= b)
 

From a77ecdbe78be9ce4e24ac72bbf54b00be2bcd54c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 15:04:46 -0400
Subject: [PATCH 073/151] Parse binding statements.

---
 semantic-core/src/Data/Core/Parser.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 56a52a3ee..f2f5e1099 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeOperators #-}
 module Data.Core.Parser
   ( module Text.Trifecta
   , core
@@ -67,7 +68,13 @@ atom = choice
   ]
 
 comp :: (TokenParsing m, Monad m) => m (Term Core User)
-comp = braces (Core.block <$> sepEndByNonEmpty expr semi) <?> "compound statement"
+comp = braces (Core.do' <$> sepEndByNonEmpty statement semi) <?> "compound statement"
+
+statement :: (TokenParsing m, Monad m) => m (Maybe (Named User) Core.:<- Term Core User)
+statement
+  =   try ((Core.:<-) . Just <$> name <* symbol "<-" <*> expr)
+  <|> (Nothing Core.:<-) <$> expr
+  <?> "statement"
 
 ifthenelse :: (TokenParsing m, Monad m) => m (Term Core User)
 ifthenelse = Core.if'

From f9eea3892a050e84991c4b9a66e19c2b5c711516 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 15:07:35 -0400
Subject: [PATCH 074/151] Print braces around nested binds.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 279a15788..13f5d9b1a 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -82,7 +82,7 @@ prettyCore style = run . runReader @Prec 0 . go
 
             Named (Ignored x) a :>>= b -> do
               prec <- ask @Prec
-              fore <- with 12 (go a)
+              fore <- with 11 (go a)
               aft  <- with 12 (go (instantiate1 (pure x) b))
 
               let open  = symbol ("{" <> softline)

From 52da8b764cf125330b5a5c9ce30a269d9b21af89 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 15:13:14 -0400
Subject: [PATCH 075/151] Qualify the import of Data.Core.

---
 semantic-core/test/Generators.hs | 30 +++++++++++++++---------------
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index 1dd8b0909..f82e65f8b 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -16,7 +16,7 @@ import Hedgehog hiding (Var)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 
-import Data.Core
+import qualified Data.Core as Core
 import Data.Name
 import Data.Term
 
@@ -27,31 +27,31 @@ name :: MonadGen m => m (Named User)
 name = Gen.prune ((Named . Ignored <*> id) <$> names) where
   names = Gen.text (Range.linear 1 10) Gen.lower
 
-boolean :: MonadGen m => m (Term Core User)
-boolean = bool <$> Gen.bool
+boolean :: MonadGen m => m (Term Core.Core User)
+boolean = Core.bool <$> Gen.bool
 
-variable :: MonadGen m => m (Term Core User)
+variable :: MonadGen m => m (Term Core.Core User)
 variable = pure . namedValue <$> name
 
-ifthenelse :: MonadGen m => m (Term Core User) -> m (Term Core User)
-ifthenelse bod = Gen.subterm3 boolean bod bod if'
+ifthenelse :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+ifthenelse bod = Gen.subterm3 boolean bod bod Core.if'
 
-apply :: MonadGen m => m (Term Core User) -> m (Term Core User)
+apply :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
 apply gen = go where
   go = Gen.recursive
     Gen.choice
-    [ Gen.subterm2 gen gen ($$)]
-    [ Gen.subterm2 go go ($$)  -- balanced
-    , Gen.subtermM go (\x -> lam <$> name <*> pure x)
+    [ Gen.subterm2 gen gen (Core.$$)]
+    [ Gen.subterm2 go go (Core.$$)  -- balanced
+    , Gen.subtermM go (\x -> Core.lam <$> name <*> pure x)
     ]
 
-lambda :: MonadGen m => m (Term Core User) -> m (Term Core User)
+lambda :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
 lambda bod = do
   arg <- name
-  Gen.subterm bod (lam arg)
+  Gen.subterm bod (Core.lam arg)
 
-atoms :: MonadGen m => [m (Term Core User)]
-atoms = [boolean, variable, pure unit]
+atoms :: MonadGen m => [m (Term Core.Core User)]
+atoms = [boolean, variable, pure Core.unit]
 
-literal :: MonadGen m => m (Term Core User)
+literal :: MonadGen m => m (Term Core.Core User)
 literal = Gen.recursive Gen.choice atoms [lambda literal]

From 043d3083fac21942de83d06780d9335a1cc54d4c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 15:26:02 -0400
Subject: [PATCH 076/151] Generate records.

---
 semantic-core/test/Generators.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index f82e65f8b..a1c235223 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -6,6 +6,7 @@ module Generators
   , variable
   , boolean
   , lambda
+  , record
   , apply
   , ifthenelse
   ) where
@@ -50,8 +51,11 @@ lambda bod = do
   arg <- name
   Gen.subterm bod (Core.lam arg)
 
+record :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . namedValue <$> name <*> bod)
+
 atoms :: MonadGen m => [m (Term Core.Core User)]
 atoms = [boolean, variable, pure Core.unit]
 
 literal :: MonadGen m => m (Term Core.Core User)
-literal = Gen.recursive Gen.choice atoms [lambda literal]
+literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]

From b43bdbb353ac2420dc04f07d6a020e9aab5ee291 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 15:33:47 -0400
Subject: [PATCH 077/151] Use named' to define the name generator.

---
 semantic-core/test/Generators.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index a1c235223..5057be775 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -25,7 +25,7 @@ import Data.Term
 -- fresh names for variables, since the length of variable names is not an
 -- interesting property as they parse regardless.
 name :: MonadGen m => m (Named User)
-name = Gen.prune ((Named . Ignored <*> id) <$> names) where
+name = Gen.prune (named' <$> names) where
   names = Gen.text (Range.linear 1 10) Gen.lower
 
 boolean :: MonadGen m => m (Term Core.Core User)

From 539f8db2f659cef2bae7eddb67ee0427c2f8bfa1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 15:42:08 -0400
Subject: [PATCH 078/151] Test roundtripping of general expressions.

---
 semantic-core/test/Generators.hs | 12 ++++++++++++
 semantic-core/test/Spec.hs       |  1 +
 2 files changed, 13 insertions(+)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index 5057be775..1963adb80 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -9,6 +9,7 @@ module Generators
   , record
   , apply
   , ifthenelse
+  , expr
   ) where
 
 import Prelude hiding (span)
@@ -59,3 +60,14 @@ atoms = [boolean, variable, pure Core.unit]
 
 literal :: MonadGen m => m (Term Core.Core User)
 literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]
+
+expr :: MonadGen m => m (Term Core.Core User)
+expr = Gen.recursive Gen.choice atoms
+  [ lambda expr
+  , record expr
+  , Gen.subterm2 expr expr (Core.$$)
+  , Gen.subterm3 expr expr expr Core.if'
+  , Gen.subterm2 expr expr (Core.>>>)
+  , Gen.subtermM2 expr expr (\ x y -> (Core.>>>= y) . (Core.:<- x) <$> name)
+  , Gen.subtermM expr (\ x -> (x Core....) . namedValue <$> name)
+  ]
diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs
index 9ea3f2a17..b877a4a1e 100644
--- a/semantic-core/test/Spec.hs
+++ b/semantic-core/test/Spec.hs
@@ -41,6 +41,7 @@ parserProps = testGroup "Parsing: roundtripping"
   , testProperty "if/then/else" . prop_roundtrips . Gen.ifthenelse $ Gen.variable
   , testProperty "lambda" . prop_roundtrips $ Gen.lambda Gen.literal
   , testProperty "function application" . prop_roundtrips $ Gen.apply Gen.variable
+  , testProperty "expressions" . prop_roundtrips $ Gen.expr
   ]
 
 -- * Parser specs

From 45723e71fc850e1818e79f617a536258a8362a68 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 16:19:22 -0400
Subject: [PATCH 079/151] Simplify the pretty-printing of sequences with a
 helper.

---
 semantic-core/src/Data/Core/Pretty.hs | 30 +++++++++++----------------
 1 file changed, 12 insertions(+), 18 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 13f5d9b1a..208a5cfb6 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -14,7 +14,7 @@ import           Data.File
 import           Data.Name
 import           Data.Scope
 import           Data.Term
-import           Data.Text.Prettyprint.Doc (Pretty (..), annotate, softline, (<+>))
+import           Data.Text.Prettyprint.Doc (Pretty (..), annotate, (<+>), vsep)
 import qualified Data.Text.Prettyprint.Doc as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
@@ -58,7 +58,13 @@ inParens :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m
 inParens amount go = do
   prec <- ask
   body <- with amount go
-  pure (encloseIf (amount >= prec) (symbol "(") (symbol ")") body)
+  pure (if amount > prec then Pretty.parens body else body)
+
+inBraces :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m AnsiDoc
+inBraces amount go = do
+  prec <- ask
+  body <- with amount go
+  pure (if amount > prec then Pretty.braces body else body)
 
 prettyCore :: Style -> Term Core User -> AnsiDoc
 prettyCore style = run . runReader @Prec 0 . go
@@ -68,29 +74,17 @@ prettyCore style = run . runReader @Prec 0 . go
             Rec b -> inParens 11 $ do
               (x, body) <- bind b
               pure (keyword "rec" <+> name x <+> symbol "=" <+> body)
-            a :>> b -> do
-              prec <- ask @Prec
+            a :>> b -> inBraces 12 $ do
               fore <- with 12 (go a)
               aft  <- with 12 (go b)
 
-              let open  = symbol ("{" <> softline)
-                  close = symbol (softline <> "}")
-                  separator = ";" <> Pretty.line
-                  body = fore <> separator <> aft
+              pure $ vsep [ fore <> Pretty.semi, aft ]
 
-              pure . Pretty.align $ encloseIf (12 > prec) open close (Pretty.align body)
-
-            Named (Ignored x) a :>>= b -> do
-              prec <- ask @Prec
+            Named (Ignored x) a :>>= b -> inBraces 12 $ do
               fore <- with 11 (go a)
               aft  <- with 12 (go (instantiate1 (pure x) b))
 
-              let open  = symbol ("{" <> softline)
-                  close = symbol (softline <> "}")
-                  separator = ";" <> Pretty.line
-                  body = name x <+> arrowL <+> fore <> separator <> aft
-
-              pure . Pretty.align $ encloseIf (12 > prec) open close (Pretty.align body)
+              pure $ vsep [ name x <+> arrowL <+> fore <> Pretty.semi, aft ]
 
             Lam f -> inParens 11 $ do
               (x, body) <- bind f

From 344b5bded1e9b314128501174d3c843ac4da7873 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 22 Jul 2019 16:26:41 -0400
Subject: [PATCH 080/151] Projection binds tighter than application.

---
 semantic-core/src/Data/Core.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 64bc1c9d6..5dc0b7d77 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -81,8 +81,8 @@ data Core f a
 
 infixr 1 :>>
 infixr 1 :>>=
-infixl 9 :$
-infixl 4 :.
+infixl 8 :$
+infixl 9 :.
 infix  3 :=
 
 instance HFunctor Core
@@ -163,13 +163,13 @@ unlam _ _                                    = empty
 ($$) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
 f $$ a = send (f :$ a)
 
-infixl 9 $$
+infixl 8 $$
 
 -- | Application of a function to a sequence of arguments.
 ($$*) :: (Foldable t, Carrier sig m, Member Core sig) => m a -> t (m a) -> m a
 ($$*) = foldl' ($$)
 
-infixl 9 $$*
+infixl 8 $$*
 
 unapply :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
 unapply (Term sig) | Just (f :$ a) <- prj sig = pure (f, a)
@@ -201,7 +201,7 @@ record fs = send (Record fs)
 (...) :: (Carrier sig m, Member Core sig) => m a -> User -> m a
 a ... b = send (a :. b)
 
-infixl 4 ...
+infixl 9 ...
 
 (.=) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
 a .= b = send (a := b)

From a5ac6f3342bfc91c972cc5321214931363d33532 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:40:27 -0400
Subject: [PATCH 081/151] Correct the condition on parenthesization.

---
 semantic-core/src/Data/Core/Pretty.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 208a5cfb6..fc69b63b5 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -58,13 +58,13 @@ inParens :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m
 inParens amount go = do
   prec <- ask
   body <- with amount go
-  pure (if amount > prec then Pretty.parens body else body)
+  pure (if prec > amount then Pretty.parens body else body)
 
 inBraces :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m AnsiDoc
 inBraces amount go = do
   prec <- ask
   body <- with amount go
-  pure (if amount > prec then Pretty.braces body else body)
+  pure (if prec > amount then Pretty.braces body else body)
 
 prettyCore :: Style -> Term Core User -> AnsiDoc
 prettyCore style = run . runReader @Prec 0 . go

From 0cb3f181d0d84b9580d53da33e611e374aaa3947 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:40:47 -0400
Subject: [PATCH 082/151] Indentation.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index fc69b63b5..e7d63d5b2 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -107,7 +107,7 @@ prettyCore style = run . runReader @Prec 0 . go
               pure $ Pretty.sep [con', tru', fal']
 
             Load p   -> "load" `appending` go p
-            item :. body   -> inParens 4 $ do
+            item :. body -> inParens 9 $ do
               f <- go item
               pure (f <> symbol "." <> name body)
 

From f851b2bc927c734ec4b7a674a9f3a47055a3234b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:40:56 -0400
Subject: [PATCH 083/151] Correct a bunch of precedences.

---
 semantic-core/src/Data/Core/Pretty.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index e7d63d5b2..f3f785986 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -74,20 +74,20 @@ prettyCore style = run . runReader @Prec 0 . go
             Rec b -> inParens 11 $ do
               (x, body) <- bind b
               pure (keyword "rec" <+> name x <+> symbol "=" <+> body)
-            a :>> b -> inBraces 12 $ do
-              fore <- with 12 (go a)
-              aft  <- with 12 (go b)
+            a :>> b -> inBraces 1 $ do
+              fore <- with 1 (go a)
+              aft  <- with 1 (go b)
 
               pure $ vsep [ fore <> Pretty.semi, aft ]
 
-            Named (Ignored x) a :>>= b -> inBraces 12 $ do
-              fore <- with 11 (go a)
-              aft  <- with 12 (go (instantiate1 (pure x) b))
+            Named (Ignored x) a :>>= b -> inBraces 1 $ do
+              fore <- with 2 (go a)
+              aft  <- with 1 (go (instantiate1 (pure x) b))
 
               pure $ vsep [ name x <+> arrowL <+> fore <> Pretty.semi, aft ]
 
-            Lam f -> inParens 11 $ do
-              (x, body) <- bind f
+            Lam (Named (Ignored x) b) -> inParens 0 $ do
+              body <- with 1 (go (instantiate1 (pure x) b))
               pure (lambda <> name x <+> arrow <+> body)
 
             Record fs -> do
@@ -98,7 +98,7 @@ prettyCore style = run . runReader @Prec 0 . go
             Bool b   -> pure $ primitive (if b then "true" else "false")
             String s -> pure . strlit $ Pretty.viaShow s
 
-            f :$ x -> inParens 11 $ (<+>) <$> go f <*> go x
+            f :$ x -> inParens 8 $ (<+>) <$> go f <*> with 9 (go x)
 
             If con tru fal -> do
               con' <- "if"   `appending` go con

From 09fdb30653915129262536dd149b1085bd4f2623 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:43:27 -0400
Subject: [PATCH 084/151] Alignment.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index f3f785986..4c8a84c96 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -36,7 +36,7 @@ type AnsiDoc = Pretty.Doc Pretty.AnsiStyle
 
 keyword, symbol, strlit, primitive :: AnsiDoc -> AnsiDoc
 keyword = annotate (Pretty.colorDull Pretty.Cyan)
-symbol  = annotate (Pretty.color Pretty.Yellow)
+symbol  = annotate (Pretty.color     Pretty.Yellow)
 strlit  = annotate (Pretty.colorDull Pretty.Green)
 primitive = keyword . mappend "#"
 

From 024d2d4072a5338f6cc69a56021944066a1f7d9a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:44:12 -0400
Subject: [PATCH 085/151] =?UTF-8?q?Don=E2=80=99t=20qualify=20the=20Pretty?=
 =?UTF-8?q?=20import.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Core/Pretty.hs | 21 ++++++++++-----------
 1 file changed, 10 insertions(+), 11 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 4c8a84c96..4db7db89e 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -14,14 +14,13 @@ import           Data.File
 import           Data.Name
 import           Data.Scope
 import           Data.Term
-import           Data.Text.Prettyprint.Doc (Pretty (..), annotate, (<+>), vsep)
-import qualified Data.Text.Prettyprint.Doc as Pretty
+import           Data.Text.Prettyprint.Doc
 import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
 import           Data.Traversable (for)
 
 showCore :: Term Core User -> String
-showCore = Pretty.renderString . Pretty.layoutSmart Pretty.defaultLayoutOptions . Pretty.unAnnotate . prettyCore Ascii
+showCore = Pretty.renderString . layoutSmart defaultLayoutOptions . unAnnotate . prettyCore Ascii
 
 printCore :: Term Core User -> IO ()
 printCore p = Pretty.putDoc (prettyCore Unicode p) *> putStrLn ""
@@ -32,7 +31,7 @@ showFile = showCore . fileBody
 printFile :: File (Term Core User) -> IO ()
 printFile = printCore . fileBody
 
-type AnsiDoc = Pretty.Doc Pretty.AnsiStyle
+type AnsiDoc = Doc Pretty.AnsiStyle
 
 keyword, symbol, strlit, primitive :: AnsiDoc -> AnsiDoc
 keyword = annotate (Pretty.colorDull Pretty.Cyan)
@@ -58,13 +57,13 @@ inParens :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m
 inParens amount go = do
   prec <- ask
   body <- with amount go
-  pure (if prec > amount then Pretty.parens body else body)
+  pure (if prec > amount then parens body else body)
 
 inBraces :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m AnsiDoc
 inBraces amount go = do
   prec <- ask
   body <- with amount go
-  pure (if prec > amount then Pretty.braces body else body)
+  pure (if prec > amount then braces body else body)
 
 prettyCore :: Style -> Term Core User -> AnsiDoc
 prettyCore style = run . runReader @Prec 0 . go
@@ -78,13 +77,13 @@ prettyCore style = run . runReader @Prec 0 . go
               fore <- with 1 (go a)
               aft  <- with 1 (go b)
 
-              pure $ vsep [ fore <> Pretty.semi, aft ]
+              pure $ vsep [ fore <> semi, aft ]
 
             Named (Ignored x) a :>>= b -> inBraces 1 $ do
               fore <- with 2 (go a)
               aft  <- with 1 (go (instantiate1 (pure x) b))
 
-              pure $ vsep [ name x <+> arrowL <+> fore <> Pretty.semi, aft ]
+              pure $ vsep [ name x <+> arrowL <+> fore <> semi, aft ]
 
             Lam (Named (Ignored x) b) -> inParens 0 $ do
               body <- with 1 (go (instantiate1 (pure x) b))
@@ -92,11 +91,11 @@ prettyCore style = run . runReader @Prec 0 . go
 
             Record fs -> do
               fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
-              pure $ primitive "record" <+> Pretty.encloseSep Pretty.lbrace Pretty.rbrace Pretty.semi fs'
+              pure $ primitive "record" <+> encloseSep lbrace rbrace semi fs'
 
             Unit     -> pure $ primitive "unit"
             Bool b   -> pure $ primitive (if b then "true" else "false")
-            String s -> pure . strlit $ Pretty.viaShow s
+            String s -> pure . strlit $ viaShow s
 
             f :$ x -> inParens 8 $ (<+>) <$> go f <*> with 9 (go x)
 
@@ -104,7 +103,7 @@ prettyCore style = run . runReader @Prec 0 . go
               con' <- "if"   `appending` go con
               tru' <- "then" `appending` go tru
               fal' <- "else" `appending` go fal
-              pure $ Pretty.sep [con', tru', fal']
+              pure $ sep [con', tru', fal']
 
             Load p   -> "load" `appending` go p
             item :. body -> inParens 9 $ do

From 200bf17d278abed1fa4f94e9e8bfb04b103f8fb2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:47:24 -0400
Subject: [PATCH 086/151] Print spaces after semicolons.

---
 semantic-core/src/Data/Core/Pretty.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 4db7db89e..fd6f71e35 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -127,6 +127,7 @@ prettyCore style = run . runReader @Prec 0 . go
         arrowL = case style of
           Unicode -> symbol "←"
           Ascii   -> symbol "<-"
+        semi = "; "
 
 
 appending :: Functor f => AnsiDoc -> f AnsiDoc -> f AnsiDoc

From 5c033abb3ed49e7b9850b77007f0f0a79f78bc29 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:51:52 -0400
Subject: [PATCH 087/151] :fire: encloseIf.

---
 semantic-core/src/Data/Core/Pretty.hs | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index fd6f71e35..23ab08d45 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -39,16 +39,12 @@ symbol  = annotate (Pretty.color     Pretty.Yellow)
 strlit  = annotate (Pretty.colorDull Pretty.Green)
 primitive = keyword . mappend "#"
 
-encloseIf :: Semigroup m => Bool -> m -> m -> m -> m
-encloseIf True  l r x = l <> x <> r
-encloseIf False _ _ x = x
-
 type Prec = Int
 
 data Style = Unicode | Ascii
 
 name :: User -> AnsiDoc
-name n = encloseIf (needsQuotation n) (symbol "#{") (symbol "}") (pretty n)
+name n = if needsQuotation n then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
 
 with :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m a -> m a
 with n = local (const n)

From 77acb91a7f4c595124f12dd849c12f735d745f63 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:53:13 -0400
Subject: [PATCH 088/151] Add spaces inside braces.

---
 semantic-core/src/Data/Core/Pretty.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 23ab08d45..305ebf623 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -59,7 +59,10 @@ inBraces :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m
 inBraces amount go = do
   prec <- ask
   body <- with amount go
-  pure (if prec > amount then braces body else body)
+  pure (if prec > amount then braces (pad body) else body)
+
+pad :: Doc a -> Doc a
+pad = enclose space space
 
 prettyCore :: Style -> Term Core User -> AnsiDoc
 prettyCore style = run . runReader @Prec 0 . go

From f1c4d8a1c5310579d5184f3d6a9502cbd81c74b8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:54:08 -0400
Subject: [PATCH 089/151] =?UTF-8?q?Add=20spaces=20inside=20records?=
 =?UTF-8?q?=E2=80=99=20braces.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 305ebf623..0a8f4690a 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -90,7 +90,7 @@ prettyCore style = run . runReader @Prec 0 . go
 
             Record fs -> do
               fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
-              pure $ primitive "record" <+> encloseSep lbrace rbrace semi fs'
+              pure $ primitive "record" <+> encloseSep "{ " " }" semi fs'
 
             Unit     -> pure $ primitive "unit"
             Bool b   -> pure $ primitive (if b then "true" else "false")

From 390b25a894fe8ab5705a2a498280bd3fede38a4c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 09:56:00 -0400
Subject: [PATCH 090/151] Wrap & indent records.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 0a8f4690a..ec2f19a80 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -90,7 +90,7 @@ prettyCore style = run . runReader @Prec 0 . go
 
             Record fs -> do
               fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
-              pure $ primitive "record" <+> encloseSep "{ " " }" semi fs'
+              pure . group . nest 2 $ vsep [ primitive "record", encloseSep "{ " " }" semi fs' ]
 
             Unit     -> pure $ primitive "unit"
             Bool b   -> pure $ primitive (if b then "true" else "false")

From 50f9b82ae68eca50ac28d5301a8230c5b45bcb93 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:01:25 -0400
Subject: [PATCH 091/151] Nest sequences.

---
 semantic-core/src/Data/Core/Pretty.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index ec2f19a80..72e5c07db 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -76,13 +76,13 @@ prettyCore style = run . runReader @Prec 0 . go
               fore <- with 1 (go a)
               aft  <- with 1 (go b)
 
-              pure $ vsep [ fore <> semi, aft ]
+              pure . group . nest 2 $ vsep [ fore, semi <> aft ]
 
             Named (Ignored x) a :>>= b -> inBraces 1 $ do
               fore <- with 2 (go a)
               aft  <- with 1 (go (instantiate1 (pure x) b))
 
-              pure $ vsep [ name x <+> arrowL <+> fore <> semi, aft ]
+              pure . group . nest 2 $ vsep [ name x <+> arrowL <+> fore, semi <> aft ]
 
             Lam (Named (Ignored x) b) -> inParens 0 $ do
               body <- with 1 (go (instantiate1 (pure x) b))

From 9b3164a722dce5a83f688a23302f817f47fb7309 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:02:06 -0400
Subject: [PATCH 092/151] :fire: block.

---
 semantic-core/src/Data/Core.hs | 9 ---------
 1 file changed, 9 deletions(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 5dc0b7d77..c64597f90 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -5,7 +5,6 @@ module Data.Core
 , Edge(..)
 , rec
 , (>>>)
-, block
 , (>>>=)
 , do'
 , (:<-)(..)
@@ -117,14 +116,6 @@ a >>> b = send (a :>> b)
 
 infixr 1 >>>
 
-block :: (Foldable t, Carrier sig m, Member Core sig) => t (m a) -> m a
-block = maybe unit getBlock . foldMap (Just . Block)
-
-newtype Block m a = Block { getBlock :: m a }
-
-instance (Carrier sig m, Member Core sig) => Semigroup (Block m a) where
-  Block a <> Block b = Block (a >>> b)
-
 unseq :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
 unseq (Term sig) | Just (a :>> b) <- prj sig = pure (a, b)
 unseq _                                      = empty

From ed0231cdf2d35814133dcbc9f888574456a1c51f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:08:55 -0400
Subject: [PATCH 093/151] Add an unbind eliminator for >>>=.

---
 semantic-core/src/Data/Core.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index c64597f90..b05ebf8da 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -6,6 +6,7 @@ module Data.Core
 , rec
 , (>>>)
 , (>>>=)
+, unbind
 , do'
 , (:<-)(..)
 , lam
@@ -131,6 +132,10 @@ Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
 
 infixr 1 >>>=
 
+unbind :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Named a :<- Term sig a, Term sig a)
+unbind n (Term sig) | Just (Named u a :>>= b) <- prj sig = pure (Named u n :<- a, instantiate1 (pure n) b)
+unbind _ _                                       = empty
+
 do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a
 do' bindings = fromMaybe unit (foldr bind Nothing bindings)
   where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a

From 4e98c0434b3a907bee55618f8c1ec0e49e5f8831 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:09:12 -0400
Subject: [PATCH 094/151] Move the unseq/unseqs exports up.

---
 semantic-core/src/Data/Core.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index b05ebf8da..73520c891 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -5,6 +5,8 @@ module Data.Core
 , Edge(..)
 , rec
 , (>>>)
+, unseq
+, unseqs
 , (>>>=)
 , unbind
 , do'
@@ -12,8 +14,6 @@ module Data.Core
 , lam
 , lams
 , unlam
-, unseq
-, unseqs
 , ($$)
 , ($$*)
 , unapply

From b0ee9eeb80c0ee5bebcee8674ce27bb3292ec28f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:10:04 -0400
Subject: [PATCH 095/151] Derive Foldable, Functor, & Traversable instances for
 :<-.

---
 semantic-core/src/Data/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 73520c891..d59b695d1 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -141,7 +141,7 @@ do' bindings = fromMaybe unit (foldr bind Nothing bindings)
   where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a
 
 data a :<- b = a :<- b
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
 
 infix 2 :<-
 

From aa7f1fc6ccda1b2fa07a19a36b159893d863cc6c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:10:49 -0400
Subject: [PATCH 096/151] Define a Bifunctor instance for :<-.

---
 semantic-core/src/Data/Core.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index d59b695d1..de7970ebf 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -35,6 +35,7 @@ module Data.Core
 import Control.Applicative (Alternative (..))
 import Control.Effect.Carrier
 import Control.Monad.Module
+import Data.Bifunctor (Bifunctor (..))
 import Data.Foldable (foldl')
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Loc
@@ -145,6 +146,9 @@ data a :<- b = a :<- b
 
 infix 2 :<-
 
+instance Bifunctor (:<-) where
+  bimap f g (a :<- b) = f a :<- g b
+
 
 lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
 lam (Named u n) b = send (Lam (Named u (abstract1 n b)))

From 1caf99b0bfa66f23958bb42044d9dced9c11cefe Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:11:24 -0400
Subject: [PATCH 097/151] Align.

---
 semantic-core/src/Data/Core.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index de7970ebf..855e79ca8 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -135,7 +135,7 @@ infixr 1 >>>=
 
 unbind :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Named a :<- Term sig a, Term sig a)
 unbind n (Term sig) | Just (Named u a :>>= b) <- prj sig = pure (Named u n :<- a, instantiate1 (pure n) b)
-unbind _ _                                       = empty
+unbind _ _                                               = empty
 
 do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a
 do' bindings = fromMaybe unit (foldr bind Nothing bindings)

From a63e7c34183c234bd9aafcc534ba1ff26b73c5c7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:14:43 -0400
Subject: [PATCH 098/151] Clean up the language extensions in Data.Name.

---
 semantic-core/src/Data/Name.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs
index e4eaabd69..1de0ddc58 100644
--- a/semantic-core/src/Data/Name.hs
+++ b/semantic-core/src/Data/Name.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveTraversable, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, OverloadedLists, OverloadedStrings, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveTraversable, LambdaCase, OverloadedLists #-}
 module Data.Name
 ( User
 , Named(..)

From 16413e1e5b1e263a188d59fee6739a4493dd8fbc Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:15:47 -0400
Subject: [PATCH 099/151] Define a couple of functions for taking apart
 sequences of syntax.

---
 semantic-core/src/Data/Scope.hs | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index fd75bc83b..8ce54621c 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -12,6 +12,8 @@ module Data.Scope
 , instantiate1
 , instantiate
 , instantiateEither
+, un
+, unEither
 ) where
 
 import Control.Applicative (liftA2)
@@ -20,6 +22,7 @@ import Control.Monad ((>=>), guard)
 import Control.Monad.Module
 import Control.Monad.Trans.Class
 import Data.Function (on)
+import Data.Stack
 
 data Incr a b
   = Z a
@@ -105,3 +108,15 @@ instantiate f = instantiateEither (either f pure)
 
 instantiateEither :: Monad f => (Either a b -> f c) -> Scope a f b -> f c
 instantiateEither f = unScope >=> incr (f . Left) (>>= f . Right)
+
+
+un :: Monad m => (t -> Maybe (m (a, t))) -> t -> m (Stack a, t)
+un from = unEither (\ t -> maybe (Left t) Right (from t))
+
+unEither :: Monad m => (t -> Either b (m (a, t))) -> t -> m (Stack a, b)
+unEither from = go Nil
+  where go names value = case from value of
+          Right a -> do
+            (name, body) <- a
+            go (names :> name) body
+          Left  b -> pure (names, b)

From 6050b9594db0fab65211672f1b1e09902108648d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:18:21 -0400
Subject: [PATCH 100/151] Define an eliminator for statements.

---
 semantic-core/src/Data/Core.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 855e79ca8..da5226f1f 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -9,6 +9,7 @@ module Data.Core
 , unseqs
 , (>>>=)
 , unbind
+, unstatement
 , do'
 , (:<-)(..)
 , lam
@@ -137,6 +138,9 @@ unbind :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -
 unbind n (Term sig) | Just (Named u a :>>= b) <- prj sig = pure (Named u n :<- a, instantiate1 (pure n) b)
 unbind _ _                                               = empty
 
+unstatement :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Maybe (Named a) :<- Term sig a, Term sig a)
+unstatement n t = first (first Just) <$> unbind n t <|> first (Nothing :<-) <$> unseq t
+
 do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a
 do' bindings = fromMaybe unit (foldr bind Nothing bindings)
   where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a

From fa9c99132084c5148f190bc887d8e8149735a812 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:30:14 -0400
Subject: [PATCH 101/151] Define an eliminator for blocks of statements.

---
 semantic-core/src/Data/Core.hs | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index da5226f1f..49f92e59e 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -11,6 +11,7 @@ module Data.Core
 , unbind
 , unstatement
 , do'
+, unstatements
 , (:<-)(..)
 , lam
 , lams
@@ -145,6 +146,12 @@ do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a)
 do' bindings = fromMaybe unit (foldr bind Nothing bindings)
   where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a
 
+unstatements :: (Member Core sig, RightModule sig) => Term sig a -> (Stack (Maybe (Named (Either Int a)) :<- Term sig (Either Int a)), Term sig (Either Int a))
+unstatements = go Nil (0 :: Int) . fmap Right
+  where go ts i t = case unstatement (Left i) t of
+          Just (t, b) -> go (ts :> t) (succ i) b
+          Nothing     -> (ts, t)
+
 data a :<- b = a :<- b
   deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
 

From 6aa85afa7640b7a4431de3ebe12414dda70d0d4d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:37:38 -0400
Subject: [PATCH 102/151] Simplify un/unEither to not assume a Monad.

---
 semantic-core/src/Data/Scope.hs | 16 +++++++---------
 1 file changed, 7 insertions(+), 9 deletions(-)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 8ce54621c..9fafafef1 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -110,13 +110,11 @@ instantiateEither :: Monad f => (Either a b -> f c) -> Scope a f b -> f c
 instantiateEither f = unScope >=> incr (f . Left) (>>= f . Right)
 
 
-un :: Monad m => (t -> Maybe (m (a, t))) -> t -> m (Stack a, t)
-un from = unEither (\ t -> maybe (Left t) Right (from t))
+un :: (t -> Maybe (a, t)) -> t -> (Stack a, t)
+un from = unEither (matchMaybe from)
 
-unEither :: Monad m => (t -> Either b (m (a, t))) -> t -> m (Stack a, b)
-unEither from = go Nil
-  where go names value = case from value of
-          Right a -> do
-            (name, body) <- a
-            go (names :> name) body
-          Left  b -> pure (names, b)
+unEither :: (t -> Either (a, t) b) -> t -> (Stack a, b)
+unEither from = go (0 :: Int) Nil
+  where go i bs t = case from t of
+          Left (b, t) -> go (succ i) (bs :> b) t
+          Right b     -> (bs, b)

From 1e4315736fd32df720b469a3b1e8a4de01f95be7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:38:48 -0400
Subject: [PATCH 103/151] =?UTF-8?q?Pass=20the=20index=20to=20un/unEither?=
 =?UTF-8?q?=E2=80=99s=20argument.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Scope.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 9fafafef1..4f7c58d79 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -110,11 +110,11 @@ instantiateEither :: Monad f => (Either a b -> f c) -> Scope a f b -> f c
 instantiateEither f = unScope >=> incr (f . Left) (>>= f . Right)
 
 
-un :: (t -> Maybe (a, t)) -> t -> (Stack a, t)
-un from = unEither (matchMaybe from)
+un :: (Int -> t -> Maybe (a, t)) -> t -> (Stack a, t)
+un from = unEither (matchMaybe . from)
 
-unEither :: (t -> Either (a, t) b) -> t -> (Stack a, b)
+unEither :: (Int -> t -> Either (a, t) b) -> t -> (Stack a, b)
 unEither from = go (0 :: Int) Nil
-  where go i bs t = case from t of
+  where go i bs t = case from i t of
           Left (b, t) -> go (succ i) (bs :> b) t
           Right b     -> (bs, b)

From 00452833782ad9071797aa5fb604e5878ef0f87a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:40:01 -0400
Subject: [PATCH 104/151] Define unstatements using un.

---
 semantic-core/src/Data/Core.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 49f92e59e..4cdc68c7a 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -147,10 +147,7 @@ do' bindings = fromMaybe unit (foldr bind Nothing bindings)
   where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a
 
 unstatements :: (Member Core sig, RightModule sig) => Term sig a -> (Stack (Maybe (Named (Either Int a)) :<- Term sig (Either Int a)), Term sig (Either Int a))
-unstatements = go Nil (0 :: Int) . fmap Right
-  where go ts i t = case unstatement (Left i) t of
-          Just (t, b) -> go (ts :> t) (succ i) b
-          Nothing     -> (ts, t)
+unstatements = un (unstatement . Left) . fmap Right
 
 data a :<- b = a :<- b
   deriving (Eq, Foldable, Functor, Ord, Show, Traversable)

From 7b290632e525d47ec3205bcf3d560adfbcee2dfc Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:43:38 -0400
Subject: [PATCH 105/151] :fire: bind.

---
 semantic-core/src/Data/Core/Pretty.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 72e5c07db..3ba317da8 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -69,8 +69,8 @@ prettyCore style = run . runReader @Prec 0 . go
   where go = \case
           Var v -> pure (name v)
           Term t -> case t of
-            Rec b -> inParens 11 $ do
-              (x, body) <- bind b
+            Rec (Named (Ignored x) b) -> inParens 11 $ do
+              body <- go (instantiate1 (pure x) b)
               pure (keyword "rec" <+> name x <+> symbol "=" <+> body)
             a :>> b -> inBraces 1 $ do
               fore <- with 1 (go a)
@@ -116,7 +116,6 @@ prettyCore style = run . runReader @Prec 0 . go
 
             -- Annotations are not pretty-printed, as it lowers the signal/noise ratio too profoundly.
             Ann _ c -> go c
-          where bind (Named (Ignored x) f) = (,) x <$> go (instantiate1 (pure x) f)
         lambda = case style of
           Unicode -> symbol "λ"
           Ascii   -> symbol "\\"

From 6b250c723e3341fbe3c6d5a1ea3e9cbfcb9bad25 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 11:46:06 -0400
Subject: [PATCH 106/151] Pretty-print variables early.

---
 semantic-core/src/Data/Core/Pretty.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 3ba317da8..487244954 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -65,12 +65,12 @@ pad :: Doc a -> Doc a
 pad = enclose space space
 
 prettyCore :: Style -> Term Core User -> AnsiDoc
-prettyCore style = run . runReader @Prec 0 . go
+prettyCore style = run . runReader @Prec 0 . go . fmap name
   where go = \case
-          Var v -> pure (name v)
+          Var v -> pure v
           Term t -> case t of
             Rec (Named (Ignored x) b) -> inParens 11 $ do
-              body <- go (instantiate1 (pure x) b)
+              body <- go (instantiate1 (pure (name x)) b)
               pure (keyword "rec" <+> name x <+> symbol "=" <+> body)
             a :>> b -> inBraces 1 $ do
               fore <- with 1 (go a)
@@ -80,12 +80,12 @@ prettyCore style = run . runReader @Prec 0 . go
 
             Named (Ignored x) a :>>= b -> inBraces 1 $ do
               fore <- with 2 (go a)
-              aft  <- with 1 (go (instantiate1 (pure x) b))
+              aft  <- with 1 (go (instantiate1 (pure (name x)) b))
 
               pure . group . nest 2 $ vsep [ name x <+> arrowL <+> fore, semi <> aft ]
 
             Lam (Named (Ignored x) b) -> inParens 0 $ do
-              body <- with 1 (go (instantiate1 (pure x) b))
+              body <- with 1 (go (instantiate1 (pure (name x)) b))
               pure (lambda <> name x <+> arrow <+> body)
 
             Record fs -> do

From b119712c53f50e5b9fde9d163eb6dfaf379b3fb0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:03:19 -0400
Subject: [PATCH 107/151] Avoid redundant nesting of statements.

---
 semantic-core/src/Data/Core/Pretty.hs | 30 +++++++++------------------
 1 file changed, 10 insertions(+), 20 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 487244954..d42be011f 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -11,8 +11,10 @@ module Data.Core.Pretty
 import           Control.Effect.Reader
 import           Data.Core
 import           Data.File
+import           Data.Foldable (toList)
 import           Data.Name
 import           Data.Scope
+import           Data.Stack
 import           Data.Term
 import           Data.Text.Prettyprint.Doc
 import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
@@ -55,15 +57,6 @@ inParens amount go = do
   body <- with amount go
   pure (if prec > amount then parens body else body)
 
-inBraces :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m AnsiDoc
-inBraces amount go = do
-  prec <- ask
-  body <- with amount go
-  pure (if prec > amount then braces (pad body) else body)
-
-pad :: Doc a -> Doc a
-pad = enclose space space
-
 prettyCore :: Style -> Term Core User -> AnsiDoc
 prettyCore style = run . runReader @Prec 0 . go . fmap name
   where go = \case
@@ -72,17 +65,6 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
             Rec (Named (Ignored x) b) -> inParens 11 $ do
               body <- go (instantiate1 (pure (name x)) b)
               pure (keyword "rec" <+> name x <+> symbol "=" <+> body)
-            a :>> b -> inBraces 1 $ do
-              fore <- with 1 (go a)
-              aft  <- with 1 (go b)
-
-              pure . group . nest 2 $ vsep [ fore, semi <> aft ]
-
-            Named (Ignored x) a :>>= b -> inBraces 1 $ do
-              fore <- with 2 (go a)
-              aft  <- with 1 (go (instantiate1 (pure (name x)) b))
-
-              pure . group . nest 2 $ vsep [ name x <+> arrowL <+> fore, semi <> aft ]
 
             Lam (Named (Ignored x) b) -> inParens 0 $ do
               body <- with 1 (go (instantiate1 (pure (name x)) b))
@@ -116,6 +98,14 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
 
             -- Annotations are not pretty-printed, as it lowers the signal/noise ratio too profoundly.
             Ann _ c -> go c
+            statement -> do
+              let (bindings, return) = unstatements (Term statement)
+                  statements = toList (bindings :> (Nothing :<- return))
+                  names = zipWith (\ i (n :<- _) -> maybe (pretty @Int i) (name . namedName) n) [0..] statements
+              statements' <- traverse (prettyStatement names) statements
+              pure (encloseSep "{ " " }" semi statements')
+        prettyStatement names (Just (Named (Ignored u) _) :<- t) = (name u <+> arrowL <+>) <$> go (either (names !!) id <$> t)
+        prettyStatement names (Nothing                    :<- t) = go (either (names !!) id <$> t)
         lambda = case style of
           Unicode -> symbol "λ"
           Ascii   -> symbol "\\"

From a96eadb620d6566bf04eab30504a21e60e166c01 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:07:08 -0400
Subject: [PATCH 108/151] Nest & align recursive bindings.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index d42be011f..3cdedf938 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -64,7 +64,7 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
           Term t -> case t of
             Rec (Named (Ignored x) b) -> inParens 11 $ do
               body <- go (instantiate1 (pure (name x)) b)
-              pure (keyword "rec" <+> name x <+> symbol "=" <+> body)
+              pure . group . nest 2 $ vsep [ keyword "rec" <+> name x, symbol "=" <+> align body ]
 
             Lam (Named (Ignored x) b) -> inParens 0 $ do
               body <- with 1 (go (instantiate1 (pure (name x)) b))

From 47b43cf009570fcd27b5b305010746a96212e28c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:08:28 -0400
Subject: [PATCH 109/151] =?UTF-8?q?Don=E2=80=99t=20pad=20empty=20records.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Core/Pretty.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 3cdedf938..aac4b8733 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -72,7 +72,7 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
 
             Record fs -> do
               fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
-              pure . group . nest 2 $ vsep [ primitive "record", encloseSep "{ " " }" semi fs' ]
+              pure . group . nest 2 $ vsep [ primitive "record", block fs' ]
 
             Unit     -> pure $ primitive "unit"
             Bool b   -> pure $ primitive (if b then "true" else "false")
@@ -103,7 +103,9 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
                   statements = toList (bindings :> (Nothing :<- return))
                   names = zipWith (\ i (n :<- _) -> maybe (pretty @Int i) (name . namedName) n) [0..] statements
               statements' <- traverse (prettyStatement names) statements
-              pure (encloseSep "{ " " }" semi statements')
+              pure (block statements')
+        block [] = braces mempty
+        block ss = encloseSep "{ " " }" semi ss
         prettyStatement names (Just (Named (Ignored u) _) :<- t) = (name u <+> arrowL <+>) <$> go (either (names !!) id <$> t)
         prettyStatement names (Nothing                    :<- t) = go (either (names !!) id <$> t)
         lambda = case style of

From 453b898581084f7c4a7208de3fc8740fe7ad8eb1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:10:24 -0400
Subject: [PATCH 110/151] Use colons to separate keys & values.

---
 semantic-core/src/Data/Core/Parser.hs | 2 +-
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index f2f5e1099..f7f9d18f2 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -114,7 +114,7 @@ lit = let x `given` n = x <$ reserved n in choice
   ] <?> "literal"
 
 record :: (TokenParsing m, Monad m) => m (Term Core User)
-record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic '=' <*> core) semi)
+record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> core) semi)
 
 lambda :: (TokenParsing m, Monad m) => m (Term Core User)
 lambda = Core.lam <$ lambduh <*> name <* arrow <*> core <?> "lambda" where
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index aac4b8733..619c50f21 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -71,7 +71,7 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
               pure (lambda <> name x <+> arrow <+> body)
 
             Record fs -> do
-              fs' <- for fs $ \ (x, v) -> (name x <+> symbol "=" <+>) <$> go v
+              fs' <- for fs $ \ (x, v) -> (name x <+> symbol ":" <+>) <$> go v
               pure . group . nest 2 $ vsep [ primitive "record", block fs' ]
 
             Unit     -> pure $ primitive "unit"

From 3da182dcec2969eb8b479548f55fb36288f7a7ae Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:12:02 -0400
Subject: [PATCH 111/151] Comma-separate records.

---
 semantic-core/src/Data/Core/Parser.hs | 2 +-
 semantic-core/src/Data/Core/Pretty.hs | 9 ++++-----
 2 files changed, 5 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index f7f9d18f2..7e3abf0a8 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -114,7 +114,7 @@ lit = let x `given` n = x <$ reserved n in choice
   ] <?> "literal"
 
 record :: (TokenParsing m, Monad m) => m (Term Core User)
-record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> core) semi)
+record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> core) comma)
 
 lambda :: (TokenParsing m, Monad m) => m (Term Core User)
 lambda = Core.lam <$ lambduh <*> name <* arrow <*> core <?> "lambda" where
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 619c50f21..80854229a 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -72,7 +72,7 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
 
             Record fs -> do
               fs' <- for fs $ \ (x, v) -> (name x <+> symbol ":" <+>) <$> go v
-              pure . group . nest 2 $ vsep [ primitive "record", block fs' ]
+              pure . group . nest 2 $ vsep [ primitive "record", block ", " fs' ]
 
             Unit     -> pure $ primitive "unit"
             Bool b   -> pure $ primitive (if b then "true" else "false")
@@ -103,9 +103,9 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
                   statements = toList (bindings :> (Nothing :<- return))
                   names = zipWith (\ i (n :<- _) -> maybe (pretty @Int i) (name . namedName) n) [0..] statements
               statements' <- traverse (prettyStatement names) statements
-              pure (block statements')
-        block [] = braces mempty
-        block ss = encloseSep "{ " " }" semi ss
+              pure (block "; " statements')
+        block _ [] = braces mempty
+        block s ss = encloseSep "{ " " }" s ss
         prettyStatement names (Just (Named (Ignored u) _) :<- t) = (name u <+> arrowL <+>) <$> go (either (names !!) id <$> t)
         prettyStatement names (Nothing                    :<- t) = go (either (names !!) id <$> t)
         lambda = case style of
@@ -117,7 +117,6 @@ prettyCore style = run . runReader @Prec 0 . go . fmap name
         arrowL = case style of
           Unicode -> symbol "←"
           Ascii   -> symbol "<-"
-        semi = "; "
 
 
 appending :: Functor f => AnsiDoc -> f AnsiDoc -> f AnsiDoc

From 96127627f60a7bb648d2bdf5b272f6504d0758ea Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:24:45 -0400
Subject: [PATCH 112/151] Define Prec as a newtype.

---
 semantic-core/src/Data/Core/Pretty.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 80854229a..ca1fd814a 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -41,24 +41,25 @@ symbol  = annotate (Pretty.color     Pretty.Yellow)
 strlit  = annotate (Pretty.colorDull Pretty.Green)
 primitive = keyword . mappend "#"
 
-type Prec = Int
+newtype Prec = Prec { unPrec :: Int }
+  deriving (Eq, Ord, Show)
 
 data Style = Unicode | Ascii
 
 name :: User -> AnsiDoc
 name n = if needsQuotation n then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
 
-with :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m a -> m a
-with n = local (const n)
+with :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m a -> m a
+with n = local (const (Prec n))
 
-inParens :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m AnsiDoc
+inParens :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m AnsiDoc -> m AnsiDoc
 inParens amount go = do
   prec <- ask
   body <- with amount go
-  pure (if prec > amount then parens body else body)
+  pure (if prec > Prec amount then parens body else body)
 
 prettyCore :: Style -> Term Core User -> AnsiDoc
-prettyCore style = run . runReader @Prec 0 . go . fmap name
+prettyCore style = run . runReader (Prec 0) . go . fmap name
   where go = \case
           Var v -> pure v
           Term t -> case t of

From 56d40daef4fab6e66b7756172cdd6ea29ba57133 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:26:25 -0400
Subject: [PATCH 113/151] Rename with to withPrec.

---
 semantic-core/src/Data/Core/Pretty.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index ca1fd814a..f8234f2e1 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -49,13 +49,13 @@ data Style = Unicode | Ascii
 name :: User -> AnsiDoc
 name n = if needsQuotation n then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
 
-with :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m a -> m a
-with n = local (const (Prec n))
+withPrec :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m a -> m a
+withPrec n = local (const (Prec n))
 
 inParens :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m AnsiDoc -> m AnsiDoc
 inParens amount go = do
   prec <- ask
-  body <- with amount go
+  body <- withPrec amount go
   pure (if prec > Prec amount then parens body else body)
 
 prettyCore :: Style -> Term Core User -> AnsiDoc
@@ -68,7 +68,7 @@ prettyCore style = run . runReader (Prec 0) . go . fmap name
               pure . group . nest 2 $ vsep [ keyword "rec" <+> name x, symbol "=" <+> align body ]
 
             Lam (Named (Ignored x) b) -> inParens 0 $ do
-              body <- with 1 (go (instantiate1 (pure (name x)) b))
+              body <- withPrec 1 (go (instantiate1 (pure (name x)) b))
               pure (lambda <> name x <+> arrow <+> body)
 
             Record fs -> do
@@ -79,7 +79,7 @@ prettyCore style = run . runReader (Prec 0) . go . fmap name
             Bool b   -> pure $ primitive (if b then "true" else "false")
             String s -> pure . strlit $ viaShow s
 
-            f :$ x -> inParens 8 $ (<+>) <$> go f <*> with 9 (go x)
+            f :$ x -> inParens 8 $ (<+>) <$> go f <*> withPrec 9 (go x)
 
             If con tru fal -> do
               con' <- "if"   `appending` go con

From edbea6991ce7b024bffa0555d60dc1e56610b2d9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:27:24 -0400
Subject: [PATCH 114/151] Indentation.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index f8234f2e1..1e00f33af 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -87,7 +87,7 @@ prettyCore style = run . runReader (Prec 0) . go . fmap name
               fal' <- "else" `appending` go fal
               pure $ sep [con', tru', fal']
 
-            Load p   -> "load" `appending` go p
+            Load p -> "load" `appending` go p
             item :. body -> inParens 9 $ do
               f <- go item
               pure (f <> symbol "." <> name body)

From 99668a33a154e1613c40437ee36ade7c51c0b375 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:31:35 -0400
Subject: [PATCH 115/151] =?UTF-8?q?Don=E2=80=99t=20set=20the=20precedence?=
 =?UTF-8?q?=20recursively.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 1e00f33af..e980ea863 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -55,7 +55,7 @@ withPrec n = local (const (Prec n))
 inParens :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m AnsiDoc -> m AnsiDoc
 inParens amount go = do
   prec <- ask
-  body <- withPrec amount go
+  body <- go
   pure (if prec > Prec amount then parens body else body)
 
 prettyCore :: Style -> Term Core User -> AnsiDoc

From 5b682606bc44a90c54fc163f0f98a7e7beb710fb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 12:34:10 -0400
Subject: [PATCH 116/151] inParens wraps a Doc, not an action.

---
 semantic-core/src/Data/Core/Pretty.hs | 23 +++++++++++------------
 1 file changed, 11 insertions(+), 12 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index e980ea863..0d999b1c6 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -52,10 +52,9 @@ name n = if needsQuotation n then enclose (symbol "#{") (symbol "}") (pretty n)
 withPrec :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m a -> m a
 withPrec n = local (const (Prec n))
 
-inParens :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m AnsiDoc -> m AnsiDoc
-inParens amount go = do
+inParens :: (Member (Reader Prec) sig, Carrier sig m) => Int -> AnsiDoc -> m AnsiDoc
+inParens amount body = do
   prec <- ask
-  body <- go
   pure (if prec > Prec amount then parens body else body)
 
 prettyCore :: Style -> Term Core User -> AnsiDoc
@@ -63,13 +62,13 @@ prettyCore style = run . runReader (Prec 0) . go . fmap name
   where go = \case
           Var v -> pure v
           Term t -> case t of
-            Rec (Named (Ignored x) b) -> inParens 11 $ do
+            Rec (Named (Ignored x) b) -> do
               body <- go (instantiate1 (pure (name x)) b)
-              pure . group . nest 2 $ vsep [ keyword "rec" <+> name x, symbol "=" <+> align body ]
+              inParens 11 . group . nest 2 $ vsep [ keyword "rec" <+> name x, symbol "=" <+> align body ]
 
-            Lam (Named (Ignored x) b) -> inParens 0 $ do
+            Lam (Named (Ignored x) b) -> do
               body <- withPrec 1 (go (instantiate1 (pure (name x)) b))
-              pure (lambda <> name x <+> arrow <+> body)
+              inParens 0 (lambda <> name x <+> arrow <+> body)
 
             Record fs -> do
               fs' <- for fs $ \ (x, v) -> (name x <+> symbol ":" <+>) <$> go v
@@ -79,7 +78,7 @@ prettyCore style = run . runReader (Prec 0) . go . fmap name
             Bool b   -> pure $ primitive (if b then "true" else "false")
             String s -> pure . strlit $ viaShow s
 
-            f :$ x -> inParens 8 $ (<+>) <$> go f <*> withPrec 9 (go x)
+            f :$ x -> (<+>) <$> go f <*> withPrec 9 (go x) >>= inParens 8
 
             If con tru fal -> do
               con' <- "if"   `appending` go con
@@ -88,14 +87,14 @@ prettyCore style = run . runReader (Prec 0) . go . fmap name
               pure $ sep [con', tru', fal']
 
             Load p -> "load" `appending` go p
-            item :. body -> inParens 9 $ do
+            item :. body -> do
               f <- go item
-              pure (f <> symbol "." <> name body)
+              inParens 9 (f <> symbol "." <> name body)
 
-            lhs := rhs -> inParens 3 $ do
+            lhs := rhs -> do
               f <- go lhs
               g <- go rhs
-              pure (f <+> symbol "=" <+> g)
+              inParens 3 (f <+> symbol "=" <+> g)
 
             -- Annotations are not pretty-printed, as it lowers the signal/noise ratio too profoundly.
             Ann _ c -> go c

From 76eb3e2154a5c5b1f309fb217c9ddcda81f8790b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:00:32 -0400
Subject: [PATCH 117/151] Pretty-print with mandatory precedence handling.

---
 semantic-core/src/Data/Core/Pretty.hs | 94 +++++++++++++--------------
 1 file changed, 46 insertions(+), 48 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 0d999b1c6..7ea5db084 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -8,7 +8,6 @@ module Data.Core.Pretty
   , prettyCore
   ) where
 
-import           Control.Effect.Reader
 import           Data.Core
 import           Data.File
 import           Data.Foldable (toList)
@@ -19,7 +18,6 @@ import           Data.Term
 import           Data.Text.Prettyprint.Doc
 import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
 import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
-import           Data.Traversable (for)
 
 showCore :: Term Core User -> String
 showCore = Pretty.renderString . layoutSmart defaultLayoutOptions . unAnnotate . prettyCore Ascii
@@ -41,73 +39,59 @@ symbol  = annotate (Pretty.color     Pretty.Yellow)
 strlit  = annotate (Pretty.colorDull Pretty.Green)
 primitive = keyword . mappend "#"
 
-newtype Prec = Prec { unPrec :: Int }
-  deriving (Eq, Ord, Show)
-
 data Style = Unicode | Ascii
 
 name :: User -> AnsiDoc
 name n = if needsQuotation n then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
 
-withPrec :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m a -> m a
-withPrec n = local (const (Prec n))
-
-inParens :: (Member (Reader Prec) sig, Carrier sig m) => Int -> AnsiDoc -> m AnsiDoc
-inParens amount body = do
-  prec <- ask
-  pure (if prec > Prec amount then parens body else body)
-
 prettyCore :: Style -> Term Core User -> AnsiDoc
-prettyCore style = run . runReader (Prec 0) . go . fmap name
+prettyCore style = precBody . go . fmap name
   where go = \case
-          Var v -> pure v
+          Var v -> atom v
           Term t -> case t of
-            Rec (Named (Ignored x) b) -> do
-              body <- go (instantiate1 (pure (name x)) b)
-              inParens 11 . group . nest 2 $ vsep [ keyword "rec" <+> name x, symbol "=" <+> align body ]
+            Rec (Named (Ignored x) b) -> prec 11 . group . nest 2 $ vsep
+              [ keyword "rec" <+> name x
+              , symbol "=" <+> align (withPrec 0 (go (instantiate1 (pure (name x)) b)))
+              ]
 
-            Lam (Named (Ignored x) b) -> do
-              body <- withPrec 1 (go (instantiate1 (pure (name x)) b))
-              inParens 0 (lambda <> name x <+> arrow <+> body)
+            Lam (Named (Ignored x) b) -> prec 0 . group . nest 2 $ vsep
+              [ lambda <> name x, arrow <+> withPrec 0 (go (instantiate1 (pure (name x)) b)) ]
 
-            Record fs -> do
-              fs' <- for fs $ \ (x, v) -> (name x <+> symbol ":" <+>) <$> go v
-              pure . group . nest 2 $ vsep [ primitive "record", block ", " fs' ]
+            Record fs -> atom . group . nest 2 $ vsep [ primitive "record", block ", " (map (uncurry keyValue) fs) ]
 
-            Unit     -> pure $ primitive "unit"
-            Bool b   -> pure $ primitive (if b then "true" else "false")
-            String s -> pure . strlit $ viaShow s
+            Unit     -> atom $ primitive "unit"
+            Bool b   -> atom $ primitive (if b then "true" else "false")
+            String s -> atom . strlit $ viaShow s
 
-            f :$ x -> (<+>) <$> go f <*> withPrec 9 (go x) >>= inParens 8
+            f :$ x -> prec 8 (withPrec 8 (go f) <+> withPrec 9 (go x))
 
-            If con tru fal -> do
-              con' <- "if"   `appending` go con
-              tru' <- "then" `appending` go tru
-              fal' <- "else" `appending` go fal
-              pure $ sep [con', tru', fal']
+            If con tru fal -> prec 8 . group $ vsep
+              [ keyword "if"   <+> precBody (go con)
+              , keyword "then" <+> precBody (go tru)
+              , keyword "else" <+> precBody (go fal)
+              ]
 
-            Load p -> "load" `appending` go p
-            item :. body -> do
-              f <- go item
-              inParens 9 (f <> symbol "." <> name body)
+            Load p -> prec 8 (keyword "load" <+> withPrec 9 (go p))
+            item :. body -> prec 9 (withPrec 9 (go item) <> symbol "." <> name body)
 
-            lhs := rhs -> do
-              f <- go lhs
-              g <- go rhs
-              inParens 3 (f <+> symbol "=" <+> g)
+            lhs := rhs -> prec 3 . group . nest 2 $ vsep
+              [ withPrec 4 (go lhs)
+              , symbol "=" <+> align (withPrec 4 (go rhs))
+              ]
 
             -- Annotations are not pretty-printed, as it lowers the signal/noise ratio too profoundly.
             Ann _ c -> go c
-            statement -> do
+            statement ->
               let (bindings, return) = unstatements (Term statement)
                   statements = toList (bindings :> (Nothing :<- return))
                   names = zipWith (\ i (n :<- _) -> maybe (pretty @Int i) (name . namedName) n) [0..] statements
-              statements' <- traverse (prettyStatement names) statements
-              pure (block "; " statements')
+                  statements' = map (prettyStatement names) statements
+              in atom (block "; " statements')
         block _ [] = braces mempty
         block s ss = encloseSep "{ " " }" s ss
-        prettyStatement names (Just (Named (Ignored u) _) :<- t) = (name u <+> arrowL <+>) <$> go (either (names !!) id <$> t)
-        prettyStatement names (Nothing                    :<- t) = go (either (names !!) id <$> t)
+        keyValue x v = name x <+> symbol ":" <+> precBody (go v)
+        prettyStatement names (Just (Named (Ignored u) _) :<- t) = name u <+> arrowL <+> precBody (go (either (names !!) id <$> t))
+        prettyStatement names (Nothing                    :<- t) = precBody (go (either (names !!) id <$> t))
         lambda = case style of
           Unicode -> symbol "λ"
           Ascii   -> symbol "\\"
@@ -119,5 +103,19 @@ prettyCore style = run . runReader (Prec 0) . go . fmap name
           Ascii   -> symbol "<-"
 
 
-appending :: Functor f => AnsiDoc -> f AnsiDoc -> f AnsiDoc
-appending k item = (keyword k <+>) <$> item
+data Prec a = Prec
+  { precLevel :: Maybe Int
+  , precBody  :: a
+  }
+  deriving (Eq, Ord, Show)
+
+prec :: Int -> a -> Prec a
+prec = Prec . Just
+
+atom :: a -> Prec a
+atom = Prec Nothing
+
+withPrec :: Int -> Prec AnsiDoc -> AnsiDoc
+withPrec d (Prec d' a)
+  | maybe False (d >) d' = parens a
+  | otherwise            = a

From b58ddb470b84463be01dc9771a5fb37578f7fb4e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:01:25 -0400
Subject: [PATCH 118/151] Projections are lvalues.

---
 semantic-core/src/Data/Core/Parser.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 7e3abf0a8..a328979b9 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -94,7 +94,8 @@ edge = Core.load <$ reserved "load" <*> expr
 
 lvalue :: (TokenParsing m, Monad m) => m (Term Core User)
 lvalue = choice
-  [ ident
+  [ prj
+  , ident
   , parens expr
   ]
 

From b7007401748190e6cbed4b4c74c5236e31b16278 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:02:05 -0400
Subject: [PATCH 119/151] Split out a rule for application.

---
 semantic-core/src/Data/Core/Parser.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index a328979b9..a6ad51051 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -50,7 +50,10 @@ core :: (TokenParsing m, Monad m) => m (Term Core User)
 core = expr
 
 expr :: (TokenParsing m, Monad m) => m (Term Core User)
-expr = prj `chainl1` (pure (Core.$$))
+expr = application
+
+application :: (TokenParsing m, Monad m) => m (Term Core User)
+application = prj `chainl1` (pure (Core.$$))
 
 prj :: (TokenParsing m, Monad m) => m (Term Core User)
 prj = foldl' (Core....) <$> atom <*> many (namedValue <$> (dot *> name))

From d1671a6d7ce7d6fda1f6e0e9609f231cd1924c5f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:02:24 -0400
Subject: [PATCH 120/151] Rename prj to projection.

---
 semantic-core/src/Data/Core/Parser.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index a6ad51051..c63c135bd 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -53,10 +53,10 @@ expr :: (TokenParsing m, Monad m) => m (Term Core User)
 expr = application
 
 application :: (TokenParsing m, Monad m) => m (Term Core User)
-application = prj `chainl1` (pure (Core.$$))
+application = projection `chainl1` (pure (Core.$$))
 
-prj :: (TokenParsing m, Monad m) => m (Term Core User)
-prj = foldl' (Core....) <$> atom <*> many (namedValue <$> (dot *> name))
+projection :: (TokenParsing m, Monad m) => m (Term Core User)
+projection = foldl' (Core....) <$> atom <*> many (namedValue <$> (dot *> name))
 
 atom :: (TokenParsing m, Monad m) => m (Term Core User)
 atom = choice
@@ -97,7 +97,7 @@ edge = Core.load <$ reserved "load" <*> expr
 
 lvalue :: (TokenParsing m, Monad m) => m (Term Core User)
 lvalue = choice
-  [ prj
+  [ projection
   , ident
   , parens expr
   ]

From 59af553279ae2fc6742b655cab6771a2118d6a35 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:05:46 -0400
Subject: [PATCH 121/151] Recur via expr.

---
 semantic-core/src/Data/Core/Parser.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index c63c135bd..8817199af 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -81,16 +81,16 @@ statement
 
 ifthenelse :: (TokenParsing m, Monad m) => m (Term Core User)
 ifthenelse = Core.if'
-  <$ reserved "if"   <*> core
-  <* reserved "then" <*> core
-  <* reserved "else" <*> core
+  <$ reserved "if"   <*> expr
+  <* reserved "then" <*> expr
+  <* reserved "else" <*> expr
   <?> "if-then-else statement"
 
 rec :: (TokenParsing m, Monad m) => m (Term Core User)
-rec = Core.rec <$ reserved "rec" <*> name <* symbolic '=' <*> core <?> "recursive binding"
+rec = Core.rec <$ reserved "rec" <*> name <* symbolic '=' <*> expr <?> "recursive binding"
 
 assign :: (TokenParsing m, Monad m) => m (Term Core User)
-assign = (Core..=) <$> try (lvalue <* symbolic '=') <*> core <?> "assignment"
+assign = (Core..=) <$> try (lvalue <* symbolic '=') <*> expr <?> "assignment"
 
 edge :: (TokenParsing m, Monad m) => m (Term Core User)
 edge = Core.load <$ reserved "load" <*> expr
@@ -118,10 +118,10 @@ lit = let x `given` n = x <$ reserved n in choice
   ] <?> "literal"
 
 record :: (TokenParsing m, Monad m) => m (Term Core User)
-record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> core) comma)
+record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> expr) comma)
 
 lambda :: (TokenParsing m, Monad m) => m (Term Core User)
-lambda = Core.lam <$ lambduh <*> name <* arrow <*> core <?> "lambda" where
+lambda = Core.lam <$ lambduh <*> name <* arrow <*> expr <?> "lambda" where
   lambduh = symbolic 'λ' <|> symbolic '\\'
   arrow   = symbol "→"   <|> symbol "->"
 

From 08878f1a18f2de6c90aef2b83b480f7d091e03e3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:07:21 -0400
Subject: [PATCH 122/151] assign binds looser than application.

---
 semantic-core/src/Data/Core/Parser.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 8817199af..84d290111 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -50,7 +50,10 @@ core :: (TokenParsing m, Monad m) => m (Term Core User)
 core = expr
 
 expr :: (TokenParsing m, Monad m) => m (Term Core User)
-expr = application
+expr = assign
+
+assign :: (TokenParsing m, Monad m) => m (Term Core User)
+assign = application <**> (flip (Core..=) <$ symbolic '=' <*> application <|> pure id) <?> "assignment"
 
 application :: (TokenParsing m, Monad m) => m (Term Core User)
 application = projection `chainl1` (pure (Core.$$))
@@ -66,7 +69,6 @@ atom = choice
   , lit
   , ident
   , rec
-  , assign
   , parens expr
   ]
 
@@ -89,9 +91,6 @@ ifthenelse = Core.if'
 rec :: (TokenParsing m, Monad m) => m (Term Core User)
 rec = Core.rec <$ reserved "rec" <*> name <* symbolic '=' <*> expr <?> "recursive binding"
 
-assign :: (TokenParsing m, Monad m) => m (Term Core User)
-assign = (Core..=) <$> try (lvalue <* symbolic '=') <*> expr <?> "assignment"
-
 edge :: (TokenParsing m, Monad m) => m (Term Core User)
 edge = Core.load <$ reserved "load" <*> expr
 

From 9ccd11ef09462bfab58200d5deb7fa04745260af Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:10:51 -0400
Subject: [PATCH 123/151] ifthenelse and lambda bind looser than assignment.

---
 semantic-core/src/Data/Core/Parser.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 84d290111..c457ceb77 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -50,7 +50,7 @@ core :: (TokenParsing m, Monad m) => m (Term Core User)
 core = expr
 
 expr :: (TokenParsing m, Monad m) => m (Term Core User)
-expr = assign
+expr = ifthenelse <|> lambda <|> assign
 
 assign :: (TokenParsing m, Monad m) => m (Term Core User)
 assign = application <**> (flip (Core..=) <$ symbolic '=' <*> application <|> pure id) <?> "assignment"
@@ -64,7 +64,6 @@ projection = foldl' (Core....) <$> atom <*> many (namedValue <$> (dot *> name))
 atom :: (TokenParsing m, Monad m) => m (Term Core User)
 atom = choice
   [ comp
-  , ifthenelse
   , edge
   , lit
   , ident
@@ -113,7 +112,6 @@ lit = let x `given` n = x <$ reserved n in choice
   , Core.unit       `given` "#unit"
   , record
   , between (string "\"") (string "\"") (Core.string . fromString <$> many ('"' <$ string "\\\"" <|> noneOf "\""))
-  , lambda
   ] <?> "literal"
 
 record :: (TokenParsing m, Monad m) => m (Term Core User)

From 068941e3e11795868893b9599e7a0f2b8429bbb3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:12:41 -0400
Subject: [PATCH 124/151] Correct the precedence of if/then/else and lambda.

---
 semantic-core/src/Data/Core/Pretty.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 7ea5db084..74f84771f 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -54,8 +54,8 @@ prettyCore style = precBody . go . fmap name
               , symbol "=" <+> align (withPrec 0 (go (instantiate1 (pure (name x)) b)))
               ]
 
-            Lam (Named (Ignored x) b) -> prec 0 . group . nest 2 $ vsep
-              [ lambda <> name x, arrow <+> withPrec 0 (go (instantiate1 (pure (name x)) b)) ]
+            Lam (Named (Ignored x) b) -> prec 3 . group . nest 2 $ vsep
+              [ lambda <> name x, arrow <+> withPrec 3 (go (instantiate1 (pure (name x)) b)) ]
 
             Record fs -> atom . group . nest 2 $ vsep [ primitive "record", block ", " (map (uncurry keyValue) fs) ]
 
@@ -65,7 +65,7 @@ prettyCore style = precBody . go . fmap name
 
             f :$ x -> prec 8 (withPrec 8 (go f) <+> withPrec 9 (go x))
 
-            If con tru fal -> prec 8 . group $ vsep
+            If con tru fal -> prec 3 . group $ vsep
               [ keyword "if"   <+> precBody (go con)
               , keyword "then" <+> precBody (go tru)
               , keyword "else" <+> precBody (go fal)

From e03236d30133d231323b6bc968a1feed27cf36f5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:15:55 -0400
Subject: [PATCH 125/151] Generate assignments.

---
 semantic-core/test/Generators.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index 1963adb80..cdb8e514b 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -70,4 +70,5 @@ expr = Gen.recursive Gen.choice atoms
   , Gen.subterm2 expr expr (Core.>>>)
   , Gen.subtermM2 expr expr (\ x y -> (Core.>>>= y) . (Core.:<- x) <$> name)
   , Gen.subtermM expr (\ x -> (x Core....) . namedValue <$> name)
+  , Gen.subterm2 expr expr (Core..=)
   ]

From 308066fbb19de5e91bc4006a73309d6907cfc683 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:18:04 -0400
Subject: [PATCH 126/151] Generate recursive bindings.

---
 semantic-core/test/Generators.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index cdb8e514b..84325ff21 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -63,7 +63,8 @@ literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]
 
 expr :: MonadGen m => m (Term Core.Core User)
 expr = Gen.recursive Gen.choice atoms
-  [ lambda expr
+  [ Gen.subtermM expr (\x -> flip Core.rec x <$> name)
+  , lambda expr
   , record expr
   , Gen.subterm2 expr expr (Core.$$)
   , Gen.subterm3 expr expr expr Core.if'

From 8e5c2163b8c2909113fe99b3800f1fa43547db7c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:19:59 -0400
Subject: [PATCH 127/151] Correct the precedence of recursive bindings.

---
 semantic-core/src/Data/Core/Parser.hs | 3 +--
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index c457ceb77..0ea4c23fc 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -50,7 +50,7 @@ core :: (TokenParsing m, Monad m) => m (Term Core User)
 core = expr
 
 expr :: (TokenParsing m, Monad m) => m (Term Core User)
-expr = ifthenelse <|> lambda <|> assign
+expr = ifthenelse <|> lambda <|> rec <|> assign
 
 assign :: (TokenParsing m, Monad m) => m (Term Core User)
 assign = application <**> (flip (Core..=) <$ symbolic '=' <*> application <|> pure id) <?> "assignment"
@@ -67,7 +67,6 @@ atom = choice
   , edge
   , lit
   , ident
-  , rec
   , parens expr
   ]
 
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 74f84771f..926fe7d44 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -49,7 +49,7 @@ prettyCore style = precBody . go . fmap name
   where go = \case
           Var v -> atom v
           Term t -> case t of
-            Rec (Named (Ignored x) b) -> prec 11 . group . nest 2 $ vsep
+            Rec (Named (Ignored x) b) -> prec 3 . group . nest 2 $ vsep
               [ keyword "rec" <+> name x
               , symbol "=" <+> align (withPrec 0 (go (instantiate1 (pure (name x)) b)))
               ]

From 4bd2129511dfaf71e620f8ebb5550b44b38f72fd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:20:20 -0400
Subject: [PATCH 128/151] Lower the precedence in lambda bodies.

---
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 926fe7d44..0b07a8f19 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -55,7 +55,7 @@ prettyCore style = precBody . go . fmap name
               ]
 
             Lam (Named (Ignored x) b) -> prec 3 . group . nest 2 $ vsep
-              [ lambda <> name x, arrow <+> withPrec 3 (go (instantiate1 (pure (name x)) b)) ]
+              [ lambda <> name x, arrow <+> withPrec 0 (go (instantiate1 (pure (name x)) b)) ]
 
             Record fs -> atom . group . nest 2 $ vsep [ primitive "record", block ", " (map (uncurry keyValue) fs) ]
 

From 0d530dc078dba00dc0c177cbd4521ae3cf1ae9a3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:22:12 -0400
Subject: [PATCH 129/151] Sort the recursive generators.

---
 semantic-core/test/Generators.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index 84325ff21..e368b47f8 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -64,12 +64,12 @@ literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]
 expr :: MonadGen m => m (Term Core.Core User)
 expr = Gen.recursive Gen.choice atoms
   [ Gen.subtermM expr (\x -> flip Core.rec x <$> name)
-  , lambda expr
-  , record expr
-  , Gen.subterm2 expr expr (Core.$$)
-  , Gen.subterm3 expr expr expr Core.if'
   , Gen.subterm2 expr expr (Core.>>>)
   , Gen.subtermM2 expr expr (\ x y -> (Core.>>>= y) . (Core.:<- x) <$> name)
+  , lambda expr
+  , Gen.subterm2 expr expr (Core.$$)
+  , Gen.subterm3 expr expr expr Core.if'
+  , record expr
   , Gen.subtermM expr (\ x -> (x Core....) . namedValue <$> name)
   , Gen.subterm2 expr expr (Core..=)
   ]

From e4470bcbccd4067a6682e2fe2ad9c3b57bc3d426 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:23:26 -0400
Subject: [PATCH 130/151] Generate load instructions.

---
 semantic-core/test/Generators.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index e368b47f8..127f89ff8 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -69,6 +69,7 @@ expr = Gen.recursive Gen.choice atoms
   , lambda expr
   , Gen.subterm2 expr expr (Core.$$)
   , Gen.subterm3 expr expr expr Core.if'
+  , Gen.subterm expr Core.load
   , record expr
   , Gen.subtermM expr (\ x -> (x Core....) . namedValue <$> name)
   , Gen.subterm2 expr expr (Core..=)

From 3b6741456d37c393af4b795a9a07dc9dc80c77e2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:23:45 -0400
Subject: [PATCH 131/151] Rename edge to load.

---
 semantic-core/src/Data/Core/Parser.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 0ea4c23fc..b6e0e7b09 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -64,7 +64,7 @@ projection = foldl' (Core....) <$> atom <*> many (namedValue <$> (dot *> name))
 atom :: (TokenParsing m, Monad m) => m (Term Core User)
 atom = choice
   [ comp
-  , edge
+  , load
   , lit
   , ident
   , parens expr
@@ -89,8 +89,8 @@ ifthenelse = Core.if'
 rec :: (TokenParsing m, Monad m) => m (Term Core User)
 rec = Core.rec <$ reserved "rec" <*> name <* symbolic '=' <*> expr <?> "recursive binding"
 
-edge :: (TokenParsing m, Monad m) => m (Term Core User)
-edge = Core.load <$ reserved "load" <*> expr
+load :: (TokenParsing m, Monad m) => m (Term Core User)
+load = Core.load <$ reserved "load" <*> expr
 
 lvalue :: (TokenParsing m, Monad m) => m (Term Core User)
 lvalue = choice

From ac3f4877034d9fd35d71488c9de96a9a16a13c32 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:24:19 -0400
Subject: [PATCH 132/151] Correct the precedence of load.

---
 semantic-core/src/Data/Core/Parser.hs | 3 +--
 semantic-core/src/Data/Core/Pretty.hs | 2 +-
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index b6e0e7b09..6d396273a 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -50,7 +50,7 @@ core :: (TokenParsing m, Monad m) => m (Term Core User)
 core = expr
 
 expr :: (TokenParsing m, Monad m) => m (Term Core User)
-expr = ifthenelse <|> lambda <|> rec <|> assign
+expr = ifthenelse <|> lambda <|> rec <|> load <|> assign
 
 assign :: (TokenParsing m, Monad m) => m (Term Core User)
 assign = application <**> (flip (Core..=) <$ symbolic '=' <*> application <|> pure id) <?> "assignment"
@@ -64,7 +64,6 @@ projection = foldl' (Core....) <$> atom <*> many (namedValue <$> (dot *> name))
 atom :: (TokenParsing m, Monad m) => m (Term Core User)
 atom = choice
   [ comp
-  , load
   , lit
   , ident
   , parens expr
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 0b07a8f19..2bb0170b6 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -71,7 +71,7 @@ prettyCore style = precBody . go . fmap name
               , keyword "else" <+> precBody (go fal)
               ]
 
-            Load p -> prec 8 (keyword "load" <+> withPrec 9 (go p))
+            Load p -> prec 3 (keyword "load" <+> withPrec 9 (go p))
             item :. body -> prec 9 (withPrec 9 (go item) <> symbol "." <> name body)
 
             lhs := rhs -> prec 3 . group . nest 2 $ vsep

From 3d65ae97efe335f1dbeb1d6383b897e1869434e9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:27:03 -0400
Subject: [PATCH 133/151] Sort the atoms.

---
 semantic-core/test/Generators.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index 127f89ff8..eb65f8adf 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -56,7 +56,7 @@ record :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
 record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . namedValue <$> name <*> bod)
 
 atoms :: MonadGen m => [m (Term Core.Core User)]
-atoms = [boolean, variable, pure Core.unit]
+atoms = [variable, pure Core.unit, boolean]
 
 literal :: MonadGen m => m (Term Core.Core User)
 literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]

From f10cbb21b39312db854e862ba2dbac811f62eead Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:43:11 -0400
Subject: [PATCH 134/151] Generate string literals.

---
 semantic-core/test/Generators.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index eb65f8adf..3ec79e8be 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -56,7 +56,7 @@ record :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
 record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . namedValue <$> name <*> bod)
 
 atoms :: MonadGen m => [m (Term Core.Core User)]
-atoms = [variable, pure Core.unit, boolean]
+atoms = [variable, pure Core.unit, boolean, Core.string <$> Gen.text (Range.linear 1 10) Gen.lower]
 
 literal :: MonadGen m => m (Term Core.Core User)
 literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]

From 0254bc9895d384505cdba03a2082cc6de39b7983 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:43:25 -0400
Subject: [PATCH 135/151] Parse more escape sequences.

---
 semantic-core/src/Data/Core/Parser.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 6d396273a..b95a94bd4 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -109,8 +109,14 @@ lit = let x `given` n = x <$ reserved n in choice
   , Core.bool False `given` "#false"
   , Core.unit       `given` "#unit"
   , record
-  , between (string "\"") (string "\"") (Core.string . fromString <$> many ('"' <$ string "\\\"" <|> noneOf "\""))
+  , between (string "\"") (string "\"") (Core.string . fromString <$> many (escape <|> (noneOf "\"" <?> "non-escaped character")))
   ] <?> "literal"
+  where escape = char '\\' *> choice
+          [ '"' <$ string "\""
+          , '\n' <$ string "n"
+          , '\r' <$ string "r"
+          , '\t' <$ string "t"
+          ] <?> "escape sequence"
 
 record :: (TokenParsing m, Monad m) => m (Term Core User)
 record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> expr) comma)

From 15430badecae053884a5c8941133b3368ec9eb71 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:44:02 -0400
Subject: [PATCH 136/151] Alignment.

---
 semantic-core/src/Data/Core/Parser.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index b95a94bd4..1b1317f94 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -112,7 +112,7 @@ lit = let x `given` n = x <$ reserved n in choice
   , between (string "\"") (string "\"") (Core.string . fromString <$> many (escape <|> (noneOf "\"" <?> "non-escaped character")))
   ] <?> "literal"
   where escape = char '\\' *> choice
-          [ '"' <$ string "\""
+          [ '"'  <$ string "\""
           , '\n' <$ string "n"
           , '\r' <$ string "r"
           , '\t' <$ string "t"

From 41a31d18733a6f1aad41789b791e45a73891c715 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:49:22 -0400
Subject: [PATCH 137/151] Simplify the projection rule.

---
 semantic-core/src/Data/Core/Parser.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 1b1317f94..128aef5f8 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -59,7 +59,7 @@ application :: (TokenParsing m, Monad m) => m (Term Core User)
 application = projection `chainl1` (pure (Core.$$))
 
 projection :: (TokenParsing m, Monad m) => m (Term Core User)
-projection = foldl' (Core....) <$> atom <*> many (namedValue <$> (dot *> name))
+projection = foldl' (Core....) <$> atom <*> many (namedValue <$ dot <*> name)
 
 atom :: (TokenParsing m, Monad m) => m (Term Core User)
 atom = choice

From 7c2467292146138eccf1bd1e3f8559e5de3d4418 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 15:53:18 -0400
Subject: [PATCH 138/151] Parse whitespace following string literals.

---
 semantic-core/src/Data/Core/Parser.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 128aef5f8..45034f4dc 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -109,7 +109,7 @@ lit = let x `given` n = x <$ reserved n in choice
   , Core.bool False `given` "#false"
   , Core.unit       `given` "#unit"
   , record
-  , between (string "\"") (string "\"") (Core.string . fromString <$> many (escape <|> (noneOf "\"" <?> "non-escaped character")))
+  , token (between (string "\"") (string "\"") (Core.string . fromString <$> many (escape <|> (noneOf "\"" <?> "non-escaped character"))))
   ] <?> "literal"
   where escape = char '\\' *> choice
           [ '"'  <$ string "\""

From a0bf65f43b1489a3590d6381fb947858ab3f91c5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 23 Jul 2019 16:11:04 -0400
Subject: [PATCH 139/151] Move Edge into Concrete.

---
 semantic-core/src/Analysis/Concrete.hs | 17 ++++++++++-------
 semantic-core/src/Data/Core.hs         |  4 ----
 2 files changed, 10 insertions(+), 11 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 05f052229..fab556ad2 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -59,6 +59,9 @@ newtype Frame = Frame
 
 type Heap = IntMap.IntMap Concrete
 
+data Edge = Lexical | Import
+  deriving (Eq, Ord, Show)
+
 
 -- | Concrete evaluation of a term to a value.
 --
@@ -153,14 +156,14 @@ runHeap = runState mempty
 --   > λ let (heap, res) = concrete [ruby]
 --   > λ writeFile "/Users/rob/Desktop/heap.dot" (export (addressStyle heap) (heapAddressGraph heap))
 --   > λ :!dot -Tsvg < ~/Desktop/heap.dot > ~/Desktop/heap.svg
-heapGraph :: (Precise -> Concrete -> a) -> (Either Core.Edge User -> Precise -> G.Graph a) -> Heap -> G.Graph a
+heapGraph :: (Precise -> Concrete -> a) -> (Either Edge User -> Precise -> G.Graph a) -> Heap -> G.Graph a
 heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
   where graph k v rest = (G.vertex (vertex k v) `G.connect` outgoing v) `G.overlay` rest
         outgoing = \case
           Unit -> G.empty
           Bool _ -> G.empty
           String _ -> G.empty
-          Closure _ _ _ env -> foldr (G.overlay . edge (Left Core.Lexical)) G.empty env
+          Closure _ _ _ env -> foldr (G.overlay . edge (Left Lexical)) G.empty env
           Record frame -> foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList frame)
 
 heapValueGraph :: Heap -> G.Graph Concrete
@@ -173,10 +176,10 @@ heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,)
 addressStyle :: Heap -> G.Style (EdgeType, Precise) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
-        edgeAttributes _ (Slot name,         _) = ["label" G.:= name]
-        edgeAttributes _ (Edge Core.Import,  _) = ["color" G.:= "blue"]
-        edgeAttributes _ (Edge Core.Lexical, _) = ["color" G.:= "green"]
-        edgeAttributes _ _                      = []
+        edgeAttributes _ (Slot name,    _) = ["label" G.:= name]
+        edgeAttributes _ (Edge Import,  _) = ["color" G.:= "blue"]
+        edgeAttributes _ (Edge Lexical, _) = ["color" G.:= "green"]
+        edgeAttributes _ _                 = []
         fromConcrete = \case
           Unit ->  "()"
           Bool b -> pack $ show b
@@ -186,7 +189,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 
 data EdgeType
-  = Edge Core.Edge
+  = Edge Edge
   | Slot User
   | Value Concrete
   deriving (Eq, Ord, Show)
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 4cdc68c7a..83b6c25b2 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -2,7 +2,6 @@
              ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Data.Core
 ( Core(..)
-, Edge(..)
 , rec
 , (>>>)
 , unseq
@@ -50,9 +49,6 @@ import Data.Text (Text)
 import GHC.Generics (Generic1)
 import GHC.Stack
 
-data Edge = Lexical | Import
-  deriving (Eq, Ord, Show)
-
 data Core f a
   -- | Recursive local binding of a name in a scope; strict evaluation of the name in the body will diverge.
   --

From 93eba2061954e719e6e23ac2aa4ee6c7efdfe0c0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 11:55:43 -0400
Subject: [PATCH 140/151] Rename un/unEither to unprefix/unprefixEither.

---
 semantic-core/src/Data/Core.hs  |  2 +-
 semantic-core/src/Data/Scope.hs | 12 ++++++------
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 83b6c25b2..65bbbe7ba 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -143,7 +143,7 @@ do' bindings = fromMaybe unit (foldr bind Nothing bindings)
   where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a
 
 unstatements :: (Member Core sig, RightModule sig) => Term sig a -> (Stack (Maybe (Named (Either Int a)) :<- Term sig (Either Int a)), Term sig (Either Int a))
-unstatements = un (unstatement . Left) . fmap Right
+unstatements = unprefix (unstatement . Left) . fmap Right
 
 data a :<- b = a :<- b
   deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 4f7c58d79..07d878c07 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -12,8 +12,8 @@ module Data.Scope
 , instantiate1
 , instantiate
 , instantiateEither
-, un
-, unEither
+, unprefix
+, unprefixEither
 ) where
 
 import Control.Applicative (liftA2)
@@ -110,11 +110,11 @@ instantiateEither :: Monad f => (Either a b -> f c) -> Scope a f b -> f c
 instantiateEither f = unScope >=> incr (f . Left) (>>= f . Right)
 
 
-un :: (Int -> t -> Maybe (a, t)) -> t -> (Stack a, t)
-un from = unEither (matchMaybe . from)
+unprefix :: (Int -> t -> Maybe (a, t)) -> t -> (Stack a, t)
+unprefix from = unprefixEither (matchMaybe . from)
 
-unEither :: (Int -> t -> Either (a, t) b) -> t -> (Stack a, b)
-unEither from = go (0 :: Int) Nil
+unprefixEither :: (Int -> t -> Either (a, t) b) -> t -> (Stack a, b)
+unprefixEither from = go (0 :: Int) Nil
   where go i bs t = case from i t of
           Left (b, t) -> go (succ i) (bs :> b) t
           Right b     -> (bs, b)

From 7b0a4155da0d3d98212482f8e097bb2e3ccdcdf8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 11:57:10 -0400
Subject: [PATCH 141/151] :memo: unprefix.

---
 semantic-core/src/Data/Scope.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 07d878c07..c6fd1dd92 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -110,6 +110,7 @@ instantiateEither :: Monad f => (Either a b -> f c) -> Scope a f b -> f c
 instantiateEither f = unScope >=> incr (f . Left) (>>= f . Right)
 
 
+-- | Unwrap a (possibly-empty) prefix of @a@s wrapping a @t@ using a helper function.
 unprefix :: (Int -> t -> Maybe (a, t)) -> t -> (Stack a, t)
 unprefix from = unprefixEither (matchMaybe . from)
 

From ab07e5a0d6c5e4c1555f862d90d270e8d40f3d17 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 11:59:20 -0400
Subject: [PATCH 142/151] =?UTF-8?q?:memo:=20unprefix=E2=80=99s=20purpose.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Scope.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index c6fd1dd92..7b24a73aa 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -111,6 +111,8 @@ instantiateEither f = unScope >=> incr (f . Left) (>>= f . Right)
 
 
 -- | Unwrap a (possibly-empty) prefix of @a@s wrapping a @t@ using a helper function.
+--
+--   This allows us to peel a prefix of syntax, typically binders, off of a term, returning a stack of prefixing values (e.g. variables) and the outermost term rejected by the function.
 unprefix :: (Int -> t -> Maybe (a, t)) -> t -> (Stack a, t)
 unprefix from = unprefixEither (matchMaybe . from)
 

From e2ec37ebdbe90b4e9891764e928d2743f6076520 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:01:30 -0400
Subject: [PATCH 143/151] =?UTF-8?q?:memo:=20unprefix=E2=80=99s=20parameter?=
 =?UTF-8?q?s.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Scope.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 7b24a73aa..8b89e9939 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -113,7 +113,10 @@ instantiateEither f = unScope >=> incr (f . Left) (>>= f . Right)
 -- | Unwrap a (possibly-empty) prefix of @a@s wrapping a @t@ using a helper function.
 --
 --   This allows us to peel a prefix of syntax, typically binders, off of a term, returning a stack of prefixing values (e.g. variables) and the outermost term rejected by the function.
-unprefix :: (Int -> t -> Maybe (a, t)) -> t -> (Stack a, t)
+unprefix
+  :: (Int -> t -> Maybe (a, t)) -- ^ A function taking the 0-based index into the prefix & the current term, and optionally returning a pair of the prefixing value and the inner subterm.
+  -> t                          -- ^ The initial term.
+  -> (Stack a, t)               -- ^ A stack of prefixing values & the final subterm.
 unprefix from = unprefixEither (matchMaybe . from)
 
 unprefixEither :: (Int -> t -> Either (a, t) b) -> t -> (Stack a, b)

From eb2ede6d1db1ba19a23fba9d8d3c2b2b8b18d52b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:02:47 -0400
Subject: [PATCH 144/151] Subterm.

---
 semantic-core/src/Data/Scope.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 8b89e9939..bc4533904 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -112,7 +112,7 @@ instantiateEither f = unScope >=> incr (f . Left) (>>= f . Right)
 
 -- | Unwrap a (possibly-empty) prefix of @a@s wrapping a @t@ using a helper function.
 --
---   This allows us to peel a prefix of syntax, typically binders, off of a term, returning a stack of prefixing values (e.g. variables) and the outermost term rejected by the function.
+--   This allows us to peel a prefix of syntax, typically binders, off of a term, returning a stack of prefixing values (e.g. variables) and the outermost subterm rejected by the function.
 unprefix
   :: (Int -> t -> Maybe (a, t)) -- ^ A function taking the 0-based index into the prefix & the current term, and optionally returning a pair of the prefixing value and the inner subterm.
   -> t                          -- ^ The initial term.

From 7c686d1ccbd8dc3e6d9ede3fef8b6bf6bcf263b8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:04:22 -0400
Subject: [PATCH 145/151] :memo: unprefixEither.

---
 semantic-core/src/Data/Scope.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index bc4533904..6748391ab 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -119,6 +119,9 @@ unprefix
   -> (Stack a, t)               -- ^ A stack of prefixing values & the final subterm.
 unprefix from = unprefixEither (matchMaybe . from)
 
+-- | Unwrap a (possibly-empty) prefix of @a@s wrapping a @b@ within a @t@ using a helper function.
+--
+--   Compared to 'unprefix', this allows the helper function to extract inner terms of a different type, for example when @t@ is a right @b@-module.
 unprefixEither :: (Int -> t -> Either (a, t) b) -> t -> (Stack a, b)
 unprefixEither from = go (0 :: Int) Nil
   where go i bs t = case from i t of

From 0d2f05a8c75339156905112426dfeed6b6db4fe2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:05:22 -0400
Subject: [PATCH 146/151] :memo: the parameters to unprefixEither.

---
 semantic-core/src/Data/Scope.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 6748391ab..63fa2ced1 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -122,7 +122,10 @@ unprefix from = unprefixEither (matchMaybe . from)
 -- | Unwrap a (possibly-empty) prefix of @a@s wrapping a @b@ within a @t@ using a helper function.
 --
 --   Compared to 'unprefix', this allows the helper function to extract inner terms of a different type, for example when @t@ is a right @b@-module.
-unprefixEither :: (Int -> t -> Either (a, t) b) -> t -> (Stack a, b)
+unprefixEither
+  :: (Int -> t -> Either (a, t) b) -- ^ A function taking the 0-based index into the prefix & the current term, and returning either a pair of the prefixing value and the next inner subterm of type @t@, or the final inner subterm of type @b@.
+  -> t                             -- ^ The initial term.
+  -> (Stack a, b)                  -- ^ A stack of prefixing values & the final subterm.
 unprefixEither from = go (0 :: Int) Nil
   where go i bs t = case from i t of
           Left (b, t) -> go (succ i) (bs :> b) t

From dd6d9a020954f557336512e40056de006c8b4db6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:07:01 -0400
Subject: [PATCH 147/151] Type application.

---
 semantic-core/src/Analysis/Concrete.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index fab556ad2..ad852d47b 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
 , concrete
@@ -84,7 +84,7 @@ runFile :: ( Carrier sig m
 runFile file = traverse run file
   where run = runReader (fileLoc file)
             . runFailWithLoc
-            . runReader (mempty :: Env)
+            . runReader @Env mempty
             . fix (eval concreteAnalysis)
 
 concreteAnalysis :: ( Carrier sig m

From 28404ae11ef45c4fe52c2e1ee4b6eb8dfb0ffc6e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:12:11 -0400
Subject: [PATCH 148/151] foldrWithKey.

:tophat: @patrickt.
---
 semantic-core/src/Analysis/Concrete.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index ad852d47b..8cc45b8cb 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -164,7 +164,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Bool _ -> G.empty
           String _ -> G.empty
           Closure _ _ _ env -> foldr (G.overlay . edge (Left Lexical)) G.empty env
-          Record frame -> foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList frame)
+          Record frame -> Map.foldrWithKey (\ k -> G.overlay . edge (Right k)) G.empty frame
 
 heapValueGraph :: Heap -> G.Graph Concrete
 heapValueGraph h = heapGraph (const id) (const fromAddr) h

From b80dd5381aadc887fb870a9e0411362b1bbaf17b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:18:34 -0400
Subject: [PATCH 149/151] Pull the rhs into a where clause.

---
 semantic-core/src/Data/Core/Parser.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 45034f4dc..e71b0ec79 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -53,7 +53,8 @@ expr :: (TokenParsing m, Monad m) => m (Term Core User)
 expr = ifthenelse <|> lambda <|> rec <|> load <|> assign
 
 assign :: (TokenParsing m, Monad m) => m (Term Core User)
-assign = application <**> (flip (Core..=) <$ symbolic '=' <*> application <|> pure id) <?> "assignment"
+assign = application <**> (symbolic '=' *> rhs <|> pure id) <?> "assignment"
+  where rhs = flip (Core..=) <$> application
 
 application :: (TokenParsing m, Monad m) => m (Term Core User)
 application = projection `chainl1` (pure (Core.$$))

From 78bd32e0b0e19ddc247b9e53e86758a5084a67d0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:23:01 -0400
Subject: [PATCH 150/151] =?UTF-8?q?Don=E2=80=99t=20prefix=20:<-.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Data/Core/Parser.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index e71b0ec79..61be0ad74 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -11,7 +11,7 @@ module Data.Core.Parser
 
 import           Control.Applicative
 import qualified Data.Char as Char
-import           Data.Core (Core)
+import           Data.Core ((:<-) (..), Core)
 import qualified Data.Core as Core
 import           Data.Foldable (foldl')
 import           Data.Name
@@ -73,10 +73,10 @@ atom = choice
 comp :: (TokenParsing m, Monad m) => m (Term Core User)
 comp = braces (Core.do' <$> sepEndByNonEmpty statement semi) <?> "compound statement"
 
-statement :: (TokenParsing m, Monad m) => m (Maybe (Named User) Core.:<- Term Core User)
+statement :: (TokenParsing m, Monad m) => m (Maybe (Named User) :<- Term Core User)
 statement
-  =   try ((Core.:<-) . Just <$> name <* symbol "<-" <*> expr)
-  <|> (Nothing Core.:<-) <$> expr
+  =   try ((:<-) . Just <$> name <* symbol "<-" <*> expr)
+  <|> (Nothing :<-) <$> expr
   <?> "statement"
 
 ifthenelse :: (TokenParsing m, Monad m) => m (Term Core User)

From 372ed98b5e418c86cc8bfb9f1e5232da162b6a58 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 12:25:05 -0400
Subject: [PATCH 151/151] Avoid rolling our own string literal parser.

:tophat: @patrickt.
---
 semantic-core/src/Data/Core/Parser.hs | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 61be0ad74..3ae921dd7 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -110,14 +110,8 @@ lit = let x `given` n = x <$ reserved n in choice
   , Core.bool False `given` "#false"
   , Core.unit       `given` "#unit"
   , record
-  , token (between (string "\"") (string "\"") (Core.string . fromString <$> many (escape <|> (noneOf "\"" <?> "non-escaped character"))))
+  , Core.string <$> stringLiteral
   ] <?> "literal"
-  where escape = char '\\' *> choice
-          [ '"'  <$ string "\""
-          , '\n' <$ string "n"
-          , '\r' <$ string "r"
-          , '\t' <$ string "t"
-          ] <?> "escape sequence"
 
 record :: (TokenParsing m, Monad m) => m (Term Core User)
 record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> expr) comma)