From 07c5f395f8791065a867f3ddb97e9de94c744944 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sun, 12 Mar 2017 23:16:34 +0000 Subject: [PATCH 1/2] Update for PureScript 0.11 --- .travis.yml | 2 +- bower.json | 12 +++++++----- package.json | 8 ++++---- src/Data/List.purs | 8 ++++---- src/Data/List/Lazy/Types.purs | 12 ++++++++++-- src/Data/List/Types.purs | 18 ++++++++++++------ 6 files changed, 38 insertions(+), 22 deletions(-) diff --git a/.travis.yml b/.travis.yml index 8f06562..cf9c3ef 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,7 @@ language: node_js sudo: required dist: trusty -node_js: 5 +node_js: stable env: - PATH=$HOME/purescript:$PATH install: diff --git a/bower.json b/bower.json index 219952b..5fad604 100644 --- a/bower.json +++ b/bower.json @@ -20,13 +20,15 @@ "package.json" ], "dependencies": { - "purescript-generics": "^3.0.0", - "purescript-lazy": "^2.0.0", - "purescript-unfoldable": "^2.0.0" + "purescript-lazy": "^3.0.0", + "purescript-nonempty": "^4.0.0", + "purescript-tailrec": "^3.0.0", + "purescript-unfoldable": "^3.0.0" }, "devDependencies": { - "purescript-assert": "^2.0.0", - "purescript-console": "^2.0.0", + "purescript-arrays": "^4.0.0", + "purescript-assert": "^3.0.0", + "purescript-console": "^3.0.0", "purescript-math": "^2.0.0" } } diff --git a/package.json b/package.json index 5054554..bf77170 100644 --- a/package.json +++ b/package.json @@ -2,12 +2,12 @@ "private": true, "scripts": { "clean": "rimraf output && rimraf .pulp-cache", - "build": "pulp build --censor-lib --strict", + "build": "pulp build -- --censor-lib --strict", "test": "pulp test" }, "devDependencies": { - "pulp": "^9.0.1", - "purescript-psa": "^0.3.9", - "rimraf": "^2.5.0" + "pulp": "^10.0.4", + "purescript-psa": "^0.5.0-rc.1", + "rimraf": "^2.6.1" } } diff --git a/src/Data/List.purs b/src/Data/List.purs index c4c188c..46bf219 100644 --- a/src/Data/List.purs +++ b/src/Data/List.purs @@ -145,11 +145,11 @@ range start end | start == end = singleton start -- | -- | The `Lazy` constraint is used to generate the result lazily, to ensure -- | termination. -some :: forall f a. (Alternative f, Lazy (f (List a))) => f a -> f (List a) +some :: forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a) some v = Cons <$> v <*> defer (\_ -> many v) -- | A stack-safe version of `some`, at the cost of a `MonadRec` constraint. -someRec :: forall f a. (MonadRec f, Alternative f) => f a -> f (List a) +someRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) someRec v = Cons <$> v <*> manyRec v -- | Attempt a computation multiple times, returning as many successful results @@ -157,11 +157,11 @@ someRec v = Cons <$> v <*> manyRec v -- | -- | The `Lazy` constraint is used to generate the result lazily, to ensure -- | termination. -many :: forall f a. (Alternative f, Lazy (f (List a))) => f a -> f (List a) +many :: forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a) many v = some v <|> pure Nil -- | A stack-safe version of `many`, at the cost of a `MonadRec` constraint. -manyRec :: forall f a. (MonadRec f, Alternative f) => f a -> f (List a) +manyRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a) manyRec p = tailRecM go Nil where go :: List a -> f (Step (List a) (List a)) diff --git a/src/Data/List/Lazy/Types.purs b/src/Data/List/Lazy/Types.purs index 1c79418..2f4660e 100644 --- a/src/Data/List/Lazy/Types.purs +++ b/src/Data/List/Lazy/Types.purs @@ -11,6 +11,7 @@ import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Control.Plus (class Plus) +import Data.Eq (class Eq1, eq1) import Data.Foldable (class Foldable, foldMap, foldl, foldr) import Data.Lazy (Lazy, defer, force) import Data.Maybe (Maybe(..)) @@ -18,6 +19,7 @@ import Data.Monoid (class Monoid, mempty) import Data.Newtype (class Newtype, unwrap) import Data.NonEmpty (NonEmpty, (:|)) import Data.NonEmpty as NE +import Data.Ord (class Ord1, compare1) import Data.Traversable (class Traversable, traverse, sequence) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable) @@ -61,7 +63,10 @@ instance showList :: Show a => Show (List a) where go (Cons x xs') = "(Cons " <> show x <> " " <> go (step xs') <> ")" instance eqList :: Eq a => Eq (List a) where - eq xs ys = go (step xs) (step ys) + eq = eq1 + +instance eq1List :: Eq1 List where + eq1 xs ys = go (step xs) (step ys) where go Nil Nil = true go (Cons x xs') (Cons y ys') @@ -69,7 +74,10 @@ instance eqList :: Eq a => Eq (List a) where go _ _ = false instance ordList :: Ord a => Ord (List a) where - compare xs ys = go (step xs) (step ys) + compare = compare1 + +instance ord1List :: Ord1 List where + compare1 xs ys = go (step xs) (step ys) where go Nil Nil = EQ go Nil _ = LT diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index 95dc66c..108c522 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -1,6 +1,7 @@ module Data.List.Types where import Prelude + import Control.Alt (class Alt) import Control.Alternative (class Alternative) import Control.Apply (lift2) @@ -9,13 +10,15 @@ import Control.Extend (class Extend) import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Control.Plus (class Plus) + +import Data.Eq (class Eq1, eq1) import Data.Foldable (class Foldable, foldr, foldl, intercalate) -import Data.Generic (class Generic) import Data.Maybe (Maybe(..)) import Data.Monoid (class Monoid, mempty) import Data.Newtype (class Newtype) import Data.NonEmpty (NonEmpty, (:|)) import Data.NonEmpty as NE +import Data.Ord (class Ord1, compare1) import Data.Traversable (class Traversable, traverse) import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable) @@ -24,14 +27,15 @@ data List a = Nil | Cons a (List a) infixr 6 Cons as : -derive instance genericList :: Generic a => Generic (List a) - instance showList :: Show a => Show (List a) where show Nil = "Nil" show xs = "(" <> intercalate " : " (show <$> xs) <> " : Nil)" instance eqList :: Eq a => Eq (List a) where - eq xs ys = go xs ys true + eq = eq1 + +instance eq1List :: Eq1 List where + eq1 xs ys = go xs ys true where go _ _ false = false go Nil Nil acc = acc @@ -39,7 +43,10 @@ instance eqList :: Eq a => Eq (List a) where go _ _ _ = false instance ordList :: Ord a => Ord (List a) where - compare xs ys = go xs ys + compare = compare1 + +instance ord1List :: Ord1 List where + compare1 xs ys = go xs ys where go Nil Nil = EQ go Nil _ = LT @@ -123,7 +130,6 @@ derive instance newtypeNonEmptyList :: Newtype (NonEmptyList a) _ derive newtype instance eqNonEmptyList :: Eq a => Eq (NonEmptyList a) derive newtype instance ordNonEmptyList :: Ord a => Ord (NonEmptyList a) -derive newtype instance genericEmptyList :: Generic a => Generic (NonEmptyList a) instance showNonEmptyList :: Show a => Show (NonEmptyList a) where show (NonEmptyList nel) = "(NonEmptyList " <> show nel <> ")" From 20282db626c6dd6b74ae013ee4f41eb8e21c023a Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sun, 26 Mar 2017 22:10:52 +0100 Subject: [PATCH 2/2] Temporarily use `tailRec` for tail recursive functions --- src/Data/List/Lazy/Types.purs | 14 +++++++++----- src/Data/List/Types.purs | 25 +++++++++++++++---------- 2 files changed, 24 insertions(+), 15 deletions(-) diff --git a/src/Data/List/Lazy/Types.purs b/src/Data/List/Lazy/Types.purs index 2f4660e..01662b2 100644 --- a/src/Data/List/Lazy/Types.purs +++ b/src/Data/List/Lazy/Types.purs @@ -4,9 +4,11 @@ import Prelude import Control.Alt (class Alt) import Control.Alternative (class Alternative) -import Control.Extend (class Extend) import Control.Comonad (class Comonad) +import Control.Extend (class Extend) import Control.Lazy as Z +import Control.Monad.Rec.Class (tailRec) +import Control.Monad.Rec.Class as Rec import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Control.Plus (class Plus) @@ -110,11 +112,13 @@ instance foldableList :: Foldable List where foldr op z xs = foldl (flip op) z (rev xs) where rev = foldl (flip cons) nil - foldl = go where + foldl op b xs = go (Tuple b xs) + where -- `go` is needed to ensure the function is tail-call optimized - go op b xs = case step xs of - Nil -> b - Cons hd tl -> go op (b `op` hd) tl + go = tailRec \(Tuple b' xs') -> + case step xs' of + Nil -> Rec.Done b' + (Cons hd tl) -> Rec.Loop (Tuple (b' `op` hd) tl) foldMap f = foldl (\b a -> b <> f a) mempty diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index 108c522..132b31c 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -7,6 +7,7 @@ import Control.Alternative (class Alternative) import Control.Apply (lift2) import Control.Comonad (class Comonad) import Control.Extend (class Extend) +import Control.Monad.Rec.Class (Step(..), tailRec) import Control.MonadPlus (class MonadPlus) import Control.MonadZero (class MonadZero) import Control.Plus (class Plus) @@ -66,22 +67,26 @@ instance functorList :: Functor List where map f = foldr (\x acc -> f x : acc) Nil instance foldableList :: Foldable List where - foldr f b as = foldl (flip f) b (rev Nil as) + foldr f b as = foldl (flip f) b (rev (Tuple Nil as)) where - rev acc Nil = acc - rev acc (x : xs) = rev (x : acc) xs - foldl f = go + rev = tailRec \(Tuple acc xs) -> + case xs of + Nil -> Done acc + (x : xs') -> Loop (Tuple (x : acc) xs') + foldl f b as = go (Tuple b as) where - go b Nil = b - go b (a : as) = go (f b a) as + go = tailRec \(Tuple b' xs) -> + case xs of + Nil -> Done b' + (a : as') -> Loop (Tuple (f b' a) as') foldMap f = foldl (\acc -> append acc <<< f) mempty instance unfoldableList :: Unfoldable List where - unfoldr f b = go b Nil + unfoldr f b = go (Tuple b Nil) where - go source memo = case f source of - Nothing -> foldl (flip (:)) Nil memo - Just (Tuple one rest) -> go rest (one : memo) + go = tailRec \(Tuple source memo) -> case f source of + Nothing -> Done (foldl (flip (:)) Nil memo) + Just (Tuple one rest) -> Loop (Tuple rest (one : memo)) instance traversableList :: Traversable List where traverse f = map (foldl (flip (:)) Nil) <<< foldl (\acc -> lift2 (flip (:)) acc <<< f) (pure Nil)