Text.take/drop/words, Vector.dedup-adjacent

shared/src/Unison/Node/Builtin.hs

@@ -10,7 +10,7 @@ import Unison.Term (Term)
 import Unison.Type (Type)
 import Unison.Typechecker.Context (remoteSignatureOf)
 import Unison.Util.Logger (Logger)
-import Control.Concurrent (threadDelay)
+import qualified Data.Char as Char
 import qualified Data.Vector as Vector
 import qualified Data.Text as Text
 import qualified Unison.ABT as ABT
@@ -258,6 +258,35 @@ makeBuiltins logger whnf =
        in (r, Just (string2' (Term.ref r) (>=)), textCompareTyp, prefix "Text.>=")
      , let r = R.Builtin "Text.Order"
        in (r, Nothing, unsafeParseType "Order Text", prefix "Text.Order")
+     , let r = R.Builtin "Text.lowercase"
+           op [Term.Text' txt] = pure $ Term.text (Text.toLower txt)
+           op _ = error "Text.lowercase unpossible"
+           typ = "Text -> Text"
+       in (r, Just (I.Primop 1 op), unsafeParseType typ, prefix "Text.lowercase")
+     , let r = R.Builtin "Text.uppercase"
+           op [Term.Text' txt] = pure $ Term.text (Text.toUpper txt)
+           op _ = error "Text.uppercase unpossible"
+           typ = "Text -> Text"
+       in (r, Just (I.Primop 1 op), unsafeParseType typ, prefix "Text.lowercase")
+     , let r = R.Builtin "Text.take"
+           op [Term.Number' n, Term.Text' txt] = pure $ Term.text (Text.take (floor n) txt)
+           op _ = error "Text.take unpossible"
+           typ = "Number -> Text -> Text"
+       in (r, Just (I.Primop 2 op), unsafeParseType typ, prefix "Text.take")
+     , let r = R.Builtin "Text.drop"
+           op [Term.Number' n, Term.Text' txt] = pure $ Term.text (Text.drop (floor n) txt)
+           op _ = error "Text.drop unpossible"
+           typ = "Number -> Text -> Text"
+       in (r, Just (I.Primop 2 op), unsafeParseType typ, prefix "Text.drop")
+     , -- todo: rather special purpose, remove this in favor of more generic regex
+       let r = R.Builtin "Text.words"
+           op [Term.Text' txt] = pure $
+             let words = map stripPunctuation $ Text.split Char.isSpace txt
+                 stripPunctuation word = Text.dropAround (not . Char.isAlphaNum) word
+             in Term.vector (map Term.text . filter (not . Text.null) $ words)
+           op _ = error "Text.words unpossible"
+           typ = "Text -> Vector Text"
+       in (r, Just (I.Primop 1 op), unsafeParseType typ, prefix "Text.words")
 
      -- Pair
      , let r = R.Builtin "Pair"
@@ -501,7 +530,7 @@ makeBuiltins logger whnf =
 
 extractKey :: Term V -> [Either Double Text]
 extractKey (Term.App' _ t1) = go t1 where
-  go (Term.Builtin' u) = []
+  go (Term.Builtin' _) = []
   go (Term.App' (Term.Text' t) tl) = Right t : go tl
   go (Term.App' (Term.Number' n) tl) = Left n : go tl
   go (Term.App' (Term.Builtin' b) tl) = Right b : go tl

shared/src/Unison/TermParser.hs

@@ -242,7 +242,7 @@ alias = do
 bindings :: Var v => Parser (S v) (Term v) -> Parser (S v) [(v, Term v)]
 bindings p = do s0 <- get; some (binding <* semicolon) <* set s0 where
   binding = do
-    _ <- optional alias
+    _ <- many alias
     typ <- optional (typedecl <* semicolon)
     (name, args) <- ( (\arg1 op arg2 -> (op,[arg1,arg2]))
                       <$> prefixVar <*> infixVar <*> prefixVar)

shared/tests/Unison/Test/Interpreter.hs

@@ -72,6 +72,7 @@ tests = withResource Common.node (\_ -> pure ()) $ \node ->
       , t "Vector.fold-balanced Vector.concatenate Vector.empty [[1],[2],[3,4],[5]]"
           "[1,2,3,4,5]"
       , t "Vector.fold-balanced (+) 0 [1,2,3]" "6"
+      , t "Vector.dedup-adjacent (==_Number) [1,1,2,2,3,4,4,4,4,5]" "[1,2,3,4,5]"
       , t "Vector.range 0 10" "[0,1,2,3,4,5,6,7,8,9]"
       , t "Vector.range 0 0" "[]"
       , t "Vector.fold-left (+) 0 (Vector.replicate 5 1)" "5"

unison-src/base.u

@@ -70,6 +70,13 @@ Vector.fold-balanced plus zero vs =
     go plus zero vs;;
   ;
 
+Vector.fold-balanced1 : ∀ a . (a -> a -> a) -> Vector a -> Optional a;
+Vector.fold-balanced1 f v = Vector.fold-balanced (Optional.lift-or f) None (Vector.map Some v);
+
+Optional.lift-or : ∀ a . (a -> a -> a) -> Optional a -> Optional a -> Optional a;
+Optional.lift-or f = a1 a2 ->
+  a1 |> Optional.fold a2 (a1 -> Optional.fold None (a2 -> Some (f a1 a2)) a2);
+
 Vector.all? : ∀ a . (a -> Boolean) -> Vector a -> Boolean;
 Vector.all? f vs = Vector.fold-balanced and True (Vector.map f vs);
 
@@ -79,6 +86,22 @@ Vector.sort ok f v = Vector.sort-keyed (f `and-then` Order.key ok) v;
 Vector.sort' : ∀ a . Order a -> Vector a -> Vector a;
 Vector.sort' o = Vector.sort o identity;
 
+Vector.last : ∀ a . Vector a -> Optional a;
+Vector.last v = Vector.at (Vector.size v - 1) v;
+
+Vector.1st : ∀ a . Vector a -> Optional a;
+Vector.1st = Vector.at 0;
+
+Vector.dedup-adjacent : ∀ a . (a -> a -> Boolean) -> Vector a -> Vector a;
+Vector.dedup-adjacent eq v =
+  Vector.fold-balanced
+    (v1 v2 ->
+      if Optional.map2 eq (Vector.last v1) (Vector.1st v2) |> Optional.get-or False
+      then Vector.concatenate v1 (Vector.drop 1 v2)
+      else Vector.concatenate v1 v2)
+    []
+    (Vector.map Vector.pure v);
+
 Remote.map : ∀ a b . (a -> b) -> Remote a -> Remote b;
 Remote.map f = Remote.bind (f `and-then` Remote.pure);
 

unison-src/extra.u

@@ -35,9 +35,9 @@ Index.from-unsafe f ind = let
 ;
 
 alias IndexedTraversal k v =
-   ( Remote (Optional k)
-   , k -> Remote (Optional v)
-   , k -> Remote (Optional k));
+   ( Remote (Optional k) -- first key
+   , k -> Remote (Optional v) -- lookup the value for a key
+   , k -> Remote (Optional k)); -- increment a key
 
 IndexedTraversal.1st-key : ∀ k v . IndexedTraversal k v -> Remote (Optional k);
 IndexedTraversal.1st-key t = 1st t;
@@ -109,6 +109,9 @@ IndexedTraversal.take n t =
     else IndexedTraversal.1st-entry t |> Remote.map (Optional.map step);;
   );
 
+IndexedTraversal.take-keys : ∀ k v . Number -> IndexedTraversal k v -> Remote (Vector k);
+IndexedTraversal.take-keys n t = IndexedTraversal.take n t |> Remote.map (Vector.map 1st);
+
 Http.get-url : Text -> Remote (Either Text Text);
 Http.get-url url = Remote.map Http.get-url# (Remote.pure url);