Add Array primitives cons, uncons, reverse, and dropWhile (#116)

inferno-core/CHANGELOG.md

@@ -1,6 +1,9 @@
 # Revision History for inferno-core
 *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH)
 
+## 0.11.5.0 -- 2024-04-22
+* Add Array primitives cons, uncons, reverse, takeWhile, and dropWhile
+
 ## 0.11.4.0 -- 2024-04-02
 * Add Inferno documentation and language guide to Inferno.Docs
 

inferno-core/inferno-core.cabal

@@ -1,6 +1,6 @@
 cabal-version:       2.4
 name:                inferno-core
-version:             0.11.4.0
+version:             0.11.5.0
 synopsis:            A statically-typed functional scripting language
 description:         Parser, type inference, and interpreter for a statically-typed functional scripting language
 category:            DSL,Scripting

inferno-core/src/Inferno/Module/Prelude.hs

@@ -32,13 +32,15 @@ import Inferno.Module.Prelude.Defs
     clearBitFun,
     complementBitFun,
     complementFun,
+    consFun,
     cosFun,
     coshFun,
     dayFun,
     daysBeforeFun,
     daysFun,
     divFun,
     doubleToInt,
+    dropWhileFun,
     enumFromToInt64,
     eqFun,
     expFun,
@@ -83,6 +85,7 @@ import Inferno.Module.Prelude.Defs
     powFun,
     randomFun,
     recipFun,
+    reverseFun,
     roundFun,
     roundToFun,
     secondsBeforeFun,
@@ -96,6 +99,7 @@ import Inferno.Module.Prelude.Defs
     stripText,
     subFun,
     sumFun,
+    takeWhileFun,
     tanFun,
     tanhFun,
     testBitFun,
@@ -109,6 +113,7 @@ import Inferno.Module.Prelude.Defs
     toWord64Fun,
     truncateFun,
     truncateToFun,
+    unconsFun,
     weeksBeforeFun,
     weeksFun,
     xorFun,
@@ -383,6 +388,12 @@ module Option
 
 module Array
 
+  @doc Array construction. `cons x xs` is the array that has `x` as its first element and array `xs` as the rest of the array. For example, `cons 3 [1, 2] == [3, 1, 2]`;
+  cons : forall 'a. 'a -> array of 'a -> array of 'a := ###!consFun###;
+
+  @doc Array destruction into head and tail. `uncons xs` is `Some (x, xs1)` if array has at least one element and `xs == cons x xs1`, and is `None` if `xs == []`. For example, `uncons [1, 2, 3] == Some (1, [2, 3])`;
+  uncons : forall 'a. array of 'a -> option of ('a, array of 'a) := ###!unconsFun###;
+
   @doc Array indexing: gets the ith element of an array. Throws a RuntimeError if i is out of bounds.;
   get : forall 'a. array of 'a -> int -> 'a := ###!arrayIndexFun###;
 
@@ -488,6 +499,15 @@ module Array
         (None, None)
     in fun arr -> Option.mergeTuple (firstLast arr);
 
