Hooked up edit actions, including evaluation!

editor/src/Unison/Editor.elm

@@ -255,6 +255,14 @@ preapply origin model = case model.explorer of
                 |> refreshPanel Nothing origin
   Just _ -> model
 
+edit : Action.Action -> Action
+edit a model = case model.explorer of
+  Nothing -> case model.scope of
+    -- todo - can do edit with respect to narrowest closed scope
+    Just scope -> (Just (Edit [] scope.focus a model.term), model)
+    Nothing -> norequest model
+  Just _ -> norequest model -- ignore actions while explorer is open
+
 closeExplorer : Model -> Model
 closeExplorer model =
   let layouts = model.layouts
@@ -472,6 +480,7 @@ type alias Inputs =
   , clicks : Signal ()
   , mouse : Signal (Int,Int)
   , enters : Signal ()
+  , edits : Signal Action.Action
   , deletes : Signal ()
   , preapplies : Signal ()
   , modifier : Signal Bool -- generally shift
@@ -500,6 +509,7 @@ actions ctx =
      Signal.map resizef steadyWidth `merge`
      Signal.map (deletef ctx.origin) ctx.deletes `merge`
      Signal.map (preapplyf ctx.origin) ctx.preapplies `merge`
+     Signal.map edit ctx.edits `merge`
      Signal.map (always (enter searchbox ctx.origin)) ctx.enters `merge`
      Signal.map moveMouse ctx.mouse `merge`
      Signals.map2r (setSearchbox searchbox ctx.origin) ctx.modifier content `merge`
@@ -602,13 +612,19 @@ search2 searchbox origin reqs =
 
 main =
   let origin = (15,15)
+      keyEvent code = Signal.map (always ()) (Signals.ups (Keyboard.isDown code))
+      keyEventAs k code = Signal.map (always k) (Signals.ups (Keyboard.isDown code))
+
       inputs = { origin = origin
                , clicks = Mouse.clicks `Signal.merge` (Signals.doubleWithin Time.second Touch.taps)
                , mouse = Mouse.position `Signal.merge` (Signal.map (\{x,y} -> (x,y)) Touch.taps)
                , enters = Signal.map (always ()) (Signals.ups (Keyboard.enter))
                , modifier = Keyboard.shift
-               , deletes = Signal.map (always ()) (Signals.ups (Keyboard.isDown 68))
-               , preapplies = Signal.map (always ()) (Signals.ups (Keyboard.isDown 65))
+               , edits = keyEventAs Action.Step 83 `Signal.merge` -- [s]tep
+                         keyEventAs Action.WHNF 69 `Signal.merge` -- [e]valuate
+                         keyEventAs Action.Eta 82 -- eta [r]educe
+               , deletes = keyEvent 68
+               , preapplies = keyEvent 65
                , movements = Movement.d2' Keyboard.arrows
                , searchbox = Signal.channel Field.noContent
                , width = Window.width }
@@ -616,7 +632,8 @@ main =
       ignoreReqs actions =
         let ignore action model = snd (action model)
         in Signal.map ignore actions
-      expr = Term.Lam (Term.Lam (Term.Var 2))
+      ap = Term.App
+      expr = Term.Lam (Term.Lam (Term.Var 2)) `ap` Terms.int 42 `ap` Terms.str "hello"
       -- expr = (Term.Lam (Terms.int 42))
       ms = models inputs
                   (search2 (Signal.send inputs.searchbox) origin)

node/src/Unison/Edit/Term/Eval/Interpreter.hs

@@ -3,6 +3,7 @@ module Unison.Edit.Term.Eval.Interpreter where
 
 import Control.Applicative
 import Control.Monad
+import Debug.Trace
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import qualified Data.Map as M
@@ -16,12 +17,17 @@ import qualified Unison.Syntax.Reference as R
 data Primop f =
   Primop { arity :: Int, call :: [Term] -> f Term }
 
+watch :: Show a => String -> a -> a
+watch msg a = trace (msg ++ ": " ++ show a) a
+
 -- | Produce an evaluator from a environment of 'Primop' values
 eval :: (Applicative f, Monad f) => Map R.Reference (Primop f) -> Eval f
-eval env = Eval step whnf
+eval env = Eval whnf step
   where
-    reduce e@(E.App (E.Lam _) _) args =
-      return $ Just (foldl E.App (E.betaReduce e) args)
+    reduce (E.Lam _) [] = return Nothing
+    reduce e@(E.Lam _) (arg1:args) =
+      return $ let r = watch "reduced" $ E.betaReduce (E.App e arg1)
+               in Just (foldl E.App r args)
     reduce (E.App (E.Ref h) x) args = case M.lookup h env of
       Nothing -> return Nothing
       Just op | length (x:args) >= arity op ->
@@ -29,11 +35,13 @@ eval env = Eval step whnf
           return . Just $ foldl E.App e (drop (arity op) (x:args))
       Just _ | otherwise -> return Nothing
     reduce (E.App f x) args = reduce f (x:args)
-    reduce _ _ = return $ Nothing
+    reduce _ _ = return Nothing
 
     step resolveRef e = case e of
-      E.App f x -> E.link resolveRef f >>= \f ->
-        liftM (fromMaybe (E.App f x)) (reduce f [x])
+      E.App f x -> do
+        f' <- E.link resolveRef f
+        e' <- reduce f' [x]
+        maybe (return e) return e'
       _ -> return e
 
     whnf resolveRef e = case e of

node/src/Unison/Syntax/Term.hs

@@ -46,6 +46,8 @@ instance Show Term where
   show Blank = "_"
   show (Var v) = show v
   show (Ref v) = show v
+  show (Lit (Number d)) = show d
+  show (Lit (String s)) = show s
   show (Lit l) = show l
   show (Vector v) = show v
   show (App f x@(App _ _)) = show f ++ " (" ++ show x ++ ")"
@@ -151,12 +153,15 @@ arguments _ = []
 -- | If the outermost term is a function application,
 -- perform substitution of the argument into the body
 betaReduce :: Term -> Term
-betaReduce (App (Lam f) arg) = go V.bound1 f where
-  go depth body = case body of
-    App f x -> App (go depth f) (go depth x)
-    Vector vs -> Vector (fmap (go depth) vs)
-    Ann body t -> Ann (go depth body) t
-    Lam body -> Lam (go (V.succ depth) body)
+betaReduce (App (Lam f) arg) = go V.bound1 arg f where
+  closed = isClosed arg
+  weaken' arg = if closed then arg else unscope (weaken (Scoped arg))
+  go depth arg body = case body of
+    App f x -> App (go depth arg f) (go depth arg x)
+    Vector vs -> Vector (fmap (go depth arg) vs)
+    Ann body t -> Ann (go depth arg body) t
+    -- if arg has free variables, we weaken them when walking under lambda
+    Lam body -> Lam (go (V.succ depth) body (weaken' arg))
     Var v | v == depth -> arg
     _ -> body
 betaReduce e = e