added identity function

editor/src/Unison/Editor.elm

@@ -100,6 +100,7 @@ metadata model r =
 incorporateMetadata : List (Reference.Key, Metadata) -> Model -> Model
 incorporateMetadata kvs model =
   let metadata' = List.foldl (\(k,v) dict -> Dict.insert k v dict) model.metadata kvs
+      keys = Debug.log "known-keys" (Dict.keys metadata')
   in { model | metadata <- metadata' }
 
 explorerViewEnv : Model -> View.Env
@@ -166,7 +167,7 @@ keyedCompletions model =
         currentApps = case Term.at scope.focus model.term of
           Nothing -> []
           Just cur -> (".", cur, Styles.currentSymbol) :: List.map (la cur) i.localApplications
-        ks = List.map (\(k,_,_) -> k results)
+        ks = Debug.log "keys" (List.map (\(k,_,_) -> k) results)
         results = currentApps
                ++ List.map (searchEntry model) regulars
                ++ keyedSearchMatches model
@@ -405,7 +406,7 @@ setSearchbox sink origin modifier content model =
         Just results ->
           let oldQuery = explorerInput model -- not model'
               newQuery = explorerInput model'
-              complete = Node.areResultsComplete results
+              complete = Debug.log "complete" (Node.areResultsComplete results)
               compareIndex i =
                 let sub = String.dropLeft i << String.left 1
                 in sub oldQuery == sub newQuery
@@ -415,7 +416,9 @@ setSearchbox sink origin modifier content model =
               -- produce the results
               ok = Debug.log "ok" <|
                    (complete && String.startsWith oldQuery newQuery) ||
-                   (List.all compareIndex results.positionsExamined)
+                   (let examined = Set.fromList (results.positionsExamined) `Set.union`
+                                   Set.fromList [0 .. String.length newQuery - 1]
+                    in List.all compareIndex (Set.toList examined))
               req = if ok then Nothing
                     else case model'.localInfo of
                            Nothing -> Nothing

node/src/Node.hs

@@ -26,6 +26,7 @@ import qualified Unison.Note as N
 import qualified Unison.Syntax.Reference as R
 import qualified Unison.Syntax.Term as Term
 import qualified Unison.Syntax.Type as Type
+import qualified Unison.Syntax.Var as Var
 
 numeric2 :: Term -> (Double -> Double -> Double) -> I.Primop (N.Noted IO)
 numeric2 sym f = I.Primop 2 $ \xs -> case xs of
@@ -69,16 +70,17 @@ builtinMetadatas node = do
   Node.updateMetadata node (R.Builtin "Number.minus") (opl 4 "-")
   Node.updateMetadata node (R.Builtin "Number.times") (opl 5 "*")
   Node.updateMetadata node (R.Builtin "Number.divide") (opl 5 "/")
-  Node.updateMetadata node (R.Builtin "Text.append") (opp "append")
+  Node.updateMetadata node (R.Builtin "Text.append") (prefix "append")
+  _ <- Node.createTerm node (Term.Lam (Term.Var Var.bound1)) (prefix "identity")
   mapM_ (\(r,_,t) -> Store.annotateTerm store r t) builtins
   where opl n s = Metadata Metadata.Term
                            (Metadata.Names [Metadata.Symbol s Metadata.InfixL n ])
                            []
                            Nothing
-        opp s = Metadata Metadata.Term
-                         (Metadata.Names [Metadata.Symbol s Metadata.Prefix 9])
-                         []
-                         Nothing
+        prefix s = Metadata Metadata.Term
+                            (Metadata.Names [Metadata.Symbol s Metadata.Prefix 9])
+                            []
+                            Nothing
 
 store :: Store IO
 store = F.store "store"

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

@@ -42,6 +42,7 @@ eval env = Eval whnf step
         f' <- E.link resolveRef f
         e' <- reduce f' [x]
         maybe (return e) return e'
+      E.Ref h -> E.link resolveRef (E.Ref h)
       _ -> return e
 
     whnf resolveRef e = case e of

node/src/Unison/Node/Common.hs

@@ -99,7 +99,7 @@ node eval store =
                   (S.toList (S.unions (map E.dependencies' qmatches)))
       pure $ SearchResults
         mds
-        (qmatches, length (drop limit qmatches))
+        (trim qmatches)
         (trim illtypedQmatches)
         (MD.queryPositions query)
 

node/src/Unison/Syntax/Hash.hs

@@ -13,7 +13,7 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-import qualified Crypto.Hash.SHA3 as H
+import qualified Crypto.Hash as H
 
 -- | Hash which uniquely identifies a Unison type or term
 newtype Hash = Hash B.ByteString deriving (Eq,Ord)
@@ -22,7 +22,7 @@ instance Show Hash where
   show h = "#" ++ (take 5 . drop 1 $ show (base64 h))
 
 -- | Buffer type for building up hash values
-newtype Digest = Digest (H.Ctx -> H.Ctx)
+newtype Digest = Digest (H.Context H.SHA3_512 -> H.Context H.SHA3_512)
 
 append :: Digest -> Digest -> Digest
 append (Digest a) (Digest b) = Digest (b . a)
@@ -40,13 +40,13 @@ hashBytes (Hash h) = h
 
 finalize :: Digest -> Hash
 finalize (Digest f) =
-  Hash . H.finalize . f . H.init $ 256
+  Hash . H.digestToByteString . H.hashFinalize . f $ H.hashInit
 
 bytes :: B.ByteString -> Digest
-bytes bs = Digest (\ctx -> H.update ctx bs)
+bytes bs = Digest (\ctx -> H.hashUpdate ctx bs)
 
 lazyBytes :: LB.ByteString -> Digest
-lazyBytes bs = Digest (\ctx -> H.updates ctx (LB.toChunks bs))
+lazyBytes bs = Digest (\ctx -> H.hashUpdates ctx (LB.toChunks bs))
 
 byte :: Word8 -> Digest
 byte b = bytes (B.singleton b)

node/src/Unison/Type.hs

@@ -39,8 +39,11 @@ check' term typ = join . N.unnote $ check missing term typ
 -- for instance `admissible 42 (forall a . a)` is `True`, since a term of
 -- type `forall a . a` can be substituted for `42`.
 admissible :: Applicative f => T.Env f -> E.Term -> T.Type -> Noted f Bool
-admissible synth term admissibleTyp = f <$> synthesize synth term
-  where f t = either (const False) (const True) (subtype admissibleTyp t)
+admissible synth term admissibleTyp =
+  -- todo: this is a total hack, figure out nicer solution
+  if admissibleTyp == T.forall1 id then pure True
+  else f <$> synthesize synth term
+       where f t = either (const False) (const True) (subtype admissibleTyp t)
 
 -- | Returns `True` if the expression is well-typed, `False` otherwise
 wellTyped :: (Monad f, Applicative f) => T.Env f -> E.Term -> Noted f Bool