+  @doc `Array.reverse xs` returns the elements of `xs` in reverse order;
+  reverse : forall 'a. array of 'a -> array of 'a := ###!reverseFun###;
+
+  @doc `Array.takeWhile`, applied to a predicate `p` and a list `xs`, returns the longest prefix (possibly empty) of `xs` of elements that satisfy `p`;
+  takeWhile : forall 'a. ('a -> bool{#true, #false}) -> array of 'a -> array of 'a := ###!takeWhileFun###;
+
+  @doc `Array.dropWhile p xs` drops the longest (possibly empty) prefix of elements of `xs` satisfying the predicate `p` and returns the remainder;
+  dropWhile : forall 'a. ('a -> bool{#true, #false}) -> array of 'a -> array of 'a := ###!dropWhileFun###;
+
 module Text
 
   append : text -> text -> text := ###appendText###;
@@ -697,6 +717,9 @@ module Base
   @doc Safe array indexing: an infix operator to get the ith element of an array. Returns None if i is out of bounds.;
   (!?) : forall 'a. array of 'a -> int -> option of 'a := Array.getOpt;
 
+  // TODO why doesn't this work?
+  // (:) : forall 'a. 'a -> array of 'a -> array of 'a := cons;
+
   @doc The `fromOption` function unwraps an optional value, if given a default value to fall back on in case the value of the optional is `None`.
   ~~~inferno
   fromOption "hi" (Some "hello") == "hello"

inferno-core/src/Inferno/Module/Prelude/Defs.hs

@@ -378,6 +378,58 @@ arrayIndexFun =
         Nothing -> throwM $ RuntimeError "Array index out of bounds"
     _ -> throwM $ RuntimeError "arrayIndexFun: expecting an array"
 
+consFun :: (MonadThrow m) => Value c m
+consFun =
+  VFun $ \v ->
+    pure $ VFun $ \case
+      VArray vs -> pure $ VArray $ v : vs
+      _ -> throwM $ RuntimeError "cons: expecting an array"
+
+unconsFun :: (MonadThrow m) => Value c m
+unconsFun =
+  VFun $ \case
+    VArray [] -> pure VEmpty
+    VArray (v : vs) -> pure $ VOne $ VTuple [v, VArray vs]
+    _ -> throwM $ RuntimeError "uncons: expecting an array"
+
+reverseFun :: (MonadThrow m) => Value c m
+reverseFun =
+  VFun $ \case
+    VArray vs -> pure $ VArray $ reverse vs
+    _ -> throwM $ RuntimeError "reverse: expecting an array"
+
+takeWhileFun :: (MonadThrow m) => Value c m
+takeWhileFun =
+  VFun $ \case
+    VFun p ->
+      pure $ VFun $ \case
+        VArray vs -> VArray <$> takeWhile' p vs
+        _ -> throwM $ RuntimeError "takeWhile: expecting an array"
+    _ -> throwM $ RuntimeError "takeWhile: expecting a function"
+  where
+    takeWhile' _ [] = pure []
+    takeWhile' p (x : xs) =
+      p x >>= \case
+        VEnum h "true" | h == enumBoolHash -> (x :) <$> takeWhile' p xs
+        VEnum h "false" | h == enumBoolHash -> pure []
+        _ -> throwM $ RuntimeError "takeWhile: expecting predicate to return a bool"
+
+dropWhileFun :: (MonadThrow m) => Value c m
+dropWhileFun =
+  VFun $ \case
+    VFun p ->
+      pure $ VFun $ \case
+        VArray vs -> VArray <$> dropWhile' p vs
+        _ -> throwM $ RuntimeError "dropWhile: expecting an array"
+    _ -> throwM $ RuntimeError "dropWhile: expecting a function"
+  where
+    dropWhile' _ [] = pure []
+    dropWhile' p xs@(x : xs') =
+      p x >>= \case
+        VEnum h "true" | h == enumBoolHash -> dropWhile' p xs'
+        VEnum h "false" | h == enumBoolHash -> pure xs
+        _ -> throwM $ RuntimeError "dropWhile: expecting predicate to return a bool"
+
 singletonFun :: Monad m => (Value c m)
 singletonFun = VFun $ \v -> return $ VArray [v]
 

inferno-core/test/Eval/Spec.hs

@@ -272,6 +272,16 @@ evalTests = describe "evaluate" $
     shouldEvaluateTo "Array.sum [1.0, 2.0, 4.0, 8.0]" $ VDouble 15
     shouldEvaluateTo "open Array in range 4 13" $ VArray (map VInt [4 .. 13])
     shouldEvaluateTo "open Time in Array.sum [seconds 2, hours 5]" $ VEpochTime 18002
+    shouldEvaluateTo "Array.reverse []" $ VArray []
+    shouldEvaluateTo "Array.reverse [1.0, 2.0, 4.0, 8.0]" $ VArray (map VDouble [8, 4, 2, 1])
+    shouldEvaluateTo "Array.cons 3 [1, 2] == [3, 1, 2]" vTrue
+    shouldEvaluateTo "Array.uncons [1, 2, 3] == Some (1, [2, 3])" vTrue
+    shouldEvaluateTo "Array.takeWhile (fun x -> x < 3) [1,2,3,4,1,2,3,4] == [1, 2]" vTrue
+    shouldEvaluateTo "Array.takeWhile (fun x -> x < 9) [1,2,3] == [1,2,3]" vTrue
+    shouldEvaluateTo "Array.takeWhile (fun x -> x < 0) [1,2,3] == []" vTrue
+    shouldEvaluateTo "Array.dropWhile (fun x -> x < 3) [1,2,3,4,5,1,2,3] == [3,4,5,1,2,3]" vTrue
+    shouldEvaluateTo "Array.dropWhile (fun x -> x < 9) [1,2,3] == []" vTrue
+    shouldEvaluateTo "Array.dropWhile (fun x -> x < 0) [1,2,3] == [1,2,3]" vTrue
     -- Option type
     shouldEvaluateTo "Array.sum (Array.keepSomes [Some 3.0, None, Some 4.0])" $ VDouble 7
     shouldEvaluateTo "Array.findFirstSome [None, Some 3.0, None, Some 4.0]" $ VOne $ VDouble 3