Vector.at/take/drop

This commit is contained in:
Paul Chiusano 2016-08-23 21:27:59 -04:00
parent 89ec20d2a7
commit 33f83dcfeb
3 changed files with 40 additions and 7 deletions

View File

@ -334,6 +334,32 @@ makeBuiltins whnf =
op _ = fail "Vector.split unpossible"
typ = "forall a. Vector a -> (Vector a, Vector a)"
in (r, Just (I.Primop 1 op), unsafeParseType typ, prefix "Vector.split")
, let r = R.Builtin "Vector.at"
op [n,vec] = do
Term.Number' n <- whnf n
Term.Vector' vs <- whnf vec
pure $ case vs Vector.!? (floor n) of
Nothing -> none
Just t -> some t
op _ = fail "Vector.at unpossible"
typ = "forall a . Number -> Vector a -> Optional a"
in (r, Just (I.Primop 2 op), unsafeParseType typ, prefix "Vector.at")
, let r = R.Builtin "Vector.take"
op [n,vec] = do
Term.Number' n <- whnf n
Term.Vector' vs <- whnf vec
pure $ Term.vector' (Vector.take (floor n) vs)
op _ = fail "Vector.take unpossible"
typ = "forall a . Number -> Vector a -> Vector a"
in (r, Just (I.Primop 2 op), unsafeParseType typ, prefix "Vector.take")
, let r = R.Builtin "Vector.drop"
op [n,vec] = do
Term.Number' n <- whnf n
Term.Vector' vs <- whnf vec
pure $ Term.vector' (Vector.drop (floor n) vs)
op _ = fail "Vector.drop unpossible"
typ = "forall a . Number -> Vector a -> Vector a"
in (r, Just (I.Primop 2 op), unsafeParseType typ, prefix "Vector.drop")
, let r = R.Builtin "Vector.fold-left"
op [f,z,vec] = whnf vec >>= \vec -> case vec of
Term.Vector' vs -> Vector.foldM (\acc a -> whnf (f `Term.apps` [acc, a])) z vs

View File

@ -37,6 +37,13 @@ tests = withResource Common.node (\_ -> pure ()) $ \node ->
, t "const 41 0" "41"
, t "1st (1,2,3,4)" "1"
, t "2nd (1,2 + 1,3,4)" "3"
, t "if (Text.equal \"hi\" \"hi\") 1 2" "1"
, t "if (Text.lessThan \"hi\" \"hiya\") 1 2" "1"
, t "if (Text.lessThanOrEqual \"hi\" \"hiya\") 1 2" "1"
, t "if (Text.greaterThan \"hiya\" \"hi\") 1 2" "1"
, t "if (Text.greaterThanOrEqual \"hiya\" \"hi\") 1 2" "1"
, t "if (Text.greaterThanOrEqual \"hi\" \"hi\") 1 2" "1"
, t "if (Text.lessThanOrEqual \"hi\" \"hi\") 1 2" "1"
, t "Vector.reverse [1,2,3]" "[3,2,1]"
, t "Vector.reverse Vector.empty" "[]"
, t "Vector.fold-right Vector.prepend Vector.empty [1,2,3]" "[1,2,3]"
@ -45,17 +52,14 @@ 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 "if (Text.equal \"hi\" \"hi\") 1 2" "1"
, t "if (Text.lessThan \"hi\" \"hiya\") 1 2" "1"
, t "if (Text.lessThanOrEqual \"hi\" \"hiya\") 1 2" "1"
, t "if (Text.greaterThan \"hiya\" \"hi\") 1 2" "1"
, t "if (Text.greaterThanOrEqual \"hiya\" \"hi\") 1 2" "1"
, t "if (Text.greaterThanOrEqual \"hi\" \"hi\") 1 2" "1"
, t "if (Text.lessThanOrEqual \"hi\" \"hi\") 1 2" "1"
, 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"
, t "Vector.sort Number.Order identity [5,2,1,3,4]" "[1,2,3,4,5]"
, t "Optional.getOr 96 (Vector.at 1 [0,1,2,3,4])" "1"
, t "Vector.take 0 [1,2,3]" "[]"
, t "Vector.take 2 [1,2,3]" "[1,2]"
, t "Vector.drop 2 [1,2,3]" "[3]"
]
t uneval eval = testCase (uneval ++ "" ++ eval) $ do
(node, _, builtins) <- node

View File

@ -75,6 +75,9 @@ Optional.bind f = Optional.fold None f;
Optional.pure : ∀ a . a -> Optional a;
Optional.pure = Some;
Optional.getOr : ∀ a . a -> Optional a -> a;
Optional.getOr a = Optional.fold a identity;
Either.map : ∀ a b c . (b -> c) -> Either a b -> Either a c;
Either.map f = Either.fold Left (f `then` Right);