Prelude: fix types of Array primitives; add Option.join

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.9.0.0 -- 2023-11-21
+* Breaking change: Fix Array primitive type signatures. Add Option.join
+
 ## 0.8.2.0 -- 2023-11-02
 * Add median
 

inferno-core/inferno-core.cabal

@@ -1,6 +1,6 @@
 cabal-version:       2.4
 name:                inferno-core
-version:             0.8.2.0
+version:             0.9.0.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

@@ -372,6 +372,14 @@ module Option
       | _ -> None
     };
 
+  @doc `Option.join` removes the outer "layer" of a nesteed option. (By definition, `Option.join == Option.reduce id None`).
+  ~~~inferno
+  Option.join None == None
+  Option.join (Some None) == None
+  Option.join (Some (Some a)) == Some a
+  ~~~;
+  join : forall 'a. option of (option of 'a) -> option of 'a := reduce Number.id None;
+
 module Array
 
   @doc Array indexing: gets the ith element of an array. Throws a RuntimeError if i is out of bounds.;
@@ -389,31 +397,31 @@ module Array
   length : forall 'a. array of 'a -> int := ###!lengthFun###;
 
   @doc The minimum value in an array, or `None` if empty;
-  minimum: forall 'a. array of 'a -> option of double := ###!minimumFun###;
+  minimum: forall 'a. {requires order on 'a} => array of 'a -> option of 'a := ###!minimumFun###;
 
   @doc The maximum value in an array, or `None` if empty;
-  maximum: forall 'a. array of 'a -> option of double := ###!maximumFun###;
+  maximum: forall 'a. {requires order on 'a} => array of 'a -> option of 'a := ###!maximumFun###;
 
   @doc The average of the values in an array, or `None` if empty;
-  average: forall 'a. array of 'a -> option of double := ###!averageFun###;
+  average: forall 'a. {requires numeric on 'a} => array of 'a -> option of double := ###!averageFun###;
 
-  @doc Return the median element in an array, or `None` if empty;
-  median: forall 'a. array of 'a -> option of double := ###!medianFun###;
+  @doc Return the median of the values in an array, or `None` if empty;
+  median: forall 'a. {requires numeric on 'a} => array of 'a -> option of double := ###!medianFun###;
 
   @doc The index of the minimum value in an array, or `None` if empty;
-  argmin: forall 'a. array of 'a -> option of int := ###!argminFun###;
+  argmin: forall 'a. {requires order on 'a} => array of 'a -> option of int := ###!argminFun###;
 
   @doc The index of the maximum value in an array, or `None` if empty;
-  argmax: forall 'a. array of 'a -> option of int := ###!argmaxFun###;
+  argmax: forall 'a. {requires order on 'a} => array of 'a -> option of int := ###!argmaxFun###;
 
   @doc Returns the indices that would sort an array;
-  argsort: forall 'a. array of 'a -> array of int := ###!argsortFun###;
+  argsort: forall 'a. {requires order on 'a} => array of 'a -> array of int := ###!argsortFun###;
 
-  @doc Returns the Euclidean norm of an array;
-  magnitude: forall 'a. array of 'a -> double := ###!magnitudeFun###;
+  @doc Returns the Euclidean norm of an array, or `None` if empty;
+  magnitude: forall 'a. {requires numeric on 'a} => array of 'a -> option of double := ###!magnitudeFun###;
 
-  @doc Returns the Euclidean norm of an array;
-  norm: forall 'a. array of 'a -> double := ###!normFun###;
+  @doc Returns the Euclidean norm of an array, or `None` if empty;
+  norm: forall 'a. {requires numeric on 'a} => array of 'a -> option of double := ###!normFun###;
 
   @doc The `Array.range` function takes two `int` arguments `n` and `m` and produces an array `[n,...,m]`.
   If `m` > `n`, the empty array is returned.;
@@ -618,7 +626,9 @@ module Base
   infix 6 ==;
   infix 6 !=;
   infix 19 ..;
-  infix 5 ?;
+
+  infixr 5 ?;
+  // infixl 5 <|>;
 
   infixl 12 <<;
   infixl 12 |>;
