git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix tests
5a4b212Phil Freeman
examples/failing/DuplicateProperties1.purs+2−2
compare with golang
unifiedsplit
@@ -2,8 +2,8 @@ module DuplicateProperties where
2
2
3foreign import data Test :: # * -> *
3foreign import data Test :: # * -> *
4
4
5−foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r
5+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r
6
6
7−foreign import hasX "" :: Test (x :: Unit, y :: Unit)
7+foreign import hasX :: Test (x :: Unit, y :: Unit)
8
8
9baz = subtractX (subtractX hasX)
9baz = subtractX (subtractX hasX)
examples/failing/DuplicateProperties2.purs+2−2
@@ -2,8 +2,8 @@ module DuplicateProperties where
2
2
3foreign import data Test :: # * -> *
3foreign import data Test :: # * -> *
4
4
5−foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r
5+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r
6
6
7−foreign import hasX "" :: forall r. Test (x :: Unit, y :: Unit | r)
7+foreign import hasX :: forall r. Test (x :: Unit, y :: Unit | r)
8
8
9baz = subtractX (subtractX hasX)
9baz = subtractX (subtractX hasX)
examples/passing/BindersInFunctions.purs+2−7
@@ -2,14 +2,9 @@ module Main where
2
2
3import Prelude
3import Prelude
4
4
5−snd = \[_, y] -> y
5+import Assert
6
6
7−foreign import error
7+snd = \[_, y] -> y
8− """
9− function error(msg) {
10− throw msg;
11− }
12− """ :: forall a. String -> a
13
8
14main =
9main =
15 let ts = snd [1.0, 2.0] in
10 let ts = snd [1.0, 2.0] in
examples/passing/BlockString.purs+2−8
@@ -1,12 +1,6 @@
1module Main where
1module Main where
2
2
3−foreign import foo """
4− function foo(s) {
5− return s;
6− }
7−""" :: String -> String
3+foo :: String
8−
4+foo = """foo"""
9−bar :: String -> String
10−bar _ = foo "test"
11
5
12main = Debug.Trace.trace "Done"
6main = Debug.Trace.trace "Done"
examples/passing/CaseInDo.purs+4−6
@@ -3,18 +3,16 @@ module Main where
3import Debug.Trace
3import Debug.Trace
4import Control.Monad.Eff
4import Control.Monad.Eff
5
5
6−foreign import doIt "function doIt() { global.flag = true; }" :: forall eff. Eff eff Unit
6+doIt :: forall eff. Eff eff Boolean
7−
7+doIt = return true
8−foreign import get "function get() { return global.flag; }" :: forall eff. Eff eff Boolean
9
8
10set = do
9set = do
11 trace "Testing..."
10 trace "Testing..."
12 case 0 of
11 case 0 of
13 0 -> doIt
12 0 -> doIt
14− _ -> return unit
13+ _ -> return false
15
14
16main = do
15main = do
17− set
16+ b <- set
18− b <- get
19 case b of
17 case b of
20 true -> trace "Done"
18 true -> trace "Done"
examples/passing/CheckSynonymBug.purs−7
@@ -4,13 +4,6 @@ module Main where
4
4
5 type Foo a = Array a
5 type Foo a = Array a
6
6
7− foreign import length
8− """
9− function length(a) {
10− return a.length;
11− }
12− """ :: forall a. Array a -> Number
13−
14 foo _ = length ([] :: Foo Number)
7 foo _ = length ([] :: Foo Number)
15
8
16 main = Debug.Trace.trace "Done"
9 main = Debug.Trace.trace "Done"
examples/passing/Collatz.purs−12
@@ -3,18 +3,6 @@ module Main where
3import Control.Monad.Eff
3import Control.Monad.Eff
4import Control.Monad.ST
4import Control.Monad.ST
5
5
6−foreign import jsMod
7− """
8− function jsMod(x) {
9− return function (y) {
10− return x % y;
11− };
12− }
13− """ :: Number -> Number -> Number
14−
15−infixl 7 %
16−(%) = jsMod
17−
18collatz :: Number -> Number
6collatz :: Number -> Number
19collatz n = runPure (runST (do
7collatz n = runPure (runST (do
20 r <- newSTRef n
8 r <- newSTRef n
examples/passing/Comparisons.purs+1−12
@@ -2,18 +2,7 @@ module Main where
2
2
3import Control.Monad.Eff
3import Control.Monad.Eff
4import Debug.Trace
4import Debug.Trace
5−
5+import Assert
6−foreign import data Assert :: !
7−
8−foreign import assert
9− """
10− function assert(x) {
11− return function() {
12− if (!x) throw new Error('assertion failed');
13− return {};
14− };
15− }
16− """ :: forall e. Boolean -> Eff (assert :: Assert | e) Unit
17
6
18main = do
7main = do
19 assert (1.0 < 2.0)
8 assert (1.0 < 2.0)
examples/passing/DeepArrayBinder.purs+2−8
@@ -1,6 +1,7 @@
1module Main where
1module Main where
2
2
3import Control.Monad.Eff
3import Control.Monad.Eff
4+import Assert
4
5
5data List a = Cons a (List a) | Nil
6data List a = Cons a (List a) | Nil
6
7
@@ -8,13 +9,6 @@ match2 :: List Number -> Number
8match2 (Cons x (Cons y xs)) = x * y + match2 xs
9match2 (Cons x (Cons y xs)) = x * y + match2 xs
9match2 _ = 0.0
10match2 _ = 0.0
10
11
11−foreign import explode
12− """
13− function explode() {
14− throw new Error('Incorrect result');
15− }
16− """ :: forall eff a. Eff eff a
17−
18main = case match2 (Cons 1.0 (Cons 2.0 (Cons 3.0 (Cons 4.0 (Cons 5.0 (Cons 6.0 (Cons 7.0 (Cons 8.0 (Cons 9.0 Nil))))))))) of
12main = case match2 (Cons 1.0 (Cons 2.0 (Cons 3.0 (Cons 4.0 (Cons 5.0 (Cons 6.0 (Cons 7.0 (Cons 8.0 (Cons 9.0 Nil))))))))) of
19 100.0 -> Debug.Trace.trace "Done"
13 100.0 -> Debug.Trace.trace "Done"
20− _ -> explode
14+ _ -> error "Incorrect result!"
examples/passing/EmptyDataDecls.purs+1−16
@@ -1,6 +1,7 @@
1module Main where
1module Main where
2
2
3import Prelude
3import Prelude
4+import Assert
4
5
5data Z
6data Z
6data S n
7data S n
@@ -10,25 +11,9 @@ data ArrayBox n a = ArrayBox (Array a)
10nil :: forall a. ArrayBox Z a
11nil :: forall a. ArrayBox Z a
11nil = ArrayBox []
12nil = ArrayBox []
12
13
13−foreign import concat
14− """
15− function concat(l1) {
16− return function(l2) {
17− return l1.concat(l2);
18− };
19− }
20− """ :: forall a. Array a -> Array a -> Array a
21−
22cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a
14cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a
23cons' x (ArrayBox xs) = ArrayBox $ concat [x] xs
15cons' x (ArrayBox xs) = ArrayBox $ concat [x] xs
24
16
25−foreign import error
26− """
27− function error(msg) {
28− throw msg;
29− }
30− """ :: forall a. String -> a
31−
32main = case cons' 1 $ cons' 2 $ cons' 3 nil of
17main = case cons' 1 $ cons' 2 $ cons' 3 nil of
33 ArrayBox [1, 2, 3] -> Debug.Trace.trace "Done"
18 ArrayBox [1, 2, 3] -> Debug.Trace.trace "Done"
34 _ -> error "Failed"
19 _ -> error "Failed"
examples/passing/ExternData.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3− foreign import data IO :: * -> *
4−
5− foreign import bind "function bind() {}" :: forall a b. IO a -> (a -> IO b) -> IO b
6−
7− foreign import showMessage "function showMessage() {}" :: String -> IO { }
8−
9− foreign import prompt "function prompt() {}" :: IO String
10−
11− test _ = prompt `bind` \s -> showMessage s
12−
13− main = Debug.Trace.trace "Done"
examples/passing/ExternRaw.pursdeleted−26
@@ -1,26 +0,0 @@
1−module Main where
2−
3−foreign import first
4− """
5− function first(xs) {
6− return xs[0];
7− }
8− """ :: forall a. Array a -> a
9−
10−foreign import loop
11− """
12− function loop() {
13− while (true) {}
14− }
15− """ :: forall a. a
16−
17−foreign import concat
18− """
19− function concat(xs) {
20− return function(ys) {
21− return xs.concat(ys);
22− };
23− }
24− """ :: forall a. Array a -> Array a -> Array a
25−
26−main = Debug.Trace.trace "Done"
examples/passing/FFI.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−foreign import foo
4− """
5− function foo(s) {
6− return s;
7− }
8− """ :: String -> String
9−
10−bar :: String -> String
11−bar _ = foo "test"
12−
13−main = Debug.Trace.trace "Done"
examples/passing/ForeignInstance.pursdeleted−20
@@ -1,20 +0,0 @@
1−module Main where
2−
3−class Foo a where
4− foo :: a -> String
5−
6−foreign import instance fooArray :: (Foo a) => Foo (Array a)
7−
8−foreign import instance fooNumber :: Foo Number
9−
10−foreign import instance fooString :: Foo String
11−
12−foreign import fooString "var fooString = {};" :: Unit
13−foreign import fooNumber "var fooNumber = {};" :: Unit
14−foreign import fooArray "var fooArray = {};" :: Unit
15−
16−test1 _ = foo [1.0, 2.0, 3.0]
17−
18−test2 _ = foo "Test"
19−
20−main = Debug.Trace.trace "Done"
examples/passing/FunctionScope.purs+1−7
@@ -1,17 +1,11 @@
1module Main where
1module Main where
2
2
3 import Prelude
3 import Prelude
4+ import Assert
4
5
5 mkValue :: Number -> Number
6 mkValue :: Number -> Number
6 mkValue id = id
7 mkValue id = id
7
8
8− foreign import error
9− """
10− function error(msg) {
11− throw msg;
12− }
13− """ :: forall a. String -> a
14−
15 main = do
9 main = do
16 let value = mkValue 1.0
10 let value = mkValue 1.0
17 if value == 1.0
11 if value == 1.0
examples/passing/Functions2.purs+1−7
@@ -1,17 +1,11 @@
1module Main where
1module Main where
2
2
3 import Prelude
3 import Prelude
4+ import Assert
4
5
5 test :: forall a b. a -> b -> a
6 test :: forall a b. a -> b -> a
6 test = \const _ -> const
7 test = \const _ -> const
7
8
8− foreign import error
9− """
10− function error(msg) {
11− throw msg;
12− }
13− """ :: forall a. String -> a
14−
15 main = do
9 main = do
16 let value = test "Done" {}
10 let value = test "Done" {}
17 if value == "Done"
11 if value == "Done"
examples/passing/Guards.purs−12
@@ -1,17 +1,5 @@
1module Main where
1module Main where
2
2
3−foreign import jsMod
4− """
5− function jsMod(x) {
6− return function (y) {
7− return x % y;
8− };
9− }
10− """ :: Number -> Number -> Number
11−
12−infixl 7 %
13−(%) = jsMod
14−
15collatz = \x -> case x of
3collatz = \x -> case x of
16 y | y % 2.0 == 0.0 -> y / 2.0
4 y | y % 2.0 == 0.0 -> y / 2.0
17 y -> y * 3.0 + 1.0
5 y -> y * 3.0 + 1.0
examples/passing/HoistError.purs+2−10
@@ -2,18 +2,10 @@ module Main where
2
2
3import Control.Monad.Eff
3import Control.Monad.Eff
4import Debug.Trace
4import Debug.Trace
5−
6−foreign import f
5+import Assert
7− """
8− function f(x) {
9− return function() {
10− if (x !== 0) throw new Error('x is not 0');
11− };
12− }
13− """ :: forall e. Number -> Eff e Number
14
6
15main = do
7main = do
16 let x = 0.0
8 let x = 0.0
17− f x
9+ assert $ x == 0.0
18 let x = 1.0 + 1.0
10 let x = 1.0 + 1.0
19 trace "Done"
11 trace "Done"
examples/passing/IntAndChar.purs+5−13
@@ -1,6 +1,7 @@
1module Main where
1module Main where
2
2
3import Control.Monad.Eff
3import Control.Monad.Eff
4+import Assert
4
5
5f 1 = 1
6f 1 = 1
6f _ = 0
7f _ = 0
@@ -8,18 +9,9 @@ f _ = 0
8g 'a' = 'a'
9g 'a' = 'a'
9g _ = 'b'
10g _ = 'b'
10
11
11−foreign import assertEqual
12− """
13− function assertEqual(a) { return function(b) { return function() {
14− if (a != b) {
15− throw new Error('Assertion failed!');
16− }
17− }; }; }
18− """ :: forall eff a. a -> a -> Eff eff Unit
19−
20main = do
12main = do
21− assertEqual (f 1) 1
13+ assert $ f 1 == 1
22− assertEqual (f 0) 0
14+ assert $ f 0 == 0
23− assertEqual (g 'a') 'a'
15+ assert $ g 'a' == 'a'
24− assertEqual (g 'b') 'b'
16+ assert $ g 'b' == 'b'
25 Debug.Trace.trace "Done"
17 Debug.Trace.trace "Done"
examples/passing/ObjectUpdate2.purs+2−1
@@ -2,7 +2,8 @@ module Main where
2
2
3type X r = { | r }
3type X r = { | r }
4
4
5−foreign import x "var x = {};" :: forall r. X r
5+x :: X (baz :: String)
6+x = { baz: "baz" }
6
7
7blah :: forall r. X r -> X r
8blah :: forall r. X r -> X r
8blah x = x
9blah x = x
examples/passing/ObjectUpdater.purs+5−17
@@ -2,19 +2,7 @@ module Main where
2
2
3import Control.Monad.Eff
3import Control.Monad.Eff
4import Debug.Trace
4import Debug.Trace
5−
5+import Assert
6−foreign import eqeqeq
7− """
8− function eqeqeq(x) {
9− return function (y) {
10− if (x == y) return x;
11− throw new Error("Unexpected result: " + x + " /== " + y);
12− };
13− };
14− """ :: forall a. a -> a -> a
15−
16−(===) = eqeqeq
17−infixl 4 ===
18
6
19getValue :: forall e. Eff (| e) Boolean
7getValue :: forall e. Eff (| e) Boolean
20getValue = return true
8getValue = return true
@@ -22,14 +10,14 @@ getValue = return true
22main = do
10main = do
23 let record = { value: false }
11 let record = { value: false }
24 record' <- record { value = _ } <$> getValue
12 record' <- record { value = _ } <$> getValue
25− print $ record'.value === true
13+ assert $ record'.value == true
26
14
27 let point = { x: 1.0, y: 1.0 }
15 let point = { x: 1.0, y: 1.0 }
28 x = 10.0
16 x = 10.0
29 point' = (point { x = _, y = x }) 100.0
17 point' = (point { x = _, y = x }) 100.0
30
18
31− print $ point'.x === 100.0
19+ assert $ point'.x == 100.0
32− print $ point'.y === 10.0
20+ assert $ point'.y == 10.0
33
21
34 let record2 = (_ { x = _ }) { x: 0.0 } 10.0
22 let record2 = (_ { x = _ }) { x: 0.0 } 10.0
35− print $ record2.x === 10.0
23+ assert $ record2.x == 10.0
examples/passing/ObjectWildcards.purs+3−15
@@ -2,30 +2,18 @@ module Main where
2
2
3import Control.Monad.Eff
3import Control.Monad.Eff
4import Debug.Trace
4import Debug.Trace
5+import Assert
5
6
6mkRecord = { foo: _, bar: _, baz: "baz" }
7mkRecord = { foo: _, bar: _, baz: "baz" }
7
8
8getValue :: forall e. Eff (| e) Boolean
9getValue :: forall e. Eff (| e) Boolean
9getValue = return true
10getValue = return true
10
11
11−foreign import eqeqeq
12− """
13− function eqeqeq(x) {
14− return function (y) {
15− if (x == y) return x;
16− throw new Error("Unexpected result: " + x + " /== " + y);
17− };
18− };
19− """ :: forall a. a -> a -> a
20−
21−(===) = eqeqeq
22−infixl 4 ===
23−
24main = do
12main = do
25 obj <- { value: _ } <$> getValue
13 obj <- { value: _ } <$> getValue
26 print obj.value
14 print obj.value
27 let x = 1.0
15 let x = 1.0
28 point <- { x: _, y: x } <$> return 2.0
16 point <- { x: _, y: x } <$> return 2.0
29− print $ point.x === 2.0
17+ assert $ point.x == 2.0
30− print $ point.y === 1.0
18+ assert $ point.y == 1.0
31 trace (mkRecord 1.0 "Done!").bar
19 trace (mkRecord 1.0 "Done!").bar
examples/passing/OperatorAssociativity.purs+15−41
@@ -2,49 +2,23 @@ module Main where
2
2
3import Control.Monad.Eff
3import Control.Monad.Eff
4import Debug.Trace
4import Debug.Trace
5−
5+import Assert
6−foreign import data Assert :: !
7−
8−foreign import assert
9− """
10− function assert(x) {
11− return function(desc) {
12− return function() {
13− if (!x) throw new Error('assertion (' + desc + ') failed');
14− return {};
15− };
16− };
17− }
18− """ :: forall e. Boolean -> String -> Eff (assert :: Assert | e) Unit
19
6
20bug :: Number -> Number -> Number
7bug :: Number -> Number -> Number
21bug a b = 0.0 - (a - b)
8bug a b = 0.0 - (a - b)
22
9
23−foreign import explode
24− """
25− function explode() {
26− throw new Error('Assertion failed!');
27− }
28− """ :: forall eff a. Eff eff a
29−
30main = do
10main = do
31− assert (bug 0.0 2.0 == 2.0) "bug 0.0 2.0 == 2.0"
11+ assert (bug 0.0 2.0 == 2.0)
32− assert (0.0 - (0.0 - 2.0) == 2.0) "0.0 - (0.0 - 2.0) == 2.0"
12+ assert (0.0 - (0.0 - 2.0) == 2.0)
33− assert (0.0 - (0.0 + 2.0) == -2.0) "0.0 - (0.0 + 2.0) == -2.0"
13+ assert (0.0 - (0.0 + 2.0) == -2.0)
34−
35− assert (6.0 / (3.0 * 2.0) == 1.0) "6.0 / (3.0 * 2.0) == 1.0"
14+ assert (6.0 / (3.0 * 2.0) == 1.0)
36− assert ((6.0 / 3.0) * 2.0 == 4.0) "(6.0 / 3.0) * 2.0 == 4.0"
15+ assert ((6.0 / 3.0) * 2.0 == 4.0)
37−
38− assert (not (1.0 < 0.0) == true) "not (1.0 < 0.0) == true"
16+ assert (not (1.0 < 0.0) == true)
39− assert (not ((negate 1.0) < 0.0) == false) "not ((negate 1.0) < 0.0) == false"
17+ assert (not ((negate 1.0) < 0.0) == false)
40−
41− assert (negate (1.0 + 10.0) == -11.0) "negate (1.0 + 10.0) == -11.0"
18+ assert (negate (1.0 + 10.0) == -11.0)
42−
43− assert (2.0 * 3.0 / 4.0 == 1.5) "2.0 * 3.0 / 4.0 == 1.5"
19+ assert (2.0 * 3.0 / 4.0 == 1.5)
44− assert (1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0) "1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0"
20+ assert (1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0)
45−
46− assert (1.0 + 10.0 - 5.0 == 6.0) "1.0 + 10.0 - 5.0 == 6.0"
21+ assert (1.0 + 10.0 - 5.0 == 6.0)
47− assert (1.0 + 10.0 * 5.0 == 51.0) "1.0 + 10.0 * 5.0 == 51.0"
22+ assert (1.0 + 10.0 * 5.0 == 51.0)
48− assert (10.0 * 5.0 - 1.0 == 49.0) "10.0 * 5.0 - 1.0 == 49.0"
23+ assert (10.0 * 5.0 - 1.0 == 49.0)
49−
50− trace "Success!"
24+ trace "Success!"
examples/passing/OperatorSections.purs+5−16
@@ -1,21 +1,10 @@
1module Main where
1module Main where
2
2
3−foreign import eqeqeq
3+import Assert
4− """
5− function eqeqeq(x) {
6− return function (y) {
7− if (x == y) return x;
8− throw new Error("Unexpected result: " + x + " /== " + y);
9− };
10− };
11− """ :: forall a. a -> a -> a
12−
13−(===) = eqeqeq
14−infixl 4 ===
15
4
16main = do
5main = do
17− Debug.Trace.print $ (/ 2.0) 4.0 === 2.0
6+ assert $ (/ 2.0) 4.0 == 2.0
18− Debug.Trace.print $ (2.0 /) 4.0 === 0.5
7+ assert $ (2.0 /) 4.0 == 0.5
19− Debug.Trace.print $ (`const` 1.0) 2.0 === 2.0
8+ assert $ (`const` 1.0) 2.0 == 2.0
20− Debug.Trace.print $ (1.0 `const`) 2.0 === 1.0
9+ assert $ (1.0 `const`) 2.0 == 1.0
21 Debug.Trace.trace "Done!"
10 Debug.Trace.trace "Done!"
examples/passing/PartialFunction.purs+2−12
@@ -1,19 +1,9 @@
1module Main where
1module Main where
2
2
3−foreign import testError
3+import Assert
4− """
5− function testError(f) {
6− try {
7− return f();
8− } catch (e) {
9− if (e instanceof Error) return 'success';
10− throw new Error('Pattern match failure is not Error');
11− }
12− }
13− """ :: (Unit -> Number) -> String
14
4
15fn :: Number -> Number
5fn :: Number -> Number
16fn 0.0 = 0.0
6fn 0.0 = 0.0
17fn 1.0 = 2.0
7fn 1.0 = 2.0
18
8
19−main = Debug.Trace.trace (show $ testError $ \_ -> fn 2.0)
9+main = assertPartial $ \_ -> fn 2.0
examples/passing/Person.purs+1−10
@@ -1,18 +1,9 @@
1module Main where
1module Main where
2
2
3− import Prelude ((++))
4−
5 data Person = Person { name :: String, age :: Number }
3 data Person = Person { name :: String, age :: Number }
6
4
7− foreign import itoa
8− """
9− function itoa(n) {
10− return n.toString();
11− }
12− """ :: Number -> String
13−
14 showPerson :: Person -> String
5 showPerson :: Person -> String
15 showPerson = \p -> case p of
6 showPerson = \p -> case p of
16− Person o -> o.name ++ ", aged " ++ itoa(o.age)
7+ Person o -> o.name ++ ", aged " ++ show o.age
17
8
18 main = Debug.Trace.trace "Done"
9 main = Debug.Trace.trace "Done"
examples/passing/RowSynonyms.pursdeleted−46
@@ -1,46 +0,0 @@
1−module Main where
2−
3−import Control.Monad.Eff
4−import Control.Monad.ST
5−
6−type State bindings =
7− {
8− bindings :: {addition :: Number | bindings},
9− other :: String
10− }
11−
12−type MyBindings = (test :: Number)
13−
14−data Shadow bindings = Shadow String
15−
16−shadows :: Shadow (Object MyBindings)
17−shadows = Shadow "uhh"
18−
19−main :: Eff () Unit
20−main = withIt
21− shadows
22− \ bindings -> do
23− let state =
24− {
25− bindings : bindings,
26− other : "Test"
27− }
28− runST do
29− stRef <- newSTRef state
30− handleKeyD stRef
31− return unit
32−
33−
34−withIt :: forall bindings eff a. Shadow (Object bindings) ->
35− ({addition :: Number | bindings} -> Eff eff a) -> Eff eff a
36−withIt (Shadow str) success = do
37− b <- withBindings
38− success (b{addition = 1.0})
39−
40−foreign import withBindings
41−"""
42− function withBindings() {}
43−""" :: forall eff bindings. Eff eff bindings
44−
45−handleKeyD :: forall h eff. STRef h (State MyBindings) -> Eff (st :: ST h | eff) Unit
46−handleKeyD state = return unit
examples/passing/ShadowedRename.purs+2−10
@@ -2,20 +2,12 @@ module Main where
2
2
3import Control.Monad.Eff
3import Control.Monad.Eff
4import Debug.Trace
4import Debug.Trace
5−
6−foreign import f
5+import Assert
7− """
8− function f(x) {
9− return function() {
10− if (x !== 2.0) throw new Error('x is not 2.0');
11− };
12− }
13− """ :: forall e. Number -> Eff e Number
14
6
15foo foo = let foo_1 = \_ -> foo
7foo foo = let foo_1 = \_ -> foo
16 foo_2 = foo_1 unit + 1.0
8 foo_2 = foo_1 unit + 1.0
17 in foo_2
9 in foo_2
18
10
19main = do
11main = do
20− f (foo 1.0)
12+ assert $ foo 1.0 == 2.0
21 trace "Done"
13 trace "Done"
examples/passing/TopLevelCase.purs−12
@@ -1,17 +1,5 @@
1module Main where
1module Main where
2
2
3−foreign import jsMod
4− """
5− function jsMod(x) {
6− return function (y) {
7− return x % y;
8− };
9− }
10− """ :: Number -> Number -> Number
11−
12−infixl 7 %
13−(%) = jsMod
14−
15gcd :: Number -> Number -> Number
3gcd :: Number -> Number -> Number
16gcd 0.0 x = x
4gcd 0.0 x = x
17gcd x 0.0 = x
5gcd x 0.0 = x
examples/passing/TypeClassImport.pursdeleted−18
@@ -1,18 +0,0 @@
1−module Main where
2−
3−foreign import data T :: *
4−
5−foreign import data C :: *
6−
7−foreign import t "var t = null;" :: T
8−
9−foreign import inst """
10− var inst = {
11− show: function(t) {
12− return 'Done';
13− }
14− }""" :: C
15−
16−foreign import instance inst :: Show T
17−
18−main = Debug.Trace.print t
psc/Main.hs+2−48
@@ -24,8 +24,6 @@ import Control.Applicative
24import Control.Monad
24import Control.Monad
25import Control.Monad.Error.Class (MonadError(..))
25import Control.Monad.Error.Class (MonadError(..))
26import Control.Monad.Reader
26import Control.Monad.Reader
27−import Control.Monad.Supply (evalSupplyT)
28−import Control.Monad.Supply.Class (MonadSupply())
29import Control.Monad.Writer
27import Control.Monad.Writer
30
28
31import Data.Maybe (fromMaybe)
29import Data.Maybe (fromMaybe)
@@ -40,9 +38,6 @@ import System.IO (hPutStrLn, stderr)
40
38
41import qualified Data.Map as M
39import qualified Data.Map as M
42import qualified Language.PureScript as P
40import qualified Language.PureScript as P
43−import qualified Language.PureScript.CodeGen.JS as J
44−import qualified Language.PureScript.Constants as C
45−import qualified Language.PureScript.CoreFn as CF
46import qualified Paths_purescript as Paths
41import qualified Paths_purescript as Paths
47
42
48data PSCOptions = PSCOptions
43data PSCOptions = PSCOptions
@@ -83,11 +78,11 @@ compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do
83 Right ((ms, foreigns), warnings) -> do
78 Right ((ms, foreigns), warnings) -> do
84 when (P.nonEmpty warnings) $
79 when (P.nonEmpty warnings) $
85 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
80 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
86− case runPSC opts (compileJS ms foreigns prefix) of
81+ case runPSC opts (P.compileJS ms foreigns prefix) of
87 Left errs -> do
82 Left errs -> do
88 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
83 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
89 exitFailure
84 exitFailure
90− Right ((js, exts), warnings') -> do
85+ Right ((js, exts, _), warnings') -> do
91 when (P.nonEmpty warnings') $
86 when (P.nonEmpty warnings') $
92 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
87 hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
93 case output of
88 case output of
@@ -104,47 +99,6 @@ parseInputs modules foreigns =
104 (,) <$> (map snd <$> P.parseModulesFromFiles (fromMaybe "") modules)
99 (,) <$> (map snd <$> P.parseModulesFromFiles (fromMaybe "") modules)
105 <*> P.parseForeignModulesFromFiles foreigns
100 <*> P.parseForeignModulesFromFiles foreigns
106
101
107−compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
108− => [P.Module] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> [String] -> m (String, String)
109−compileJS ms foreigns prefix = do
110− (modulesToCodeGen, env, nextVar, exts) <- P.compile ms
111− js <- concat <$> evalSupplyT nextVar (P.parU modulesToCodeGen codegenModule)
112− js' <- generateMain env js
113− let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
114− return (pjs, exts)
115−
116− where
117−
118− codegenModule :: (Functor n, Applicative n, MonadError P.MultipleErrors n, MonadWriter P.MultipleErrors n, MonadReader (P.Options P.Compile) n, MonadSupply n)
119− => CF.Module CF.Ann -> n [J.JS]
120− codegenModule m =
121− let requiresForeign = not $ null (CF.moduleForeign m)
122− mn = CF.moduleName m
123− in case mn `M.lookup` foreigns of
124− Just (path, js)
125− | not requiresForeign -> do
126− tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
127− J.moduleToJs m Nothing
128− | otherwise -> J.moduleToJs m $ Just $
129− J.JSApp (J.JSFunction Nothing [] $
130− J.JSBlock [ J.JSVariableIntroduction "exports" (Just $ J.JSObjectLiteral [])
131− , J.JSRaw js
132− , J.JSReturn (J.JSVar "exports")
133− ]) []
134− Nothing | requiresForeign -> throwError . P.errorMessage $ P.MissingFFIModule mn
135− | otherwise -> J.moduleToJs m Nothing
136−
137− generateMain :: P.Environment -> [J.JS] -> m [J.JS]
138− generateMain env js = do
139− mainName <- asks P.optionsMain
140− additional <- asks P.optionsAdditional
141− case P.moduleNameFromString <$> mainName of
142− Just mmi -> do
143− when ((mmi, P.Ident C.main) `M.notMember` P.names env) $
144− throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)
145− return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]
146− _ -> return js
147−
148mkdirp :: FilePath -> IO ()
102mkdirp :: FilePath -> IO ()
149mkdirp = createDirectoryIfMissing True . takeDirectory
103mkdirp = createDirectoryIfMissing True . takeDirectory
150
104
src/Language/PureScript.hs+47−1
@@ -22,6 +22,7 @@ module Language.PureScript
22 ( module P
22 ( module P
23 , compile
23 , compile
24 , compile'
24 , compile'
25+ , compileJS
25 , RebuildPolicy(..)
26 , RebuildPolicy(..)
26 , MakeActions(..)
27 , MakeActions(..)
27 , SupplyVar()
28 , SupplyVar()
@@ -44,7 +45,7 @@ import Control.Monad
44import Control.Monad.Error.Class (MonadError(..))
45import Control.Monad.Error.Class (MonadError(..))
45import Control.Monad.Reader
46import Control.Monad.Reader
46import Control.Monad.Writer
47import Control.Monad.Writer
47−import Control.Monad.Supply.Class (fresh)
48+import Control.Monad.Supply.Class (MonadSupply, fresh)
48
49
49import Language.PureScript.AST as P
50import Language.PureScript.AST as P
50import Language.PureScript.Comments as P
51import Language.PureScript.Comments as P
@@ -66,6 +67,7 @@ import Language.PureScript.TypeChecker as P
66import Language.PureScript.Types as P
67import Language.PureScript.Types as P
67import qualified Language.PureScript.CoreFn as CoreFn
68import qualified Language.PureScript.CoreFn as CoreFn
68import qualified Language.PureScript.Constants as C
69import qualified Language.PureScript.Constants as C
70+import qualified Language.PureScript.CodeGen.JS as J
69
71
70import qualified Paths_purescript as Paths
72import qualified Paths_purescript as Paths
71
73
@@ -113,6 +115,50 @@ compile' env ms = do
113 exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
115 exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
114 return (modulesToCodeGen, env', nextVar, exts)
116 return (modulesToCodeGen, env', nextVar, exts)
115
117
118+-- |
119+-- Compile a collection of modules to JavaScript and externs files
120+--
121+compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)
122+ => [P.Module] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> [String] -> m (String, String, Environment)
123+compileJS ms foreigns prefix = do
124+ (modulesToCodeGen, env, nextVar, exts) <- compile ms
125+ js <- concat <$> evalSupplyT nextVar (P.parU modulesToCodeGen codegenModule)
126+ js' <- generateMain env js
127+ let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']
128+ return (pjs, exts, env)
129+
130+ where
131+
132+ codegenModule :: (Functor n, Applicative n, MonadError P.MultipleErrors n, MonadWriter P.MultipleErrors n, MonadReader (P.Options P.Compile) n, MonadSupply n)
133+ => CoreFn.Module CoreFn.Ann -> n [J.JS]
134+ codegenModule m =
135+ let requiresForeign = not $ null (CoreFn.moduleForeign m)
136+ mn = CoreFn.moduleName m
137+ in case mn `M.lookup` foreigns of
138+ Just (path, js)
139+ | not requiresForeign -> do
140+ tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
141+ J.moduleToJs m Nothing
142+ | otherwise -> J.moduleToJs m $ Just $
143+ J.JSApp (J.JSFunction Nothing [] $
144+ J.JSBlock [ J.JSVariableIntroduction "exports" (Just $ J.JSObjectLiteral [])
145+ , J.JSRaw js
146+ , J.JSReturn (J.JSVar "exports")
147+ ]) []
148+ Nothing | requiresForeign -> throwError . P.errorMessage $ P.MissingFFIModule mn
149+ | otherwise -> J.moduleToJs m Nothing
150+
151+ generateMain :: P.Environment -> [J.JS] -> m [J.JS]
152+ generateMain env js = do
153+ mainName <- asks P.optionsMain
154+ additional <- asks P.optionsAdditional
155+ case P.moduleNameFromString <$> mainName of
156+ Just mmi -> do
157+ when ((mmi, P.Ident C.main) `M.notMember` P.names env) $
158+ throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)
159+ return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]
160+ _ -> return js
161+
116-- |
162-- |
117-- Actions that require implementations when running in "make" mode.
163-- Actions that require implementations when running in "make" mode.
118--
164--
tests/Main.hs+37−28
@@ -12,7 +12,7 @@
12--
12--
13-----------------------------------------------------------------------------
13-----------------------------------------------------------------------------
14
14
15−{-# LANGUAGE DataKinds, DoAndIfThenElse #-}
15+{-# LANGUAGE DataKinds, DoAndIfThenElse, TupleSections #-}
16
16
17module Main (main) where
17module Main (main) where
18
18
@@ -20,15 +20,22 @@ import qualified Language.PureScript as P
20
20
21import Data.List (isSuffixOf)
21import Data.List (isSuffixOf)
22import Data.Traversable (traverse)
22import Data.Traversable (traverse)
23+
24+import qualified Data.Map as M
25+
23import Control.Monad
26import Control.Monad
27+import Control.Monad.IO.Class (liftIO)
24import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
28import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
25import Control.Monad.Reader (runReaderT)
29import Control.Monad.Reader (runReaderT)
26import Control.Monad.Writer (runWriterT)
30import Control.Monad.Writer (runWriterT)
31+import Control.Monad.Except (runExceptT)
27import Control.Applicative
32import Control.Applicative
33+
28import System.Exit
34import System.Exit
29import System.Process
35import System.Process
30import System.FilePath ((</>))
36import System.FilePath ((</>))
31import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirectoryContents, findExecutable)
37import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirectoryContents, findExecutable)
38+
32import Text.Parsec (ParseError)
39import Text.Parsec (ParseError)
33
40
34readInput :: [FilePath] -> IO [(FilePath, String)]
41readInput :: [FilePath] -> IO [(FilePath, String)]
@@ -36,36 +43,33 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do
36 text <- readFile inputFile
43 text <- readFile inputFile
37 return (inputFile, text)
44 return (inputFile, text)
38
45
39−loadPrelude :: [(FilePath, String)] -> Either P.MultipleErrors (String, String, P.Environment)
46+loadPrelude :: [(FilePath, String)] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> Either P.MultipleErrors (String, String, P.Environment)
40−loadPrelude ms =
47+loadPrelude fs foreigns = do
41− case P.parseModulesFromFiles id ms of
48+ ms <- P.parseModulesFromFiles id fs
42− Left parseError -> Left . P.errorMessage . P.ErrorParsingPrelude $ parseError
43− Right ms -> fmap fst . runWriterT $ runReaderT (P.compile (map snd ms) []) (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] })
49+ fmap fst . runWriterT $ runReaderT (P.compileJS (map snd ms) foreigns []) (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] })
44−
50+
45−compile :: P.Options P.Compile -> [FilePath] -> IO (Either P.MultipleErrors (String, String, P.Environment))
51+compile :: P.Options P.Compile -> [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors (String, String, P.Environment))
46−compile opts inputFiles = do
52+compile opts inputFiles foreigns = runExceptT . fmap fst . runWriterT . flip runReaderT opts $ do
47− modules <- P.parseModulesFromFiles id <$> readInput inputFiles
53+ fs <- liftIO $ readInput inputFiles
48− case modules of
54+ ms <- P.parseModulesFromFiles id fs
49− Left parseError ->
55+ P.compileJS (map snd ms) foreigns []
50− return . Left . P.errorMessage . P.ErrorParsingPrelude $ parseError
56+
51− Right ms -> return $ fmap fst . runWriterT $ runReaderT (P.compile (map snd ms) []) opts
52−
53−assert :: FilePath -> P.Options P.Compile -> FilePath -> (Either P.MultipleErrors (String, String, P.Environment) -> IO (Maybe String)) -> IO ()
57+assert :: FilePath -> P.Options P.Compile -> FilePath -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> (Either P.MultipleErrors (String, String, P.Environment) -> IO (Maybe String)) -> IO ()
54−assert preludeExterns opts inputFile f = do
58+assert preludeExterns opts inputFile foreigns f = do
55− e <- compile opts [preludeExterns, inputFile]
59+ e <- compile opts [preludeExterns, inputFile] foreigns
56 maybeErr <- f e
60 maybeErr <- f e
57 case maybeErr of
61 case maybeErr of
58 Just err -> putStrLn err >> exitFailure
62 Just err -> putStrLn err >> exitFailure
59 Nothing -> return ()
63 Nothing -> return ()
60
64
61−assertCompiles :: String -> FilePath -> FilePath -> IO ()
65+assertCompiles :: String -> FilePath -> FilePath -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()
62−assertCompiles preludeJs preludeExterns inputFile = do
66+assertCompiles preludeJs preludeExterns inputFile foreigns = do
63 putStrLn $ "Assert " ++ inputFile ++ " compiles successfully"
67 putStrLn $ "Assert " ++ inputFile ++ " compiles successfully"
64 let options = P.defaultCompileOptions
68 let options = P.defaultCompileOptions
65 { P.optionsMain = Just "Main"
69 { P.optionsMain = Just "Main"
66 , P.optionsAdditional = P.CompileOptions "Tests" ["Main"] ["Main"]
70 , P.optionsAdditional = P.CompileOptions "Tests" ["Main"] ["Main"]
67 }
71 }
68− assert preludeExterns options inputFile $ either (return . Just . P.prettyPrintMultipleErrors False) $ \(js, _, _) -> do
72+ assert preludeExterns options inputFile foreigns $ either (return . Just . P.prettyPrintMultipleErrors False) $ \(js, _, _) -> do
69 process <- findNodeProcess
73 process <- findNodeProcess
70 result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process
74 result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process
71 case result of
75 case result of
@@ -73,10 +77,10 @@ assertCompiles preludeJs preludeExterns inputFile = do
73 Just (ExitFailure _, _, err) -> return $ Just err
77 Just (ExitFailure _, _, err) -> return $ Just err
74 Nothing -> return $ Just "Couldn't find node.js executable"
78 Nothing -> return $ Just "Couldn't find node.js executable"
75
79
76−assertDoesNotCompile :: FilePath -> FilePath -> IO ()
80+assertDoesNotCompile :: FilePath -> FilePath -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()
77−assertDoesNotCompile preludeExterns inputFile = do
81+assertDoesNotCompile preludeExterns inputFile foreigns = do
78 putStrLn $ "Assert " ++ inputFile ++ " does not compile"
82 putStrLn $ "Assert " ++ inputFile ++ " does not compile"
79− assert preludeExterns (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) inputFile $ \e ->
83+ assert preludeExterns (P.defaultCompileOptions { P.optionsAdditional = P.CompileOptions "Tests" [] [] }) inputFile foreigns $ \e ->
80 case e of
84 case e of
81 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> return Nothing
85 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> return Nothing
82 Right _ -> return $ Just "Should not have compiled"
86 Right _ -> return $ Just "Should not have compiled"
@@ -89,9 +93,14 @@ findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
89main :: IO ()
93main :: IO ()
90main = do
94main = do
91 cwd <- getCurrentDirectory
95 cwd <- getCurrentDirectory
92− prelude <- readInput [cwd </> "tests" </> "prelude.purs"]
96+ let preludeDir = cwd </> "tests" </> "prelude"
97+ jsDir = preludeDir </> "js"
98+ prelude <- readInput [preludeDir </> "Prelude.purs"]
99+ jsFiles <- map (jsDir </>) . filter (".js" `isSuffixOf`) <$> getDirectoryContents jsDir
100+ foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)
101+ Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles
93 putStrLn "Compiling Prelude"
102 putStrLn "Compiling Prelude"
94− case loadPrelude prelude of
103+ case loadPrelude prelude foreigns of
95 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
104 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
96 Right (preludeJs, exts, _) -> do
105 Right (preludeJs, exts, _) -> do
97 tmp <- getTemporaryDirectory
106 tmp <- getTemporaryDirectory
@@ -101,9 +110,9 @@ main = do
101 let passing = cwd </> "examples" </> "passing"
110 let passing = cwd </> "examples" </> "passing"
102 passingTestCases <- getDirectoryContents passing
111 passingTestCases <- getDirectoryContents passing
103 forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
112 forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
104− assertCompiles preludeJs preludeExterns (passing </> inputFile)
113+ assertCompiles preludeJs preludeExterns (passing </> inputFile) foreigns
105 let failing = cwd </> "examples" </> "failing"
114 let failing = cwd </> "examples" </> "failing"
106 failingTestCases <- getDirectoryContents failing
115 failingTestCases <- getDirectoryContents failing
107 forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
116 forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
108− assertDoesNotCompile preludeExterns (failing </> inputFile)
117+ assertDoesNotCompile preludeExterns (failing </> inputFile) foreigns
109 exitSuccess
118 exitSuccess
tests/prelude.pursdeleted−1068
@@ -1,1068 +0,0 @@
1−-- | This snapshot is provided for the purposes of running the test suite.
2−-- | It is not necessarily kept up to date with the official PureScript Prelude,
3−-- | and should not be used in user code.
4−-- | The official Prelude can be found at https://github.com/purescript/purescript-prelude
5−
6−module Prelude
7− ( Unit(..), unit
8− , ($), (#)
9− , flip
10− , const
11− , asTypeOf
12− , otherwise
13− , (:), cons
14− , Semigroupoid, (<<<), (>>>)
15− , Category, id
16− , Functor, (<$>), (<#>), void
17− , Apply, (<*>)
18− , Applicative, pure, liftA1
19− , Bind, (>>=)
20− , Monad, return, liftM1, ap
21− , Semigroup, (<>), (++)
22− , Semiring, (+), zero, (*), one
23− , ModuloSemiring, (/), mod
24− , Ring, (-), negate
25− , Num
26− , DivisionRing
27− , Eq, (==), (/=)
28− , Ordering(..), Ord, compare, (<), (>), (<=), (>=)
29− , Bounded, top, bottom
30− , Lattice, sup, inf, (||), (&&)
31− , BoundedLattice
32− , ComplementedLattice, not
33− , DistributiveLattice
34− , BooleanAlgebra
35− , Show, show
36− ) where
37−
38− newtype Unit = Unit {}
39−
40− unit :: Unit
41− unit = Unit {}
42−
43− infixr 0 $
44− infixl 0 #
45−
46− ($) :: forall a b. (a -> b) -> a -> b
47− ($) f x = f x
48−
49− (#) :: forall a b. a -> (a -> b) -> b
50− (#) x f = f x
51−
52− flip :: forall a b c. (a -> b -> c) -> b -> a -> c
53− flip f b a = f a b
54−
55− const :: forall a b. a -> b -> a
56− const a _ = a
57−
58− asTypeOf :: forall a. a -> a -> a
59− asTypeOf x _ = x
60−
61− otherwise :: Boolean
62− otherwise = true
63−
64− foreign import cons
65− """
66− function cons(e) {
67− return function(l) {
68− return [e].concat(l);
69− };
70− }
71− """ :: forall a. a -> Array a -> Array a
72−
73− infixr 6 :
74−
75− (:) :: forall a. a -> Array a -> Array a
76− (:) = cons
77−
78− infixr 9 >>>
79− infixr 9 <<<
80−
81− class Semigroupoid a where
82− (<<<) :: forall b c d. a c d -> a b c -> a b d
83−
84− instance semigroupoidArr :: Semigroupoid (->) where
85− (<<<) f g x = f (g x)
86−
87− (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
88− (>>>) f g = g <<< f
89−
90− class (Semigroupoid a) <= Category a where
91− id :: forall t. a t t
92−
93− instance categoryArr :: Category (->) where
94− id x = x
95−
96− infixl 4 <$>
97− infixl 1 <#>
98−
99− class Functor f where
100− (<$>) :: forall a b. (a -> b) -> f a -> f b
101−
102− instance functorArr :: Functor ((->) r) where
103− (<$>) = (<<<)
104−
105− (<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b
106− (<#>) fa f = f <$> fa
107−
108− void :: forall f a. (Functor f) => f a -> f Unit
109− void fa = const unit <$> fa
110−
111− infixl 4 <*>
112−
113− class (Functor f) <= Apply f where
114− (<*>) :: forall a b. f (a -> b) -> f a -> f b
115−
116− instance applyArr :: Apply ((->) r) where
117− (<*>) f g x = f x (g x)
118−
119− class (Apply f) <= Applicative f where
120− pure :: forall a. a -> f a
121−
122− instance applicativeArr :: Applicative ((->) r) where
123− pure = const
124−
125− return :: forall m a. (Applicative m) => a -> m a
126− return = pure
127−
128− liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
129− liftA1 f a = pure f <*> a
130−
131− infixl 1 >>=
132−
133− class (Apply m) <= Bind m where
134− (>>=) :: forall a b. m a -> (a -> m b) -> m b
135−
136− instance bindArr :: Bind ((->) r) where
137− (>>=) m f x = f (m x) x
138−
139− class (Applicative m, Bind m) <= Monad m
140−
141− instance monadArr :: Monad ((->) r)
142−
143− liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
144− liftM1 f a = do
145− a' <- a
146− return (f a')
147−
148− ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
149− ap f a = do
150− f' <- f
151− a' <- a
152− return (f' a')
153−
154− infixr 5 <>
155− infixr 5 ++
156−
157− class Semigroup a where
158− (<>) :: a -> a -> a
159−
160− (++) :: forall s. (Semigroup s) => s -> s -> s
161− (++) = (<>)
162−
163− instance semigroupString :: Semigroup String where
164− (<>) = concatString
165−
166− instance semigroupUnit :: Semigroup Unit where
167− (<>) _ _ = unit
168−
169− instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
170− (<>) f g = \x -> f x <> g x
171−
172− instance semigroupOrdering :: Semigroup Ordering where
173− (<>) LT _ = LT
174− (<>) GT _ = GT
175− (<>) EQ y = y
176−
177− foreign import concatString
178− """
179− function concatString(s1) {
180− return function(s2) {
181− return s1 + s2;
182− };
183− }
184− """ :: String -> String -> String
185−
186− infixl 6 +
187− infixl 7 *
188−
189− class Semiring a where
190− (+) :: a -> a -> a
191− zero :: a
192− (*) :: a -> a -> a
193− one :: a
194−
195− instance semiringNumber :: Semiring Number where
196− (+) = numAdd
197− zero = 0.0
198− (*) = numMul
199− one = 1.0
200−
201− instance semiringUnit :: Semiring Unit where
202− (+) _ _ = unit
203− zero = unit
204− (*) _ _ = unit
205− one = unit
206−
207− infixl 6 -
208−
209− class (Semiring a) <= Ring a where
210− (-) :: a -> a -> a
211−
212− instance ringNumber :: Ring Number where
213− (-) = numSub
214−
215− instance ringUnit :: Ring Unit where
216− (-) _ _ = unit
217−
218− negate :: forall a. (Ring a) => a -> a
219− negate a = zero - a
220−
221− infixl 7 /
222−
223− class (Semiring a) <= ModuloSemiring a where
224− (/) :: a -> a -> a
225− mod :: a -> a -> a
226−
227− instance moduloSemiringNumber :: ModuloSemiring Number where
228− (/) = numDiv
229− mod _ _ = 0.0
230−
231− instance moduloSemiringUnit :: ModuloSemiring Unit where
232− (/) _ _ = unit
233− mod _ _ = unit
234−
235− class (Ring a, ModuloSemiring a) <= DivisionRing a
236−
237− instance divisionRingNumber :: DivisionRing Number
238−
239− instance divisionRingUnit :: DivisionRing Unit
240−
241− class (DivisionRing a) <= Num a
242−
243− instance numNumber :: Num Number
244−
245− instance numUnit :: Num Unit
246−
247− foreign import numAdd
248− """
249− function numAdd(n1) {
250− return function(n2) {
251− return n1 + n2;
252− };
253− }
254− """ :: Number -> Number -> Number
255−
256− foreign import numMul
257− """
258− function numMul(n1) {
259− return function(n2) {
260− return n1 * n2;
261− };
262− }
263− """ :: Number -> Number -> Number
264−
265− foreign import numDiv
266− """
267− function numDiv(n1) {
268− return function(n2) {
269− return n1 / n2;
270− };
271− }
272− """ :: Number -> Number -> Number
273−
274− foreign import numSub
275− """
276− function numSub(n1) {
277− return function(n2) {
278− return n1 - n2;
279− };
280− }
281− """ :: Number -> Number -> Number
282−
283− infix 4 ==
284− infix 4 /=
285−
286− class Eq a where
287− (==) :: a -> a -> Boolean
288− (/=) :: a -> a -> Boolean
289−
290− instance eqBoolean :: Eq Boolean where
291− (==) = refEq
292− (/=) = refIneq
293−
294− instance eqNumber :: Eq Number where
295− (==) = refEq
296− (/=) = refIneq
297−
298− instance eqString :: Eq String where
299− (==) = refEq
300− (/=) = refIneq
301−
302− instance eqUnit :: Eq Unit where
303− (==) _ _ = true
304− (/=) _ _ = false
305−
306− instance eqArray :: (Eq a) => Eq (Array a) where
307− (==) = eqArrayImpl (==)
308− (/=) xs ys = not (xs == ys)
309−
310− instance eqOrdering :: Eq Ordering where
311− (==) LT LT = true
312− (==) GT GT = true
313− (==) EQ EQ = true
314− (==) _ _ = false
315− (/=) x y = not (x == y)
316−
317− foreign import refEq
318− """
319− function refEq(r1) {
320− return function(r2) {
321− return r1 === r2;
322− };
323− }
324− """ :: forall a. a -> a -> Boolean
325−
326− foreign import refIneq
327− """
328− function refIneq(r1) {
329− return function(r2) {
330− return r1 !== r2;
331− };
332− }
333− """ :: forall a. a -> a -> Boolean
334−
335− foreign import eqArrayImpl
336− """
337− function eqArrayImpl(f) {
338− return function(xs) {
339− return function(ys) {
340− if (xs.length !== ys.length) return false;
341− for (var i = 0; i < xs.length; i++) {
342− if (!f(xs[i])(ys[i])) return false;
343− }
344− return true;
345− };
346− };
347− }
348− """ :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean
349−
350− data Ordering = LT | GT | EQ
351−
352− class (Eq a) <= Ord a where
353− compare :: a -> a -> Ordering
354−
355− instance ordBoolean :: Ord Boolean where
356− compare false false = EQ
357− compare false true = LT
358− compare true true = EQ
359− compare true false = GT
360−
361− instance ordNumber :: Ord Number where
362− compare = unsafeCompare
363−
364− instance ordString :: Ord String where
365− compare = unsafeCompare
366−
367− instance ordUnit :: Ord Unit where
368− compare _ _ = EQ
369−
370− instance ordArray :: (Ord a) => Ord (Array a) where
371− compare xs ys = compare 0.0 $ ordArrayImpl (\x y -> case compare x y of
372− EQ -> 0.0
373− LT -> -1.0
374− GT -> 1.0) xs ys
375−
376− foreign import ordArrayImpl """
377− function ordArrayImpl(f) {
378− return function (ys) {
379− return function (ys) {
380− var i = 0;
381− while (i < xs.length && i < ys.length) {
382− var x = xs[i];
383− var y = ys[i];
384− var o = f(x)(y);
385− if (o !== 0) {
386− return o;
387− }
388− }
389− if (xs.length == ys.length) {
390− return 0;
391− } else if (xs.length > ys.length) {
392− return 1;
393− } else {
394− return -1;
395− }
396− };
397− };
398− }
399− """ :: forall a. (a -> a -> Number) -> Array a -> Array a -> Number
400−
401− instance ordOrdering :: Ord Ordering where
402− compare LT LT = EQ
403− compare EQ EQ = EQ
404− compare GT GT = EQ
405− compare LT _ = LT
406− compare EQ LT = GT
407− compare EQ GT = LT
408− compare GT _ = GT
409−
410− infixl 4 <
411− infixl 4 >
412− infixl 4 <=
413− infixl 4 >=
414−
415− (<) :: forall a. (Ord a) => a -> a -> Boolean
416− (<) a1 a2 = case a1 `compare` a2 of
417− LT -> true
418− _ -> false
419−
420− (>) :: forall a. (Ord a) => a -> a -> Boolean
421− (>) a1 a2 = case a1 `compare` a2 of
422− GT -> true
423− _ -> false
424−
425− (<=) :: forall a. (Ord a) => a -> a -> Boolean
426− (<=) a1 a2 = case a1 `compare` a2 of
427− GT -> false
428− _ -> true
429−
430− (>=) :: forall a. (Ord a) => a -> a -> Boolean
431− (>=) a1 a2 = case a1 `compare` a2 of
432− LT -> false
433− _ -> true
434−
435− unsafeCompare :: forall a. a -> a -> Ordering
436− unsafeCompare = unsafeCompareImpl LT EQ GT
437−
438− foreign import unsafeCompareImpl
439− """
440− function unsafeCompareImpl(lt) {
441− return function(eq) {
442− return function(gt) {
443− return function(x) {
444− return function(y) {
445− return x < y ? lt : x > y ? gt : eq;
446− };
447− };
448− };
449− };
450− }
451− """ :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering
452−
453− class (Ord a) <= Bounded a where
454− top :: a
455− bottom :: a
456−
457− instance boundedBoolean :: Bounded Boolean where
458− top = true
459− bottom = false
460−
461− instance boundedUnit :: Bounded Unit where
462− top = unit
463− bottom = unit
464−
465− instance boundedOrdering :: Bounded Ordering where
466− top = GT
467− bottom = LT
468−
469− class (Ord a) <= Lattice a where
470− sup :: a -> a -> a
471− inf :: a -> a -> a
472−
473− instance latticeBoolean :: Lattice Boolean where
474− sup = boolOr
475− inf = boolAnd
476−
477− instance latticeUnit :: Lattice Unit where
478− sup _ _ = unit
479− inf _ _ = unit
480−
481− infixr 2 ||
482− infixr 3 &&
483−
484− (||) :: forall a. (Lattice a) => a -> a -> a
485− (||) = sup
486−
487− (&&) :: forall a. (Lattice a) => a -> a -> a
488− (&&) = inf
489−
490− class (Bounded a, Lattice a) <= BoundedLattice a
491−
492− instance boundedLatticeBoolean :: BoundedLattice Boolean
493−
494− instance boundedLatticeUnit :: BoundedLattice Unit
495−
496− class (BoundedLattice a) <= ComplementedLattice a where
497− not :: a -> a
498−
499− instance complementedLatticeBoolean :: ComplementedLattice Boolean where
500− not = boolNot
501−
502− instance complementedLatticeUnit :: ComplementedLattice Unit where
503− not _ = unit
504−
505− class (Lattice a) <= DistributiveLattice a
506−
507− instance distributiveLatticeBoolean :: DistributiveLattice Boolean
508−
509− instance distributiveLatticeUnit :: DistributiveLattice Unit
510−
511− class (ComplementedLattice a, DistributiveLattice a) <= BooleanAlgebra a
512−
513− instance booleanAlgebraBoolean :: BooleanAlgebra Boolean
514−
515− instance booleanAlgebraUnit :: BooleanAlgebra Unit
516−
517− foreign import boolOr
518− """
519− function boolOr(b1) {
520− return function(b2) {
521− return b1 || b2;
522− };
523− }
524− """ :: Boolean -> Boolean -> Boolean
525−
526− foreign import boolAnd
527− """
528− function boolAnd(b1) {
529− return function(b2) {
530− return b1 && b2;
531− };
532− }
533− """ :: Boolean -> Boolean -> Boolean
534−
535− foreign import boolNot
536− """
537− function boolNot(b) {
538− return !b;
539− }
540− """ :: Boolean -> Boolean
541−
542− class Show a where
543− show :: a -> String
544−
545− instance showBoolean :: Show Boolean where
546− show true = "true"
547− show false = "false"
548−
549− instance showNumber :: Show Number where
550− show = showNumberImpl
551−
552− instance showString :: Show String where
553− show = showStringImpl
554−
555− instance showUnit :: Show Unit where
556− show _ = "unit"
557−
558− instance showArray :: (Show a) => Show (Array a) where
559− show = showArrayImpl show
560−
561− instance showOrdering :: Show Ordering where
562− show LT = "LT"
563− show GT = "GT"
564− show EQ = "EQ"
565−
566− foreign import showNumberImpl
567− """
568− function showNumberImpl(n) {
569− return n.toString();
570− }
571− """ :: Number -> String
572−
573− foreign import showStringImpl
574− """
575− function showStringImpl(s) {
576− return JSON.stringify(s);
577− }
578− """ :: String -> String
579−
580− foreign import showArrayImpl
581− """
582− function showArrayImpl(f) {
583− return function(xs) {
584− var ss = [];
585− for (var i = 0, l = xs.length; i < l; i++) {
586− ss[i] = f(xs[i]);
587− }
588− return '[' + ss.join(',') + ']';
589− };
590− }
591− """ :: forall a. (a -> String) -> Array a -> String
592−
593−module Data.Function where
594−
595− on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
596− on f g x y = g x `f` g y
597−
598− foreign import data Fn0 :: * -> *
599−
600− foreign import data Fn1 :: * -> * -> *
601−
602− foreign import data Fn2 :: * -> * -> * -> *
603−
604− foreign import data Fn3 :: * -> * -> * -> * -> *
605−
606− foreign import data Fn4 :: * -> * -> * -> * -> * -> *
607−
608− foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
609−
610− foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
611−
612− foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
613−
614− foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
615−
616− foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
617−
618− foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
619−
620− foreign import mkFn0
621− """
622− function mkFn0(fn) {
623− return function() {
624− return fn({});
625− };
626− }
627− """ :: forall a. (Unit -> a) -> Fn0 a
628−
629− foreign import mkFn1
630− """
631− function mkFn1(fn) {
632− return function(a) {
633− return fn(a);
634− };
635− }
636− """ :: forall a b. (a -> b) -> Fn1 a b
637−
638− foreign import mkFn2
639− """
640− function mkFn2(fn) {
641− return function(a, b) {
642− return fn(a)(b);
643− };
644− }
645− """ :: forall a b c. (a -> b -> c) -> Fn2 a b c
646−
647− foreign import mkFn3
648− """
649− function mkFn3(fn) {
650− return function(a, b, c) {
651− return fn(a)(b)(c);
652− };
653− }
654− """ :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d
655−
656− foreign import mkFn4
657− """
658− function mkFn4(fn) {
659− return function(a, b, c, d) {
660− return fn(a)(b)(c)(d);
661− };
662− }
663− """ :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e
664−
665− foreign import mkFn5
666− """
667− function mkFn5(fn) {
668− return function(a, b, c, d, e) {
669− return fn(a)(b)(c)(d)(e);
670− };
671− }
672− """ :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f
673−
674− foreign import mkFn6
675− """
676− function mkFn6(fn) {
677− return function(a, b, c, d, e, f) {
678− return fn(a)(b)(c)(d)(e)(f);
679− };
680− }
681− """ :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g
682−
683− foreign import mkFn7
684− """
685− function mkFn7(fn) {
686− return function(a, b, c, d, e, f, g) {
687− return fn(a)(b)(c)(d)(e)(f)(g);
688− };
689− }
690− """ :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h
691−
692− foreign import mkFn8
693− """
694− function mkFn8(fn) {
695− return function(a, b, c, d, e, f, g, h) {
696− return fn(a)(b)(c)(d)(e)(f)(g)(h);
697− };
698− }
699− """ :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i
700−
701− foreign import mkFn9
702− """
703− function mkFn9(fn) {
704− return function(a, b, c, d, e, f, g, h, i) {
705− return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);
706− };
707− }
708− """ :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j
709−
710− foreign import mkFn10
711− """
712− function mkFn10(fn) {
713− return function(a, b, c, d, e, f, g, h, i, j) {
714− return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);
715− };
716− }
717− """ :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k
718−
719− foreign import runFn0
720− """
721− function runFn0(fn) {
722− return fn();
723− }
724− """ :: forall a. Fn0 a -> a
725−
726− foreign import runFn1
727− """
728− function runFn1(fn) {
729− return function(a) {
730− return fn(a);
731− };
732− }
733− """ :: forall a b. Fn1 a b -> a -> b
734−
735− foreign import runFn2
736− """
737− function runFn2(fn) {
738− return function(a) {
739− return function(b) {
740− return fn(a, b);
741− };
742− };
743− }
744− """ :: forall a b c. Fn2 a b c -> a -> b -> c
745−
746− foreign import runFn3
747− """
748− function runFn3(fn) {
749− return function(a) {
750− return function(b) {
751− return function(c) {
752− return fn(a, b, c);
753− };
754− };
755− };
756− }
757− """ :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d
758−
759− foreign import runFn4
760− """
761− function runFn4(fn) {
762− return function(a) {
763− return function(b) {
764− return function(c) {
765− return function(d) {
766− return fn(a, b, c, d);
767− };
768− };
769− };
770− };
771− }
772− """ :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e
773−
774− foreign import runFn5
775− """
776− function runFn5(fn) {
777− return function(a) {
778− return function(b) {
779− return function(c) {
780− return function(d) {
781− return function(e) {
782− return fn(a, b, c, d, e);
783− };
784− };
785− };
786− };
787− };
788− }
789− """ :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f
790−
791− foreign import runFn6
792− """
793− function runFn6(fn) {
794− return function(a) {
795− return function(b) {
796− return function(c) {
797− return function(d) {
798− return function(e) {
799− return function(f) {
800− return fn(a, b, c, d, e, f);
801− };
802− };
803− };
804− };
805− };
806− };
807− }
808− """ :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g
809−
810− foreign import runFn7
811− """
812− function runFn7(fn) {
813− return function(a) {
814− return function(b) {
815− return function(c) {
816− return function(d) {
817− return function(e) {
818− return function(f) {
819− return function(g) {
820− return fn(a, b, c, d, e, f, g);
821− };
822− };
823− };
824− };
825− };
826− };
827− };
828− }
829− """ :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h
830−
831− foreign import runFn8
832− """
833− function runFn8(fn) {
834− return function(a) {
835− return function(b) {
836− return function(c) {
837− return function(d) {
838− return function(e) {
839− return function(f) {
840− return function(g) {
841− return function(h) {
842− return fn(a, b, c, d, e, f, g, h);
843− };
844− };
845− };
846− };
847− };
848− };
849− };
850− };
851− }
852− """ :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i
853−
854− foreign import runFn9
855− """
856− function runFn9(fn) {
857− return function(a) {
858− return function(b) {
859− return function(c) {
860− return function(d) {
861− return function(e) {
862− return function(f) {
863− return function(g) {
864− return function(h) {
865− return function(i) {
866− return fn(a, b, c, d, e, f, g, h, i);
867− };
868− };
869− };
870− };
871− };
872− };
873− };
874− };
875− };
876− }
877− """ :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
878−
879− foreign import runFn10
880− """
881− function runFn10(fn) {
882− return function(a) {
883− return function(b) {
884− return function(c) {
885− return function(d) {
886− return function(e) {
887− return function(f) {
888− return function(g) {
889− return function(h) {
890− return function(i) {
891− return function(j) {
892− return fn(a, b, c, d, e, f, g, h, i, j);
893− };
894− };
895− };
896− };
897− };
898− };
899− };
900− };
901− };
902− };
903− }
904− """ :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
905−
906−module Prelude.Unsafe where
907−
908− foreign import unsafeIndex
909− """
910− function unsafeIndex(xs) {
911− return function(n) {
912− return xs[n];
913− };
914− }
915− """ :: forall a. Array a -> Number -> a
916−
917−module Control.Monad.Eff
918− ( Eff()
919− , Pure()
920− , runPure
921− , untilE, whileE
922− ) where
923−
924− foreign import data Eff :: # ! -> * -> *
925−
926− foreign import returnE
927− """
928− function returnE(a) {
929− return function() {
930− return a;
931− };
932− }
933− """ :: forall e a. a -> Eff e a
934−
935− foreign import bindE
936− """
937− function bindE(a) {
938− return function(f) {
939− return function() {
940− return f(a())();
941− };
942− };
943− }
944− """ :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
945−
946− type Pure a = forall e. Eff e a
947−
948− foreign import runPure
949− """
950− function runPure(f) {
951− return f();
952− }
953− """ :: forall a. Pure a -> a
954−
955− instance functorEff :: Functor (Eff e) where
956− (<$>) = liftA1
957−
958− instance applyEff :: Apply (Eff e) where
959− (<*>) = ap
960−
961− instance applicativeEff :: Applicative (Eff e) where
962− pure = returnE
963−
964− instance bindEff :: Bind (Eff e) where
965− (>>=) = bindE
966−
967− instance monadEff :: Monad (Eff e)
968−
969− foreign import untilE
970− """
971− function untilE(f) {
972− return function() {
973− while (!f());
974− return {};
975− };
976− }
977− """ :: forall e. Eff e Boolean -> Eff e Unit
978−
979− foreign import whileE
980− """
981− function whileE(f) {
982− return function(a) {
983− return function() {
984− while (f()) {
985− a();
986− }
987− return {};
988− };
989− };
990− }
991− """ :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit
992−
993−module Debug.Trace where
994−
995− import Control.Monad.Eff
996−
997− foreign import data Trace :: !
998−
999− foreign import trace
1000− """
1001− function trace(s) {
1002− return function() {
1003− console.log(s);
1004− return {};
1005− };
1006− }
1007− """ :: forall r. String -> Eff (trace :: Trace | r) Unit
1008−
1009− print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
1010− print o = trace (show o)
1011−
1012−module Control.Monad.ST where
1013−
1014− import Control.Monad.Eff
1015−
1016− foreign import data ST :: * -> !
1017−
1018− foreign import data STRef :: * -> * -> *
1019−
1020− foreign import newSTRef
1021− """
1022− function newSTRef(val) {
1023− return function() {
1024− return { value: val };
1025− };
1026− }
1027− """ :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)
1028−
1029− foreign import readSTRef
1030− """
1031− function readSTRef(ref) {
1032− return function() {
1033− return ref.value;
1034− };
1035− }
1036− """ :: forall a h r. STRef h a -> Eff (st :: ST h | r) a
1037−
1038− foreign import modifySTRef
1039− """
1040− function modifySTRef(ref) {
1041− return function(f) {
1042− return function() {
1043− return ref.value = f(ref.value);
1044− };
1045− };
1046− }
1047− """ :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a
1048−
1049− foreign import writeSTRef
1050− """
1051− function writeSTRef(ref) {
1052− return function(a) {
1053− return function() {
1054− return ref.value = a;
1055− };
1056− };
1057− }
1058− """ :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a
1059−
1060− foreign import runST
1061− """
1062− function runST(f) {
1063− return f;
1064− }
1065− """ :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
1066−
1067− pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a
1068− pureST st = runPure (runST st)
tests/prelude/Prelude.pursnew file+621
@@ -0,0 +1,621 @@
1+-- | This snapshot is provided for the purposes of running the test suite.
2+-- | It is not necessarily kept up to date with the official PureScript Prelude,
3+-- | and should not be used in user code.
4+-- | The official Prelude can be found at https://github.com/purescript/purescript-prelude
5+
6+module Prelude
7+ ( Unit(..), unit
8+ , ($), (#)
9+ , length
10+ , flip
11+ , const
12+ , asTypeOf
13+ , otherwise
14+ , (:), cons, concat
15+ , Semigroupoid, (<<<), (>>>)
16+ , Category, id
17+ , Functor, (<$>), (<#>), void
18+ , Apply, (<*>)
19+ , Applicative, pure, liftA1
20+ , Bind, (>>=)
21+ , Monad, return, liftM1, ap
22+ , Semigroup, (<>), (++)
23+ , Semiring, (+), zero, (*), one
24+ , ModuloSemiring, (/), mod, jsMod, (%)
25+ , Ring, (-), negate
26+ , Num
27+ , DivisionRing
28+ , Eq, (==), (/=)
29+ , Ordering(..), Ord, compare, (<), (>), (<=), (>=)
30+ , Bounded, top, bottom
31+ , Lattice, sup, inf, (||), (&&)
32+ , BoundedLattice
33+ , ComplementedLattice, not
34+ , DistributiveLattice
35+ , BooleanAlgebra
36+ , Show, show
37+ ) where
38+
39+ newtype Unit = Unit {}
40+
41+ unit :: Unit
42+ unit = Unit {}
43+
44+ foreign import length :: forall a. Array a -> Number
45+
46+ infixr 0 $
47+ infixl 0 #
48+
49+ ($) :: forall a b. (a -> b) -> a -> b
50+ ($) f x = f x
51+
52+ (#) :: forall a b. a -> (a -> b) -> b
53+ (#) x f = f x
54+
55+ flip :: forall a b c. (a -> b -> c) -> b -> a -> c
56+ flip f b a = f a b
57+
58+ const :: forall a b. a -> b -> a
59+ const a _ = a
60+
61+ asTypeOf :: forall a. a -> a -> a
62+ asTypeOf x _ = x
63+
64+ otherwise :: Boolean
65+ otherwise = true
66+
67+ foreign import cons :: forall a. a -> Array a -> Array a
68+
69+ infixr 6 :
70+
71+ (:) :: forall a. a -> Array a -> Array a
72+ (:) = cons
73+
74+ foreign import concat :: forall a. Array a -> Array a -> Array a
75+
76+ infixr 9 >>>
77+ infixr 9 <<<
78+
79+ class Semigroupoid a where
80+ (<<<) :: forall b c d. a c d -> a b c -> a b d
81+
82+ instance semigroupoidArr :: Semigroupoid (->) where
83+ (<<<) f g x = f (g x)
84+
85+ (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
86+ (>>>) f g = g <<< f
87+
88+ class (Semigroupoid a) <= Category a where
89+ id :: forall t. a t t
90+
91+ instance categoryArr :: Category (->) where
92+ id x = x
93+
94+ infixl 4 <$>
95+ infixl 1 <#>
96+
97+ class Functor f where
98+ (<$>) :: forall a b. (a -> b) -> f a -> f b
99+
100+ instance functorArr :: Functor ((->) r) where
101+ (<$>) = (<<<)
102+
103+ (<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b
104+ (<#>) fa f = f <$> fa
105+
106+ void :: forall f a. (Functor f) => f a -> f Unit
107+ void fa = const unit <$> fa
108+
109+ infixl 4 <*>
110+
111+ class (Functor f) <= Apply f where
112+ (<*>) :: forall a b. f (a -> b) -> f a -> f b
113+
114+ instance applyArr :: Apply ((->) r) where
115+ (<*>) f g x = f x (g x)
116+
117+ class (Apply f) <= Applicative f where
118+ pure :: forall a. a -> f a
119+
120+ instance applicativeArr :: Applicative ((->) r) where
121+ pure = const
122+
123+ return :: forall m a. (Applicative m) => a -> m a
124+ return = pure
125+
126+ liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
127+ liftA1 f a = pure f <*> a
128+
129+ infixl 1 >>=
130+
131+ class (Apply m) <= Bind m where
132+ (>>=) :: forall a b. m a -> (a -> m b) -> m b
133+
134+ instance bindArr :: Bind ((->) r) where
135+ (>>=) m f x = f (m x) x
136+
137+ class (Applicative m, Bind m) <= Monad m
138+
139+ instance monadArr :: Monad ((->) r)
140+
141+ liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
142+ liftM1 f a = do
143+ a' <- a
144+ return (f a')
145+
146+ ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
147+ ap f a = do
148+ f' <- f
149+ a' <- a
150+ return (f' a')
151+
152+ infixr 5 <>
153+ infixr 5 ++
154+
155+ class Semigroup a where
156+ (<>) :: a -> a -> a
157+
158+ (++) :: forall s. (Semigroup s) => s -> s -> s
159+ (++) = (<>)
160+
161+ instance semigroupString :: Semigroup String where
162+ (<>) = concatString
163+
164+ instance semigroupUnit :: Semigroup Unit where
165+ (<>) _ _ = unit
166+
167+ instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
168+ (<>) f g = \x -> f x <> g x
169+
170+ instance semigroupOrdering :: Semigroup Ordering where
171+ (<>) LT _ = LT
172+ (<>) GT _ = GT
173+ (<>) EQ y = y
174+
175+ foreign import concatString :: String -> String -> String
176+
177+ infixl 6 +
178+ infixl 7 *
179+
180+ class Semiring a where
181+ (+) :: a -> a -> a
182+ zero :: a
183+ (*) :: a -> a -> a
184+ one :: a
185+
186+ instance semiringNumber :: Semiring Number where
187+ (+) = numAdd
188+ zero = 0.0
189+ (*) = numMul
190+ one = 1.0
191+
192+ instance semiringUnit :: Semiring Unit where
193+ (+) _ _ = unit
194+ zero = unit
195+ (*) _ _ = unit
196+ one = unit
197+
198+ infixl 6 -
199+
200+ class (Semiring a) <= Ring a where
201+ (-) :: a -> a -> a
202+
203+ instance ringNumber :: Ring Number where
204+ (-) = numSub
205+
206+ instance ringUnit :: Ring Unit where
207+ (-) _ _ = unit
208+
209+ negate :: forall a. (Ring a) => a -> a
210+ negate a = zero - a
211+
212+ infixl 7 /
213+
214+ class (Semiring a) <= ModuloSemiring a where
215+ (/) :: a -> a -> a
216+ mod :: a -> a -> a
217+
218+ instance moduloSemiringNumber :: ModuloSemiring Number where
219+ (/) = numDiv
220+ mod _ _ = 0.0
221+
222+ instance moduloSemiringUnit :: ModuloSemiring Unit where
223+ (/) _ _ = unit
224+ mod _ _ = unit
225+
226+ foreign import jsMod :: Number -> Number -> Number
227+
228+ infixl 7 %
229+
230+ (%) = jsMod
231+
232+ class (Ring a, ModuloSemiring a) <= DivisionRing a
233+
234+ instance divisionRingNumber :: DivisionRing Number
235+
236+ instance divisionRingUnit :: DivisionRing Unit
237+
238+ class (DivisionRing a) <= Num a
239+
240+ instance numNumber :: Num Number
241+
242+ instance numUnit :: Num Unit
243+
244+ foreign import numAdd :: Number -> Number -> Number
245+
246+ foreign import numMul :: Number -> Number -> Number
247+
248+ foreign import numDiv :: Number -> Number -> Number
249+
250+ foreign import numSub :: Number -> Number -> Number
251+
252+ infix 4 ==
253+ infix 4 /=
254+
255+ class Eq a where
256+ (==) :: a -> a -> Boolean
257+ (/=) :: a -> a -> Boolean
258+
259+ instance eqBoolean :: Eq Boolean where
260+ (==) = refEq
261+ (/=) = refIneq
262+
263+ instance eqNumber :: Eq Number where
264+ (==) = refEq
265+ (/=) = refIneq
266+
267+ instance eqInt :: Eq Int where
268+ (==) = refEq
269+ (/=) = refIneq
270+
271+ instance eqChar :: Eq Char where
272+ (==) = refEq
273+ (/=) = refIneq
274+
275+ instance eqString :: Eq String where
276+ (==) = refEq
277+ (/=) = refIneq
278+
279+ instance eqUnit :: Eq Unit where
280+ (==) _ _ = true
281+ (/=) _ _ = false
282+
283+ instance eqArray :: (Eq a) => Eq (Array a) where
284+ (==) = eqArrayImpl (==)
285+ (/=) xs ys = not (xs == ys)
286+
287+ instance eqOrdering :: Eq Ordering where
288+ (==) LT LT = true
289+ (==) GT GT = true
290+ (==) EQ EQ = true
291+ (==) _ _ = false
292+ (/=) x y = not (x == y)
293+
294+ foreign import refEq :: forall a. a -> a -> Boolean
295+
296+ foreign import refIneq :: forall a. a -> a -> Boolean
297+
298+ foreign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean
299+
300+ data Ordering = LT | GT | EQ
301+
302+ class (Eq a) <= Ord a where
303+ compare :: a -> a -> Ordering
304+
305+ instance ordBoolean :: Ord Boolean where
306+ compare false false = EQ
307+ compare false true = LT
308+ compare true true = EQ
309+ compare true false = GT
310+
311+ instance ordNumber :: Ord Number where
312+ compare = unsafeCompare
313+
314+ instance ordString :: Ord String where
315+ compare = unsafeCompare
316+
317+ instance ordUnit :: Ord Unit where
318+ compare _ _ = EQ
319+
320+ instance ordArray :: (Ord a) => Ord (Array a) where
321+ compare xs ys = compare 0.0 $ ordArrayImpl (\x y -> case compare x y of
322+ EQ -> 0.0
323+ LT -> -1.0
324+ GT -> 1.0) xs ys
325+
326+ foreign import ordArrayImpl :: forall a. (a -> a -> Number) -> Array a -> Array a -> Number
327+
328+ instance ordOrdering :: Ord Ordering where
329+ compare LT LT = EQ
330+ compare EQ EQ = EQ
331+ compare GT GT = EQ
332+ compare LT _ = LT
333+ compare EQ LT = GT
334+ compare EQ GT = LT
335+ compare GT _ = GT
336+
337+ infixl 4 <
338+ infixl 4 >
339+ infixl 4 <=
340+ infixl 4 >=
341+
342+ (<) :: forall a. (Ord a) => a -> a -> Boolean
343+ (<) a1 a2 = case a1 `compare` a2 of
344+ LT -> true
345+ _ -> false
346+
347+ (>) :: forall a. (Ord a) => a -> a -> Boolean
348+ (>) a1 a2 = case a1 `compare` a2 of
349+ GT -> true
350+ _ -> false
351+
352+ (<=) :: forall a. (Ord a) => a -> a -> Boolean
353+ (<=) a1 a2 = case a1 `compare` a2 of
354+ GT -> false
355+ _ -> true
356+
357+ (>=) :: forall a. (Ord a) => a -> a -> Boolean
358+ (>=) a1 a2 = case a1 `compare` a2 of
359+ LT -> false
360+ _ -> true
361+
362+ unsafeCompare :: forall a. a -> a -> Ordering
363+ unsafeCompare = unsafeCompareImpl LT EQ GT
364+
365+ foreign import unsafeCompareImpl :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering
366+
367+ class (Ord a) <= Bounded a where
368+ top :: a
369+ bottom :: a
370+
371+ instance boundedBoolean :: Bounded Boolean where
372+ top = true
373+ bottom = false
374+
375+ instance boundedUnit :: Bounded Unit where
376+ top = unit
377+ bottom = unit
378+
379+ instance boundedOrdering :: Bounded Ordering where
380+ top = GT
381+ bottom = LT
382+
383+ class (Ord a) <= Lattice a where
384+ sup :: a -> a -> a
385+ inf :: a -> a -> a
386+
387+ instance latticeBoolean :: Lattice Boolean where
388+ sup = boolOr
389+ inf = boolAnd
390+
391+ instance latticeUnit :: Lattice Unit where
392+ sup _ _ = unit
393+ inf _ _ = unit
394+
395+ infixr 2 ||
396+ infixr 3 &&
397+
398+ (||) :: forall a. (Lattice a) => a -> a -> a
399+ (||) = sup
400+
401+ (&&) :: forall a. (Lattice a) => a -> a -> a
402+ (&&) = inf
403+
404+ class (Bounded a, Lattice a) <= BoundedLattice a
405+
406+ instance boundedLatticeBoolean :: BoundedLattice Boolean
407+
408+ instance boundedLatticeUnit :: BoundedLattice Unit
409+
410+ class (BoundedLattice a) <= ComplementedLattice a where
411+ not :: a -> a
412+
413+ instance complementedLatticeBoolean :: ComplementedLattice Boolean where
414+ not = boolNot
415+
416+ instance complementedLatticeUnit :: ComplementedLattice Unit where
417+ not _ = unit
418+
419+ class (Lattice a) <= DistributiveLattice a
420+
421+ instance distributiveLatticeBoolean :: DistributiveLattice Boolean
422+
423+ instance distributiveLatticeUnit :: DistributiveLattice Unit
424+
425+ class (ComplementedLattice a, DistributiveLattice a) <= BooleanAlgebra a
426+
427+ instance booleanAlgebraBoolean :: BooleanAlgebra Boolean
428+
429+ instance booleanAlgebraUnit :: BooleanAlgebra Unit
430+
431+ foreign import boolOr :: Boolean -> Boolean -> Boolean
432+
433+ foreign import boolAnd :: Boolean -> Boolean -> Boolean
434+
435+ foreign import boolNot :: Boolean -> Boolean
436+
437+ class Show a where
438+ show :: a -> String
439+
440+ instance showBoolean :: Show Boolean where
441+ show true = "true"
442+ show false = "false"
443+
444+ instance showNumber :: Show Number where
445+ show = showNumberImpl
446+
447+ instance showString :: Show String where
448+ show = showStringImpl
449+
450+ instance showUnit :: Show Unit where
451+ show _ = "unit"
452+
453+ instance showArray :: (Show a) => Show (Array a) where
454+ show = showArrayImpl show
455+
456+ instance showOrdering :: Show Ordering where
457+ show LT = "LT"
458+ show GT = "GT"
459+ show EQ = "EQ"
460+
461+ foreign import showNumberImpl :: Number -> String
462+
463+ foreign import showStringImpl :: String -> String
464+
465+ foreign import showArrayImpl :: forall a. (a -> String) -> Array a -> String
466+
467+module Data.Function where
468+
469+ on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
470+ on f g x y = g x `f` g y
471+
472+ foreign import data Fn0 :: * -> *
473+
474+ foreign import data Fn1 :: * -> * -> *
475+
476+ foreign import data Fn2 :: * -> * -> * -> *
477+
478+ foreign import data Fn3 :: * -> * -> * -> * -> *
479+
480+ foreign import data Fn4 :: * -> * -> * -> * -> * -> *
481+
482+ foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
483+
484+ foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
485+
486+ foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
487+
488+ foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
489+
490+ foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
491+
492+ foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
493+
494+ foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a
495+
496+ foreign import mkFn1 :: forall a b. (a -> b) -> Fn1 a b
497+
498+ foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c
499+
500+ foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d
501+
502+ foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e
503+
504+ foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f
505+
506+ foreign import mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g
507+
508+ foreign import mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h
509+
510+ foreign import mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i
511+
512+ foreign import mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j
513+
514+ foreign import mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k
515+
516+ foreign import runFn0 :: forall a. Fn0 a -> a
517+
518+ foreign import runFn1 :: forall a b. Fn1 a b -> a -> b
519+
520+ foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c
521+
522+ foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d
523+
524+ foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e
525+
526+ foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f
527+
528+ foreign import runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g
529+
530+ foreign import runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h
531+
532+ foreign import runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i
533+
534+ foreign import runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
535+
536+ foreign import runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
537+
538+module Assert where
539+
540+ import Control.Monad.Eff
541+
542+ foreign import data Assert :: !
543+
544+ foreign import error :: forall a. String -> a
545+
546+ foreign import assertPartial :: forall e a. (Unit -> a) -> Eff (assert :: Assert | e) Unit
547+
548+ assert :: forall e. Boolean -> Eff (assert :: Assert | e) Unit
549+ assert true = return unit
550+ assert false = error "Assertion failed!"
551+
552+module Prelude.Unsafe where
553+
554+ foreign import unsafeIndex :: forall a. Array a -> Number -> a
555+
556+module Control.Monad.Eff
557+ ( Eff()
558+ , Pure()
559+ , runPure
560+ , untilE, whileE
561+ ) where
562+
563+ foreign import data Eff :: # ! -> * -> *
564+
565+ foreign import returnE :: forall e a. a -> Eff e a
566+
567+ foreign import bindE :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
568+
569+ type Pure a = forall e. Eff e a
570+
571+ foreign import runPure :: forall a. Pure a -> a
572+
573+ instance functorEff :: Functor (Eff e) where
574+ (<$>) = liftA1
575+
576+ instance applyEff :: Apply (Eff e) where
577+ (<*>) = ap
578+
579+ instance applicativeEff :: Applicative (Eff e) where
580+ pure = returnE
581+
582+ instance bindEff :: Bind (Eff e) where
583+ (>>=) = bindE
584+
585+ instance monadEff :: Monad (Eff e)
586+
587+ foreign import untilE :: forall e. Eff e Boolean -> Eff e Unit
588+
589+ foreign import whileE :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit
590+
591+module Debug.Trace where
592+
593+ import Control.Monad.Eff
594+
595+ foreign import data Trace :: !
596+
597+ foreign import trace :: forall r. String -> Eff (trace :: Trace | r) Unit
598+
599+ print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
600+ print o = trace (show o)
601+
602+module Control.Monad.ST where
603+
604+ import Control.Monad.Eff
605+
606+ foreign import data ST :: * -> !
607+
608+ foreign import data STRef :: * -> * -> *
609+
610+ foreign import newSTRef :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)
611+
612+ foreign import readSTRef :: forall a h r. STRef h a -> Eff (st :: ST h | r) a
613+
614+ foreign import modifySTRef :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a
615+
616+ foreign import writeSTRef :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a
617+
618+ foreign import runST :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
619+
620+ pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a
621+ pureST st = runPure (runST st)
tests/prelude/js/Assert.jsnew file+19
@@ -0,0 +1,19 @@
1+/* global exports */
2+"use strict";
3+
4+// module Assert
5+
6+exports.error = function(msg) {
7+ throw msg;
8+};
9+
10+exports.assertPartial = function(f) {
11+ return function() {
12+ try {
13+ return f();
14+ } catch (e) {
15+ if (e instanceof Error) return;
16+ throw new Error('Pattern match failure is not Error');
17+ }
18+ };
19+};
tests/prelude/js/Control.Monad.Eff.jsnew file+40
@@ -0,0 +1,40 @@
1+/* global exports */
2+"use strict";
3+
4+// module Control.Monad.Eff
5+
6+exports.returnE = function (a) {
7+ return function () {
8+ return a;
9+ };
10+};
11+
12+exports.bindE = function (a) {
13+ return function (f) {
14+ return function () {
15+ return f(a())();
16+ };
17+ };
18+};
19+
20+exports.runPure = function (f) {
21+ return f();
22+};
23+
24+exports.untilE = function (f) {
25+ return function () {
26+ while (!f());
27+ return {};
28+ };
29+};
30+
31+exports.whileE = function (f) {
32+ return function (a) {
33+ return function () {
34+ while (f()) {
35+ a();
36+ }
37+ return {};
38+ };
39+ };
40+};
tests/prelude/js/Control.Monad.ST.jsnew file+38
@@ -0,0 +1,38 @@
1+/* global exports */
2+"use strict";
3+
4+// module Control.Monad.ST
5+
6+exports.newSTRef = function (val) {
7+ return function () {
8+ return { value: val };
9+ };
10+};
11+
12+exports.readSTRef = function (ref) {
13+ return function () {
14+ return ref.value;
15+ };
16+};
17+
18+exports.modifySTRef = function (ref) {
19+ return function (f) {
20+ return function () {
21+ /* jshint boss: true */
22+ return ref.value = f(ref.value);
23+ };
24+ };
25+};
26+
27+exports.writeSTRef = function (ref) {
28+ return function (a) {
29+ return function () {
30+ /* jshint boss: true */
31+ return ref.value = a;
32+ };
33+ };
34+};
35+
36+exports.runST = function (f) {
37+ return f;
38+};
tests/prelude/js/Data.Function.jsnew file+233
@@ -0,0 +1,233 @@
1+/* global exports */
2+"use strict";
3+
4+// module Data.Function
5+
6+exports.mkFn0 = function (fn) {
7+ return function () {
8+ return fn({});
9+ };
10+};
11+
12+exports.mkFn1 = function (fn) {
13+ return function (a) {
14+ return fn(a);
15+ };
16+};
17+
18+exports.mkFn2 = function (fn) {
19+ /* jshint maxparams: 2 */
20+ return function (a, b) {
21+ return fn(a)(b);
22+ };
23+};
24+
25+exports.mkFn3 = function (fn) {
26+ /* jshint maxparams: 3 */
27+ return function (a, b, c) {
28+ return fn(a)(b)(c);
29+ };
30+};
31+
32+exports.mkFn4 = function (fn) {
33+ /* jshint maxparams: 4 */
34+ return function (a, b, c, d) {
35+ return fn(a)(b)(c)(d);
36+ };
37+};
38+
39+exports.mkFn5 = function (fn) {
40+ /* jshint maxparams: 5 */
41+ return function (a, b, c, d, e) {
42+ return fn(a)(b)(c)(d)(e);
43+ };
44+};
45+
46+exports.mkFn6 = function (fn) {
47+ /* jshint maxparams: 6 */
48+ return function (a, b, c, d, e, f) {
49+ return fn(a)(b)(c)(d)(e)(f);
50+ };
51+};
52+
53+exports.mkFn7 = function (fn) {
54+ /* jshint maxparams: 7 */
55+ return function (a, b, c, d, e, f, g) {
56+ return fn(a)(b)(c)(d)(e)(f)(g);
57+ };
58+};
59+
60+exports.mkFn8 = function (fn) {
61+ /* jshint maxparams: 8 */
62+ return function (a, b, c, d, e, f, g, h) {
63+ return fn(a)(b)(c)(d)(e)(f)(g)(h);
64+ };
65+};
66+
67+exports.mkFn9 = function (fn) {
68+ /* jshint maxparams: 9 */
69+ return function (a, b, c, d, e, f, g, h, i) {
70+ return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);
71+ };
72+};
73+
74+exports.mkFn10 = function (fn) {
75+ /* jshint maxparams: 10 */
76+ return function (a, b, c, d, e, f, g, h, i, j) {
77+ return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);
78+ };
79+};
80+
81+exports.runFn0 = function (fn) {
82+ return fn();
83+};
84+
85+exports.runFn1 = function (fn) {
86+ return function (a) {
87+ return fn(a);
88+ };
89+};
90+
91+exports.runFn2 = function (fn) {
92+ return function (a) {
93+ return function (b) {
94+ return fn(a, b);
95+ };
96+ };
97+};
98+
99+exports.runFn3 = function (fn) {
100+ return function (a) {
101+ return function (b) {
102+ return function (c) {
103+ return fn(a, b, c);
104+ };
105+ };
106+ };
107+};
108+
109+exports.runFn4 = function (fn) {
110+ return function (a) {
111+ return function (b) {
112+ return function (c) {
113+ return function (d) {
114+ return fn(a, b, c, d);
115+ };
116+ };
117+ };
118+ };
119+};
120+
121+exports.runFn5 = function (fn) {
122+ return function (a) {
123+ return function (b) {
124+ return function (c) {
125+ return function (d) {
126+ return function (e) {
127+ return fn(a, b, c, d, e);
128+ };
129+ };
130+ };
131+ };
132+ };
133+};
134+
135+exports.runFn6 = function (fn) {
136+ return function (a) {
137+ return function (b) {
138+ return function (c) {
139+ return function (d) {
140+ return function (e) {
141+ return function (f) {
142+ return fn(a, b, c, d, e, f);
143+ };
144+ };
145+ };
146+ };
147+ };
148+ };
149+};
150+
151+exports.runFn7 = function (fn) {
152+ return function (a) {
153+ return function (b) {
154+ return function (c) {
155+ return function (d) {
156+ return function (e) {
157+ return function (f) {
158+ return function (g) {
159+ return fn(a, b, c, d, e, f, g);
160+ };
161+ };
162+ };
163+ };
164+ };
165+ };
166+ };
167+};
168+
169+exports.runFn8 = function (fn) {
170+ return function (a) {
171+ return function (b) {
172+ return function (c) {
173+ return function (d) {
174+ return function (e) {
175+ return function (f) {
176+ return function (g) {
177+ return function (h) {
178+ return fn(a, b, c, d, e, f, g, h);
179+ };
180+ };
181+ };
182+ };
183+ };
184+ };
185+ };
186+ };
187+};
188+
189+exports.runFn9 = function (fn) {
190+ return function (a) {
191+ return function (b) {
192+ return function (c) {
193+ return function (d) {
194+ return function (e) {
195+ return function (f) {
196+ return function (g) {
197+ return function (h) {
198+ return function (i) {
199+ return fn(a, b, c, d, e, f, g, h, i);
200+ };
201+ };
202+ };
203+ };
204+ };
205+ };
206+ };
207+ };
208+ };
209+};
210+
211+exports.runFn10 = function (fn) {
212+ return function (a) {
213+ return function (b) {
214+ return function (c) {
215+ return function (d) {
216+ return function (e) {
217+ return function (f) {
218+ return function (g) {
219+ return function (h) {
220+ return function (i) {
221+ return function (j) {
222+ return fn(a, b, c, d, e, f, g, h, i, j);
223+ };
224+ };
225+ };
226+ };
227+ };
228+ };
229+ };
230+ };
231+ };
232+ };
233+};
tests/prelude/js/Debug.Trace.jsnew file+11
@@ -0,0 +1,11 @@
1+/* global exports */
2+"use strict";
3+
4+// module Debug.Trace
5+
6+exports.trace = function(s) {
7+ return function() {
8+ console.log(s);
9+ return {};
10+ };
11+};
tests/prelude/js/Prelude.Unsafe.jsnew file+10
@@ -0,0 +1,10 @@
1+/* global exports */
2+"use strict";
3+
4+// module Prelude.Unsafe
5+
6+exports.unsafeIndex = function(xs) {
7+ return function(n) {
8+ return xs[n];
9+ };
10+};
tests/prelude/js/Prelude.jsnew file+150
@@ -0,0 +1,150 @@
1+/* global exports */
2+"use strict";
3+
4+// module Prelude
5+
6+exports.cons = function(e) {
7+ return function(l) {
8+ return [e].concat(l);
9+ };
10+};
11+
12+exports.concat = function(l1) {
13+ return function(l2) {
14+ return l1.concat(l2);
15+ };
16+};
17+
18+exports.length = function(a) {
19+ return a.length;
20+};
21+
22+exports.concatString = function(s1) {
23+ return function(s2) {
24+ return s1 + s2;
25+ };
26+};
27+
28+exports.numAdd = function (n1) {
29+ return function (n2) {
30+ return n1 + n2;
31+ };
32+};
33+
34+exports.numMul = function (n1) {
35+ return function (n2) {
36+ return n1 * n2;
37+ };
38+};
39+
40+exports.numDiv = function (n1) {
41+ return function (n2) {
42+ return n1 / n2;
43+ };
44+};
45+
46+exports.numSub = function (n1) {
47+ return function (n2) {
48+ return n1 - n2;
49+ };
50+};
51+
52+exports.jsMod = function(x) {
53+ return function (y) {
54+ return x % y;
55+ };
56+};
57+
58+exports.refEq = function(r1) {
59+ return function(r2) {
60+ return r1 === r2;
61+ };
62+};
63+
64+exports.refIneq = function(r1) {
65+ return function(r2) {
66+ return r1 !== r2;
67+ };
68+};
69+
70+exports.eqArrayImpl = function(f) {
71+ return function(xs) {
72+ return function(ys) {
73+ if (xs.length !== ys.length) return false;
74+ for (var i = 0; i < xs.length; i++) {
75+ if (!f(xs[i])(ys[i])) return false;
76+ }
77+ return true;
78+ };
79+ };
80+};
81+
82+exports.ordArrayImpl = function(f) {
83+ return function (ys) {
84+ return function (ys) {
85+ var i = 0;
86+ while (i < xs.length && i < ys.length) {
87+ var x = xs[i];
88+ var y = ys[i];
89+ var o = f(x)(y);
90+ if (o !== 0) {
91+ return o;
92+ }
93+ }
94+ if (xs.length == ys.length) {
95+ return 0;
96+ } else if (xs.length > ys.length) {
97+ return 1;
98+ } else {
99+ return -1;
100+ }
101+ };
102+ };
103+};
104+
105+exports.unsafeCompareImpl = function(lt) {
106+ return function(eq) {
107+ return function(gt) {
108+ return function(x) {
109+ return function(y) {
110+ return x < y ? lt : x > y ? gt : eq;
111+ };
112+ };
113+ };
114+ };
115+};
116+
117+exports.boolOr = function (b1) {
118+ return function (b2) {
119+ return b1 || b2;
120+ };
121+};
122+
123+exports.boolAnd = function (b1) {
124+ return function (b2) {
125+ return b1 && b2;
126+ };
127+};
128+
129+exports.boolNot = function (b) {
130+ return !b;
131+};
132+
133+exports.showNumberImpl = function (n) {
134+ /* jshint bitwise: false */
135+ return n === (n | 0) ? n + ".0" : n.toString();
136+};
137+
138+exports.showStringImpl = function (s) {
139+ return JSON.stringify(s);
140+};
141+
142+exports.showArrayImpl = function (f) {
143+ return function (xs) {
144+ var ss = [];
145+ for (var i = 0, l = xs.length; i < l; i++) {
146+ ss[i] = f(xs[i]);
147+ }
148+ return "[" + ss.join(",") + "]";
149+ };
150+};