From 7bcc159e88943adf68667c8199db920083f85f3f Mon Sep 17 00:00:00 2001
From: Paul Chiusano <paul.chiusano@gmail.com>
Date: Mon, 20 Apr 2015 09:26:49 -0400
Subject: [PATCH] Using type alias for better signature readability of
 at/modify

---
 node/src/Unison/ABT.hs    | 12 ++++++------
 node/src/Unison/A_Term.hs | 31 +++++++++++++++----------------
 2 files changed, 21 insertions(+), 22 deletions(-)

diff --git a/node/src/Unison/ABT.hs b/node/src/Unison/ABT.hs
index ae6ca1f81..977770c76 100644
--- a/node/src/Unison/ABT.hs
+++ b/node/src/Unison/ABT.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Unison.ABT (ABT(..),abs,at,freevars,hash,into,modify,out,rename,subst,tm,Term,V) where
+module Unison.ABT (ABT(..),abs,at,At,freevars,hash,into,modify,out,rename,ReplaceAt,subst,tm,Term,V) where
 
 import Control.Applicative
 import Data.Aeson (ToJSON(..),FromJSON(..))
@@ -84,8 +84,11 @@ subst t x body = case out body of
                else subst t x e
   Tm body -> tm (fmap (subst t x) body)
 
+type At f a = f a -> Maybe a
+type ReplaceAt f a = f a -> Maybe (a, a -> f a)
+
 -- | Extract the subterm a path points to
-at :: [f (Term f) -> Maybe (Term f)] -> Term f -> Maybe (Term f)
+at :: [At f (Term f)] -> Term f -> Maybe (Term f)
 at [] t = Just t
 at path@(hd:tl) t = case out t of
   Abs _ t -> at path t
@@ -94,10 +97,7 @@ at path@(hd:tl) t = case out t of
 
 -- | Modify the subterm a path points to
 modify :: Foldable f
-       => (Term f -> Term f)
-       -> [f (Term f) -> Maybe (Term f, Term f -> f (Term f))]
-       -> Term f
-       -> Maybe (Term f)
+       => (Term f -> Term f) -> [ReplaceAt f (Term f)] -> Term f -> Maybe (Term f)
 modify f [] t = Just (f t)
 modify f path@(hd:tl) t = case out t of
   Abs v t -> abs v <$> modify f path t
diff --git a/node/src/Unison/A_Term.hs b/node/src/Unison/A_Term.hs
index 5706c545d..d8a93d670 100644
--- a/node/src/Unison/A_Term.hs
+++ b/node/src/Unison/A_Term.hs
@@ -109,28 +109,28 @@ data PathElement
 newtype Path = Path [PathElement] deriving (Eq,Ord)
 
 -- | Use a @PathElement@ to compute one step into an @F a@ subexpression
-focus :: PathElement -> F a -> Maybe (a, a -> F a)
-focus Fn (App f x) = Just (f, \f -> App f x)
-focus Arg (App f x) = Just (x, \x -> App f x)
-focus Body (Lam body) = Just (body, Lam)
-focus Body (Let bs body) = Just (body, Let bs)
-focus Body (LetRec bs body) = Just (body, LetRec bs)
-focus (Binding i) (Let bs body) =
+stepPath :: PathElement -> ABT.ReplaceAt F a
+stepPath Fn (App f x) = Just (f, \f -> App f x)
+stepPath Arg (App f x) = Just (x, \x -> App f x)
+stepPath Body (Lam body) = Just (body, Lam)
+stepPath Body (Let bs body) = Just (body, Let bs)
+stepPath Body (LetRec bs body) = Just (body, LetRec bs)
+stepPath (Binding i) (Let bs body) =
   listToMaybe (drop i bs)
   >>= \b -> Just (b, \b -> Let (take i bs ++ [b] ++ drop (i+1) bs) body)
-focus (Binding i) (LetRec bs body) =
+stepPath (Binding i) (LetRec bs body) =
   listToMaybe (drop i bs)
   >>= \b -> Just (b, \b -> LetRec (take i bs ++ [b] ++ drop (i+1) bs) body)
-focus (Index i) (Vector vs) =
+stepPath (Index i) (Vector vs) =
   vs !? i >>= \v -> Just (v, \v -> Vector (vs // [(i,v)]))
-focus _ _ = Nothing
+stepPath _ _ = Nothing
 
 at :: Path -> Term -> Maybe Term
-at (Path p) t = ABT.at (map focus' p) t
-  where focus' e t = fst <$> focus e t
+at (Path p) t = ABT.at (map stepPath' p) t
+  where stepPath' e t = fst <$> stepPath e t
 
 modify :: (Term -> Term) -> Path -> Term -> Maybe Term
-modify f (Path p) t = ABT.modify f (map focus p) t
+modify f (Path p) t = ABT.modify f (map stepPath p) t
 
 -- mostly boring serialization and hashing code below ...
 
@@ -159,9 +159,8 @@ instance Digest.Digestable1 F where
     Vector as -> Digest.run $ Put.putWord8 5 *> serialize (Vector.length as)
                                              *> traverse_ (serialize . hash) as
     Lam a -> Digest.run $ Put.putWord8 6 *> serialize (hash a)
-    -- note: we use `s` to canonicalize the order of `as` before hashing the sequence
-    LetRec as a -> Digest.run $ Put.putWord8 7 *> traverse_ (serialize . hash) (s as)
-                                               *> serialize (hash a)
+    -- note: we use `s` to canonicalize the order of `a:as` before hashing the sequence
+    LetRec as a -> Digest.run $ Put.putWord8 7 *> traverse_ (serialize . hash) (s (a:as))
     -- here, order is significant, so leave order alone
     Let as a -> Digest.run $ Put.putWord8 8 *> traverse_ (serialize . hash) as
                                             *> serialize (hash a)