@@ -691,6 +701,18 @@ module Base
       | None -> default
     };
 
+  // TODO fix parser and re-introduce this
+  // @doc The `<|>` operator implements choice: it returns the left value if not `None`, otherwise the right value.
+  // ~~~inferno
+  // (Some "hello") <|> Some "hi" == Some "hello"
+  // None <|> Some "hi" == Some "hi"
+  // ~~~;
+  // (<|>) : forall 'a. option of 'a -> option of 'a -> option of 'a :=
+  //   fun ma default -> match ma with {
+  //     | Some a -> Some a
+  //     | None -> default
+  //   };
+
   @doc Gets the first component of a tuple: `fst (x, y) == x`;
   fst : forall 'a 'b. ('a, 'b) -> 'a := fun t -> match t with { (x, y) -> x };
 

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE BinaryLiterals #-}
 
 module Inferno.Module.Prelude.Defs where
@@ -19,11 +20,10 @@ import Data.Bits
     (.&.),
     (.|.),
   )
-import Data.Foldable (foldrM, maximumBy, minimumBy)
+import Data.Foldable (Foldable (foldl'), foldrM, maximumBy, minimumBy)
 import Data.Int (Int64)
 import Data.List (sortOn)
 import Data.List.Extra ((!?))
-import Data.Maybe (mapMaybe)
 import Data.Ord (comparing)
 import Data.Text (Text, pack, unpack)
 import qualified Data.Text as Text
@@ -450,93 +450,119 @@ lengthFun =
     VArray xs -> pure $ VInt $ fromIntegral $ length xs
     _ -> throwM $ RuntimeError "length: expecting an array"
 
--- | Convenience function for comparing numbered value
--- in an array while maintaining the original value type
-keepNumberValues :: [Value c m] -> [(Value c m, Double)]
-keepNumberValues =
-  mapMaybe
-    ( \case
-        m@(VInt v) -> Just (m, fromIntegral v)
-        m@(VDouble v) -> Just (m, v)
-        _ -> Nothing
-    )
+extractInts :: (MonadThrow m) => [Value custom m] -> m [Int64]
+extractInts = \case
+  [] -> pure []
+  VInt x : vs -> (x :) <$> extractInts vs
+  _ -> throwM $ RuntimeError "extractInts: got an array with mixed types"
+
+extractDoubles :: (MonadThrow m) => [Value custom m] -> m [Double]
+extractDoubles = \case
+  [] -> pure []
+  VDouble x : vs -> (x :) <$> extractDoubles vs
+  _ -> throwM $ RuntimeError "extractDoubles: got an array with mixed types"
+
+extractEpochTimes :: (MonadThrow m) => [Value custom m] -> m [EpochTime]
+extractEpochTimes = \case
+  [] -> pure []
+  VEpochTime x : vs -> (x :) <$> extractEpochTimes vs
+  _ -> throwM $ RuntimeError "extractEpochTimes: got an array with mixed types"
 
 minimumFun :: (MonadThrow m) => Value c m
 minimumFun =
   VFun $ \case
     VArray [] -> pure VEmpty
-    VArray xs -> pure $ VOne $ fst $ minimumBy (comparing snd) $ keepNumberValues xs
+    VArray vs@(VInt _ : _) -> VOne . VInt . minimum <$> extractInts vs
+    VArray vs@(VDouble _ : _) -> VOne . VDouble . minimum <$> extractDoubles vs
+    VArray vs@(VEpochTime _ : _) -> VOne . VEpochTime . minimum <$> extractEpochTimes vs
+    VArray _ -> throwM $ RuntimeError "minimum: unsupported array type"
     _ -> throwM $ RuntimeError "minimum: expecting an array"
 
 maximumFun :: (MonadThrow m) => Value c m
 maximumFun =
   VFun $ \case
     VArray [] -> pure VEmpty
-    VArray xs -> pure $ VOne $ fst $ maximumBy (comparing snd) $ keepNumberValues xs
+    VArray vs@(VInt _ : _) -> VOne . VInt . maximum <$> extractInts vs
+    VArray vs@(VDouble _ : _) -> VOne . VDouble . maximum <$> extractDoubles vs
+    VArray vs@(VEpochTime _ : _) -> VOne . VEpochTime . maximum <$> extractEpochTimes vs
+    VArray _ -> throwM $ RuntimeError "maximum: unsupported array type"
     _ -> throwM $ RuntimeError "maximum: expecting an array"
 
 averageFun :: (MonadThrow m) => Value c m
 averageFun =
   VFun $ \case
     VArray [] -> pure VEmpty
-    VArray xs -> pure $ VOne $ VDouble $ sum (mapMaybe toDouble xs) / fromIntegral (length xs)
+    VArray vs@(VInt _ : _) -> VOne . VDouble . average . map fromIntegral <$> extractInts vs
+    VArray vs@(VDouble _ : _) -> VOne . VDouble . average <$> extractDoubles vs
+    VArray _ -> throwM $ RuntimeError "average: unsupported array type"
     _ -> throwM $ RuntimeError "average: expecting an array"
   where
-    toDouble :: Value c m -> Maybe Double
-    toDouble = \case
-      VInt v -> Just $ fromIntegral v
-      VDouble v -> Just v
-      _ -> Nothing
+    average :: (Foldable f, Fractional a) => f a -> a
+    average xs
+      | null xs = error "average: impossible"
+      | otherwise =
+          uncurry (/)
+            . foldl' (\(!total, !count) x -> (total + x, count + 1)) (0, 0)
+            $ xs
 
 medianFun :: (MonadThrow m) => Value c m
 medianFun =
   VFun $ \case
     VArray [] -> pure VEmpty
-    VArray xs -> pure $ VOne $ VDouble $ median (mapMaybe toDouble xs)
+    VArray vs@(VInt _ : _) -> VOne . VDouble . median . map fromIntegral <$> extractInts vs
+    VArray vs@(VDouble _ : _) -> VOne . VDouble . median <$> extractDoubles vs
+    VArray _ -> throwM $ RuntimeError "median: unsupported array type"
     _ -> throwM $ RuntimeError "median: expecting an array"
-  where
-    toDouble :: Value c m -> Maybe Double
-    toDouble = \case
-      VInt v -> Just $ fromIntegral v
-      VDouble v -> Just v
-      _ -> Nothing
 
 argminFun :: (MonadThrow m) => Value c m
 argminFun =
   VFun $ \case
     VArray [] -> pure VEmpty
-    VArray xs -> pure $ VOne $ VInt $ fromIntegral $ argMin' $ map snd $ keepNumberValues xs
+    VArray vs@(VInt _ : _) -> VOne . VInt . argMin' <$> extractInts vs
+    VArray vs@(VDouble _ : _) -> VOne . VInt . argMin' <$> extractDoubles vs
+    VArray vs@(VEpochTime _ : _) -> VOne . VInt . argMin' <$> extractEpochTimes vs
+    VArray _ -> throwM $ RuntimeError "argmin: unsupported array type"
     _ -> throwM $ RuntimeError "argmin: expecting an array"
   where
-    argMin' :: [Double] -> Int
+    argMin' :: (Ord a) => [a] -> Int64
     argMin' = fst . minimumBy (comparing snd) . zip [0 ..]
 
 argmaxFun :: (MonadThrow m) => Value c m
 argmaxFun =
   VFun $ \case
     VArray [] -> pure VEmpty
-    VArray xs -> pure $ VOne $ VInt $ fromIntegral $ argMax' $ map snd $ keepNumberValues xs
+    VArray vs@(VInt _ : _) -> VOne . VInt . argMax' <$> extractInts vs
+    VArray vs@(VDouble _ : _) -> VOne . VInt . argMax' <$> extractDoubles vs
+    VArray vs@(VEpochTime _ : _) -> VOne . VInt . argMax' <$> extractEpochTimes vs
+    VArray _ -> throwM $ RuntimeError "argmax: unsupported array type"
     _ -> throwM $ RuntimeError "argmax: expecting an array"
   where
-    argMax' :: [Double] -> Int
+    argMax' :: (Ord a) => [a] -> Int64
     argMax' = fst . maximumBy (comparing snd) . zip [0 ..]
 
 argsortFun :: (MonadThrow m) => Value c m
 argsortFun =
   VFun $ \case
-    VArray xs -> pure $ VArray $ argsort' $ keepNumberValues xs
+    VArray [] -> pure VEmpty
+    VArray vs@(VInt _ : _) -> VArray . argsort' <$> extractInts vs
+    VArray vs@(VDouble _ : _) -> VArray . argsort' <$> extractDoubles vs
+    VArray vs@(VEpochTime _ : _) -> VArray . argsort' <$> extractEpochTimes vs
+    VArray _ -> throwM $ RuntimeError "argmax: unsupported array type"
     _ -> throwM $ RuntimeError "argsort: expecting an array"
   where
-    argsort' :: [(Value c m, Double)] -> [Value c m]
-    argsort' xs = map (VInt . fst) $ sortOn (snd . snd) $ zip [0 ..] xs
+    argsort' :: (Ord a) => [a] -> [Value c m]
+    argsort' xs = map (VInt . fst) $ sortOn snd $ zip [0 ..] xs
 
 magnitudeFun :: (MonadThrow m) => Value c m
 magnitudeFun =
   VFun $ \case
-    VDouble x -> pure $ VDouble $ abs x
-    VInt x -> pure $ VInt $ abs x
-    VArray xs -> pure $ VDouble $ sqrt $ sum $ map (\x -> x ** 2) $ map snd (keepNumberValues xs)
+    VArray [] -> pure VEmpty
+    VArray vs@(VInt _ : _) -> VOne . VDouble . magnitude . map fromIntegral <$> extractInts vs
+    VArray vs@(VDouble _ : _) -> VOne . VDouble . magnitude <$> extractDoubles vs
+    VArray _ -> throwM $ RuntimeError "magnitude: unsupported array type"
     _ -> throwM $ RuntimeError "magnitude: expecting a number"
+  where
+    magnitude = sqrt . sum . map (\x -> x ** 2)
 
 normFun :: (MonadThrow m) => Value c m
 normFun = magnitudeFun

inferno-core/src/Inferno/Parse.hs

@@ -225,7 +225,9 @@ signedFloat = Lexer.signed (takeWhileP Nothing isHSpace *> pure ()) Lexer.float
 enumE :: (SourcePos -> () -> Scoped ModuleName -> Ident -> f) -> Parser f
 enumE f = do
   startPos <- getSourcePos
-  lexeme $ try (f startPos () <$> (Scope . ModuleName <$> variable) <*> (char '.' *> enumConstructor)) <|> f startPos () LocalScope <$> enumConstructor <* notFollowedBy (char '.')
+  lexeme $
+    try (f startPos () <$> (Scope . ModuleName <$> variable) <*> (char '.' *> enumConstructor))
+      <|> f startPos () LocalScope <$> enumConstructor
 
 implVarE :: Parser (Expr () SourcePos)
 implVarE = do

inferno-core/test/Eval/Spec.hs

@@ -244,16 +244,19 @@ evalTests = describe "evaluate" $
     shouldEvaluateTo "Array.length []" $ VInt 0
     shouldEvaluateTo "Array.length [3.0, 4.0]" $ VInt 2
     shouldEvaluateTo "Array.minimum [3.0, 4.0] ? -999" $ VDouble 3.0
+    shouldEvaluateTo "Array.minimum [3.0, 1.0] ? -999" $ VDouble 1.0
     shouldEvaluateTo "Array.maximum [3.0, 4.0] ? 999" $ VDouble 4.0
+    shouldEvaluateTo "Array.average [round 0, round 1] ? 0" $ VDouble 0.5
     shouldEvaluateTo "Array.average [0.0, 1.0] ? 0" $ VDouble 0.5
     shouldEvaluateTo "Array.median [0.0, 1.0, 2.0] ? 0" $ VDouble 1.0
-    shouldEvaluateTo "Array.median [0, 1] ? 0" $ VDouble 0.5
+    shouldEvaluateTo "Array.median [round 0, round 1] ? 0" $ VDouble 0.5
     shouldEvaluateTo "Array.median [] ? 9" $ VDouble 9.0
     shouldEvaluateTo "Array.argmin [3.0, 4.0] ? 1" $ VInt 0
     shouldEvaluateTo "Array.argmax [3.0, 4.0] ? 0" $ VInt 1
     shouldEvaluateTo "Array.argsort [3.0, 1.0, 2.0]" $ VArray [VInt 1, VInt 2, VInt 0]
-    shouldEvaluateTo "Array.magnitude [1.0, 2.0, 3.0]" $ VDouble (sqrt (1.0 + 4.0 + 9.0))
-    shouldEvaluateTo "Array.norm [1.0, -2.0, 3.0]" $ VDouble (sqrt (1.0 + 4.0 + 9.0))
+    shouldEvaluateTo "Array.magnitude []" $ VEmpty
+    shouldEvaluateTo "Array.magnitude [1.0, 2.0, 3.0]" $ VOne $ VDouble (sqrt (1.0 + 4.0 + 9.0))
+    shouldEvaluateTo "Array.norm [1.0, -2.0, 3.0]" $ VOne $ VDouble (sqrt (1.0 + 4.0 + 9.0))
 
     shouldEvaluateTo "Array.range 4 3" $ VArray []
     shouldEvaluateTo "Array.range 4 13" $ VArray (map VInt [4 .. 13])
@@ -281,10 +284,19 @@ evalTests = describe "evaluate" $
     shouldEvaluateTo "fromOption 0.0 None" $ VDouble 0
     shouldEvaluateTo "(Some 4.0) ? 0" $ VDouble 4
     shouldEvaluateTo "None ? 0.0" $ VDouble 0
+    shouldEvaluateTo "(Some 4.0) ? None ? 0" $ VDouble 4
+    shouldEvaluateTo "None ? (Some 4.0) ? 0" $ VDouble 4
+    shouldEvaluateTo "None ? None ? 4.0" $ VDouble 4
+    -- shouldEvaluateTo "(Some 4.0) <|> None <|> None" $ VOne $ VDouble 4
+    -- shouldEvaluateTo "None <|> (Some 4.0) <|> Some 3" $ VOne $ VDouble 4
+    -- shouldEvaluateTo "None <|> None <|> Some 4.0" $ VOne $ VDouble 4
     shouldEvaluateTo "Option.reduce (fun d -> d + 2) 0.0 (Some 4)" $ VDouble 6
     shouldEvaluateTo "Option.reduce (fun d -> d + 2) 0.0 (Some 4.0)" $ VDouble 6
     shouldEvaluateTo "Option.reduce (fun d -> d + 2) 0 (Some 4.0)" $ VDouble 6
     shouldEvaluateTo "Option.reduce (fun d -> d + 2) 0.0 None" $ VDouble 0
+    shouldEvaluateTo "Option.join None" $ VEmpty
+    shouldEvaluateTo "Option.join (Some None)" $ VEmpty
+    shouldEvaluateTo "Option.join (Some (Some 2.3))" $ VOne $ VDouble 2.3
     -- Time
     shouldEvaluateTo "Time.seconds 5" $ VEpochTime 5
     shouldEvaluateTo "Time.minutes 5 == 5 * Time.seconds 60" vTrue

inferno-lsp/inferno-lsp.cabal

@@ -32,7 +32,7 @@ library
     , bytestring                         >= 0.10.10 && < 0.12
     , co-log-core                        >= 0.3.1 && < 0.4
     , containers                         >= 0.6.2 && < 0.7
-    , inferno-core                       >= 0.8.0 && < 0.9
+    , inferno-core                       >= 0.8.0 && < 0.10
     , inferno-types                      >= 0.2.0 && < 0.4
     , inferno-vc                         >= 0.3.0 && < 0.4
     , lsp                                >= 1.6.0 && < 1.7