git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Some work on type classes in the Prelude
c0aa52cPhil Freeman
libraries/prelude/prelude.purs+152−6
compare with golang
unifiedsplit
@@ -61,10 +61,37 @@ module Prelude where
61 read "true" = true
61 read "true" = true
62 read _ = false
62 read _ = false
63
63
64+ infixl 4 <$>
65+
66+ class Functor f where
67+ (<$>) :: forall a b. (a -> b) -> f a -> f b
68+
69+ infixl 4 <*>
70+
71+ class Applicative f where
72+ pure :: forall a. a -> f a
73+ (<*>) :: forall a b. f (a -> b) -> f a -> f b
74+
75+ instance (Applicative f) => Functor f where
76+ (<$>) f a = pure f <*> a
77+
78+ infixl 3 <|>
79+
80+ class Alternative f where
81+ empty :: forall a. f a
82+ (<|>) :: forall a. f a -> f a -> f a
83+
64 class Monad m where
84 class Monad m where
65 ret :: forall a. a -> m a
85 ret :: forall a. a -> m a
66 (>>=) :: forall a b. m a -> (a -> m b) -> m b
86 (>>=) :: forall a b. m a -> (a -> m b) -> m b
67
87
88+ instance (Monad m) => Applicative m where
89+ pure = ret
90+ (<*>) f a = do
91+ f' <- f
92+ a' <- a
93+ ret (f' a')
94+
68 infixl 5 *
95 infixl 5 *
69 infixl 5 /
96 infixl 5 /
70 infixl 5 %
97 infixl 5 %
@@ -326,6 +353,74 @@ module Prelude where
326 \ };\
353 \ };\
327 \}" :: String -> String -> String
354 \}" :: String -> String -> String
328
355
356+module Monoid where
357+
358+ import Prelude
359+
360+ infixr 6 <>
361+
362+ class Monoid m where
363+ mempty :: m
364+ (<>) :: m -> m -> m
365+
366+ instance Monoid String where
367+ mempty = ""
368+ (<>) = (++)
369+
370+ mconcat :: forall m. (Monoid m) => [m] -> m
371+ mconcat [] = mempty
372+ mconcat (m:ms) = m <> mconcat ms
373+
374+module Monad where
375+
376+ import Prelude
377+ import Arrays
378+
379+ replicateM :: forall m a. (Monad m) => Number -> m a -> m [a]
380+ replicateM 0 _ = ret []
381+ replicateM n m = do
382+ a <- m
383+ as <- replicateM (n - 1) m
384+ ret (a : as)
385+
386+ mapM :: forall m a b. (Monad m) => (a -> m b) -> [a] -> m [b]
387+ mapM _ [] = ret []
388+ mapM f (a:as) = do
389+ b <- f a
390+ bs <- mapM f as
391+ ret (b : bs)
392+
393+ infixr 1 >=>
394+ infixr 1 <=<
395+
396+ (>=>) :: forall m a b c. (Monad m) => (a -> m b) -> (b -> m c) -> a -> m c
397+ (>=>) f g a = do
398+ b <- f a
399+ g b
400+
401+ (<=<) :: forall m a b c. (Monad m) => (b -> m c) -> (a -> m b) -> a -> m c
402+ (<=<) = flip (>=>)
403+
404+ sequence :: forall m a. (Monad m) => [m a] -> m [a]
405+ sequence [] = ret []
406+ sequence (m:ms) = do
407+ a <- m
408+ as <- sequence ms
409+ ret (a : as)
410+
411+ join :: forall m a. (Monad m) => m (m a) -> m a
412+ join mm = do
413+ m <- mm
414+ m
415+
416+ foldM :: forall m a b. (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
417+ foldM _ a [] = ret a
418+ foldM f a (b:bs) = f a b >>= \a' -> foldM f a' bs
419+
420+ when :: forall m. (Monad m) => Boolean -> m {} -> m {}
421+ when true m = m
422+ when false _ = ret {}
423+
329module Maybe where
424module Maybe where
330
425
331 import Prelude
426 import Prelude
@@ -408,9 +503,9 @@ module Arrays where
408 \ };\
503 \ };\
409 \}" :: forall a. [a] -> [a] -> [a]
504 \}" :: forall a. [a] -> [a] -> [a]
410
505
411− foreign import join "function join(l) {\
506+ foreign import joinS "function joinS(l) {\
412− \ return l.join();\
507+ \ return l.join();\
413− \}" :: [String] -> String
508+ \}" :: [String] -> String
414
509
415 foreign import joinWith "function joinWith(l) {\
510 foreign import joinWith "function joinWith(l) {\
416 \ return function (s) {\
511 \ return function (s) {\
@@ -467,6 +562,9 @@ module Arrays where
467 (:) :: forall a. a -> [a] -> [a]
562 (:) :: forall a. a -> [a] -> [a]
468 (:) a = concat [a]
563 (:) a = concat [a]
469
564
565+ singleton :: forall a. a -> [a]
566+ singleton a = [a]
567+
470 concatMap :: forall a b. [a] -> (a -> [b]) -> [b]
568 concatMap :: forall a b. [a] -> (a -> [b]) -> [b]
471 concatMap [] f = []
569 concatMap [] f = []
472 concatMap (a:as) f = f a `concat` concatMap as f
570 concatMap (a:as) f = f a `concat` concatMap as f
@@ -476,9 +574,9 @@ module Arrays where
476 filter p (x:xs) | p x = x : filter p xs
574 filter p (x:xs) | p x = x : filter p xs
477 filter p (_:xs) = filter p xs
575 filter p (_:xs) = filter p xs
478
576
479− empty :: forall a. [a] -> Boolean
577+ isEmpty :: forall a. [a] -> Boolean
480− empty [] = true
578+ isEmpty [] = true
481− empty _ = false
579+ isEmpty _ = false
482
580
483 range :: Number -> Number -> [Number]
581 range :: Number -> Number -> [Number]
484 range lo hi = {
582 range lo hi = {
@@ -505,6 +603,14 @@ module Arrays where
505 show [] = "[]"
603 show [] = "[]"
506 show (x:xs) = show x ++ " : " ++ show xs
604 show (x:xs) = show x ++ " : " ++ show xs
507
605
606+ instance Prelude.Monad [] where
607+ ret = singleton
608+ (>>=) = concatMap
609+
610+ instance Prelude.Alternative [] where
611+ empty = []
612+ (<|>) = concat
613+
508module Tuple where
614module Tuple where
509
615
510 import Prelude
616 import Prelude
@@ -783,6 +889,46 @@ module Eff where
783 ret = retEff
889 ret = retEff
784 (>>=) = bindEff
890 (>>=) = bindEff
785
891
892+ foreign import untilE "function untilE(f) {\
893+ \ return function() {\
894+ \ while (!f()) { }\
895+ \ return {};\
896+ \ };\
897+ \}" :: forall e. Eff e Boolean -> Eff e {}
898+
899+ foreign import whileE "function whileE(f) {\
900+ \ return function(a) {\
901+ \ return function() {\
902+ \ while (f()) {\
903+ \ a();\
904+ \ }\
905+ \ return {};\
906+ \ };\
907+ \ };\
908+ \}" :: forall e. Eff e Boolean -> Eff e {} -> Eff e {}
909+
910+ foreign import forE "function forE(lo) {\
911+ \ return function(hi) {\
912+ \ return function(f) {\
913+ \ return function() {\
914+ \ for (var i = lo; i < hi; i++) {\
915+ \ f(i)();\
916+ \ }\
917+ \ };\
918+ \ };\
919+ \ };\
920+ \}" :: forall e. Number -> Number -> (Number -> Eff e {}) -> Eff e {}
921+
922+
923+ foreign import foreachE "function foreachE(as) {\
924+ \ return function(f) {\
925+ \ for (var i = 0; i < as.length; i++) {\
926+ \ f(as[i])();\
927+ \ }\
928+ \ };\
929+ \}" :: forall e a. [a] -> (a -> Eff e {}) -> Eff e {}
930+
931+
786module Random where
932module Random where
787
933
788 import Eff
934 import Eff
libraries/prelude/tests/Eff.purs+16−6
@@ -6,11 +6,11 @@ import Errors
6import Trace
6import Trace
7import Global
7import Global
8
8
9−test1 n = runPure $ catchError (\s -> ret 0) $ do
9+test1 n = runPure (catchError (\s -> ret 0) $ do
10 case {} of
10 case {} of
11 _ | n > 10 -> do
11 _ | n > 10 -> do
12 throwError "Error!"
12 throwError "Error!"
13− _ -> ret n
13+ _ -> ret n)
14
14
15test2 = do
15test2 = do
16 trace "Hello World"
16 trace "Hello World"
@@ -38,14 +38,24 @@ test6 s = do
38import ST
38import ST
39
39
40test7 _ = do
40test7 _ = do
41− n <- runST $ do
41+ n <- runST (do
42 r <- newSTRef 0
42 r <- newSTRef 0
43 modifySTRef r $ \n -> n + 1
43 modifySTRef r $ \n -> n + 1
44− readSTRef r
44+ readSTRef r)
45− print $ n
45+ print n
46+
47+test8 _ = (\_1 _2 -> {}) <$> print "Test" <*> print 8
48+
49+test9 _ = do
50+ r <- newSTRef 1
51+ untilE $ do
52+ n <- readSTRef r
53+ trace $ "Count " ++ show n
54+ modifySTRef r $ (+) 1
55+ ret false
46
56
47module Main where
57module Main where
48
58
49import Tests
59import Tests
50
60
51−main = test7 {}
61+main = test9 {}
src/Language/PureScript/TypeChecker/Types.hs+2
@@ -263,6 +263,8 @@ entails moduleName context goal@(className, ty) = do
263--
263--
264typeHeadsAreEqual :: ModuleName -> Environment -> Type -> Type -> Maybe [(String, Type)]
264typeHeadsAreEqual :: ModuleName -> Environment -> Type -> Type -> Maybe [(String, Type)]
265typeHeadsAreEqual _ _ (Skolem s1 _) (Skolem s2 _) | s1 == s2 = Just []
265typeHeadsAreEqual _ _ (Skolem s1 _) (Skolem s2 _) | s1 == s2 = Just []
266+typeHeadsAreEqual _ _ (TypeVar v) t = Just [(v, t)]
267+typeHeadsAreEqual _ _ t (TypeVar v) = Just [(v, t)]
266typeHeadsAreEqual m e (TypeConstructor c1) (TypeConstructor c2) | typeConstructorsAreEqual e m c1 c2 = Just []
268typeHeadsAreEqual m e (TypeConstructor c1) (TypeConstructor c2) | typeConstructorsAreEqual e m c1 c2 = Just []
267typeHeadsAreEqual m e (TypeApp h1 (TypeVar v)) (TypeApp h2 arg) = (:) (v, arg) <$> typeHeadsAreEqual m e h1 h2
269typeHeadsAreEqual m e (TypeApp h1 (TypeVar v)) (TypeApp h2 arg) = (:) (v, arg) <$> typeHeadsAreEqual m e h1 h2
268typeHeadsAreEqual m e t1@(TypeApp _ _) t2@(TypeApp _ (TypeVar _)) = typeHeadsAreEqual m e t2 t1
270typeHeadsAreEqual m e t1@(TypeApp _ _) t2@(TypeApp _ (TypeVar _)) = typeHeadsAreEqual m e t2 t1