new calling convention ("copy") now works

pkg/proto/lib/Nock.hs

@@ -34,20 +34,21 @@ no  = A 1
 -- | Tree address
 type Axis = Atom
 
-data Nock = NC Nock Nock           -- ^ ^: autocons
-          | N0 Axis                -- ^ 0, axis: tree addressing
-          | N1 Noun                -- ^ 1, const: constant
-          | N2 Nock Nock           -- ^ 2, compose: compute subject, formula; apply
-          | N3 Nock                -- ^ 3, is cell
-          | N4 Nock                -- ^ 4, succ
-          | N5 Nock Nock           -- ^ 5, eq
-          | N6 Nock Nock Nock      -- ^ 6, if
-          | N7 Nock Nock           -- ^ 7, then: =>
-          | N8 Nock Nock           -- ^ 8, push: =+
-          | N9 Axis Nock           -- ^ 9, invoke
-          | N10 (Axis, Nock) Nock  -- ^ 10, edit
-          | N11 Hint Nock          -- ^ 11, hint
-          | N12 Nock Nock          -- ^ 12, scry
+data Nock
+  = NC Nock Nock           -- ^ ^: autocons
+  | N0 Axis                -- ^ 0, axis: tree addressing
+  | N1 Noun                -- ^ 1, const
+  | N2 Nock Nock           -- ^ 2, compose: compute subject, formula; apply
+  | N3 Nock                -- ^ 3, is cell
+  | N4 Nock                -- ^ 4, succ
+  | N5 Nock Nock           -- ^ 5, eq
+  | N6 Nock Nock Nock      -- ^ 6, if
+  | N7 Nock Nock           -- ^ 7, then: =>
+  | N8 Nock Nock           -- ^ 8, push: =+
+  | N9 Axis Nock           -- ^ 9, invoke
+  | N10 (Axis, Nock) Nock  -- ^ 10, edit
+  | N11 Hint Nock          -- ^ 11, hint
+  | N12 Nock Nock          -- ^ 12, scry
   deriving (Eq, Ord, Read)
 
 data Hint = Tag Atom
@@ -121,7 +122,7 @@ nock n = \case
   N7 f g -> nock (nock n f) g
   N8 f g -> nock (C (nock n f) n) g
   N9 a f -> let c = nock n f in nock c (nounToNock (axis a c))
-  N10{} -> error "nock: I don't want to implement editing right now"
+  N10 (a, f) g -> edit a (nock n f) (nock n g)
   N11 _ f -> nock n f
   N12{} -> error "nock: scrying is not allowed"
 
@@ -132,9 +133,7 @@ data Dir = L | R
   deriving (Eq, Ord, Enum, Read, Show)
 type Path = [Dir]
 
--- Write an axis as a binary number; e.g. 5 as 101.
--- The rule is: after droping the 1 in the msb, you read from left to right.
--- 0 becomes L and 1 becomes R.
+-- some stuff from hoon.hoon
 
 cap :: Axis -> Dir
 cap = \case
@@ -171,8 +170,18 @@ axis 1 n = n
 axis (capMas -> (d, r)) (C n m) = case d of
   L -> axis r n
   R -> axis r m
-axis a n = error ("bad axis: " ++ show a)
+axis a _ = error ("bad axis: " ++ show a)
 
+edit :: Axis -> Tree a -> Tree a -> Tree a
+edit 1 v n = v
+edit (capMas -> (d, r)) v (C n m) = case d of
+  L -> C (edit r v n) m
+  R -> C n (edit r v m)
+edit a _ _ = error ("bad edit: " ++ show a)
+
+-- Write an axis as a binary number; e.g. 5 as 101.
+-- The rule is: after droping the 1 in the msb, you read from left to right.
+-- 0 becomes L and 1 becomes R. So 5 becomes [L,R]
 toPath :: Axis -> Path
 toPath = \case
   1 -> []

pkg/proto/lib/UntypedLambda.hs

@@ -105,21 +105,19 @@ data CopyExp
   | CApp CopyExp CopyExp
   | CLam [CopyVar] CopyExp
 
-toCopy :: forall a. Ord a => Exp a -> CopyExp
+toCopy :: Ord a => Exp a -> CopyExp
 toCopy = fst . go \v -> error "toCopy: free variable"
   where
-    go :: (a -> CopyVar) -> Exp a -> (CopyExp, Set a)
+    go :: Ord a => (a -> CopyVar) -> Exp a -> (CopyExp, Set a)
     go env = \case
       Var v -> (CVar (env v), singleton v)
       App e f -> (CApp ec fc, union eu fu)
         where
           (ec, eu) = go env e
           (fc, fu) = go env f
-      Lam s -> (CLam (map env u) c, fromList u)
+      Lam s -> (CLam (map env u) c, setFromList u)
         where
-          c :: CopyExp
           (c, u') = go env' (fromScope s)
-          env' :: Var () a -> CopyVar
           env' = \case
             B () -> Argument
             F v  -> Lexical (fromJust (elemIndex v u))
@@ -128,19 +126,24 @@ toCopy = fst . go \v -> error "toCopy: free variable"
             B () -> Nothing
             F v  -> Just v
 
+-- Possible improvements:
+--   - store the copied values in a tree rather than list
+--   - avoid a nock 8 if nothing is copied
 copyToNock :: CopyExp -> Nock
 copyToNock = \case
-  CVar v -> toAxis case v of
+  CVar v -> N0 $ toAxis case v of
     Argument -> [R]
-    Lexical n -> L : repeat n R ++ L
+    Lexical n -> L : replicate n R ++ [L]
   CApp e f -> N2 (copyToNock f) (copyToNock e)
+  CLam vs e -> lam (map (copyToNock . CVar) vs) (nockToNoun (copyToNock e))
+  where
+    lam vfs ef = NC (N1 (A 8)) (NC (NC (N1 (A 1)) vars) (N1 ef))
+      where
+        vars = foldr NC (N1 (A 0)) vfs
 
 -- | The proposed new calling convention
-new :: Exp a -> Nock
-new = go \v -> error "new: free variable"
-  where
-    go = undefined
-
+copy :: Ord a => Exp a -> Nock
+copy = copyToNock . toCopy
 
 
 -- x. y. x