git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

.gitignore+1

compare with golang

unifiedsplit

@@ -9,4 +9,5 @@ cabal.sandbox.config

9*.lksh*

9*.lksh*

10.virthualenv

10.virthualenv

11.psci_modules/

11.psci_modules/

12+bower_components/

12tmp/

13tmp/

examples/failing/365.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class C a where

5class C a where

4 f :: a -> a

6 f :: a -> a

5 g :: a -> a

7 g :: a -> a

examples/failing/438.purs+4−2

@@ -1,9 +1,11 @@

1module Main where

1module Main where

2−

2+

3+import Prelude

4+

3data Fix f = In (f (Fix f))

5data Fix f = In (f (Fix f))

4

6

5instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where

7instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where

6 (==) (In f) (In g) = f == g

8 (==) (In f) (In g) = f == g

7 (/=) a b = not (a == b)

9 (/=) a b = not (a == b)

8−

10+

9example = In [] == In []

11example = In [] == In []

examples/failing/ArrayType.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Debug.Trace

4import Debug.Trace

4

5

5bar :: Number -> Number -> Number

6bar :: Number -> Number -> Number

examples/failing/Arrays.purs+2−2

@@ -1,5 +1,5 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− test = \arr -> arr !! (0 !! 0)

5+test = \arr -> arr !! (0 !! 0)

examples/failing/Do.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3test1 = do let x = 1

5test1 = do let x = 1

4

6

5test2 y = do x <- y

7test2 y = do x <- y

examples/failing/DuplicateDeclarationsInLet.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3foo = a

5foo = a

4 where

6 where

5 a :: Number

7 a :: Number

examples/failing/DuplicateProperties1.purs+4−2

@@ -1,9 +1,11 @@

1module DuplicateProperties where

1module DuplicateProperties where

2

2

3+import Prelude

4+

3foreign import data Test :: # * -> *

5foreign import data Test :: # * -> *

4

6

5−foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r

7+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r

6

8

7−foreign import hasX "" :: Test (x :: Unit, y :: Unit)

9+foreign import hasX :: Test (x :: Unit, y :: Unit)

8

10

9baz = subtractX (subtractX hasX)

11baz = subtractX (subtractX hasX)

examples/failing/DuplicateProperties2.purs+4−2

@@ -1,9 +1,11 @@

1module DuplicateProperties where

1module DuplicateProperties where

2

2

3+import Prelude

4+

3foreign import data Test :: # * -> *

5foreign import data Test :: # * -> *

4

6

5−foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r

7+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r

6

8

7−foreign import hasX "" :: forall r. Test (x :: Unit, y :: Unit | r)

9+foreign import hasX :: forall r. Test (x :: Unit, y :: Unit | r)

8

10

9baz = subtractX (subtractX hasX)

11baz = subtractX (subtractX hasX)

examples/failing/DuplicateTypeVars.purs+2

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type Foo a a = a

5type Foo a a = a

examples/failing/Foldable.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Foldable f where

5class Foldable f where

4 fold :: forall a b. (a -> b -> b) -> b -> f a -> b

6 fold :: forall a b. (a -> b -> b) -> b -> f a -> b

5 size :: forall a. f a -> Number

7 size :: forall a. f a -> Number

examples/failing/InstanceExport.purs+2

@@ -1,5 +1,7 @@

1module InstanceExport (S(..), f) where

1module InstanceExport (S(..), f) where

2

2

3+import Prelude

4+

3newtype S = S String

5newtype S = S String

4

6

5class F a where

7class F a where

examples/failing/KindError.purs+3−1

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3− data KindError f a = One f | Two (f a)

5+data KindError f a = One f | Two (f a)

examples/failing/LeadingZeros1.purs+3−1

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3−x = 01

5+x = 01

examples/failing/LeadingZeros2.purs+3−1

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3−x = 00.1

5+x = 00.1

examples/failing/Let.purs+2

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3test = let x = x in x

5test = let x = x in x

examples/failing/MPTCs.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Foo a where

5class Foo a where

4 f :: a -> a

6 f :: a -> a

5

7

examples/failing/MissingClassExport.purs+4−2

@@ -1,4 +1,6 @@

1module Test (bar) where

1module Test (bar) where

2

2

3+import Prelude

4+

3− class Foo a where

5+class Foo a where

4− bar :: a -> a

6+ bar :: a -> a

examples/failing/MissingClassMemberExport.purs+4−2

@@ -1,4 +1,6 @@

1module Test (Foo) where

1module Test (Foo) where

2

2

3+import Prelude

4+

3− class Foo a where

5+class Foo a where

4− bar :: a -> a

6+ bar :: a -> a

examples/failing/MultipleErrors.purs+2

@@ -1,5 +1,7 @@

1module MultipleErrors where

1module MultipleErrors where

2

2

3+import Prelude

4+

3foo :: Number -> Number

5foo :: Number -> Number

4foo 0 = "Test"

6foo 0 = "Test"

5foo n = bar (n - 1)

7foo n = bar (n - 1)

examples/failing/MultipleErrors2.purs+2

@@ -1,5 +1,7 @@

1module MultipleErrors2 where

1module MultipleErrors2 where

2

2

3+import Prelude

4+

3foo = itDoesntExist

5foo = itDoesntExist

4

6

5bar = neitherDoesThis

7bar = neitherDoesThis

examples/failing/MutRec.purs+2

@@ -1,5 +1,7 @@

1module MutRec where

1module MutRec where

2

2

3+import Prelude

4+

3x = y

5x = y

4

6

5y = x

7y = x

examples/failing/MutRec2.purs+2

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3x = x

5x = x

examples/failing/NewtypeMultiArgs.purs+2

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3newtype Thing = Thing String Boolean

5newtype Thing = Thing String Boolean

examples/failing/NewtypeMultiCtor.purs+2

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3newtype Thing = Thing String | Other

5newtype Thing = Thing String | Other

examples/failing/NoOverlap.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Foo = Foo

5data Foo = Foo

4

6

5instance showFoo1 :: Show Foo where

7instance showFoo1 :: Show Foo where

examples/failing/NullaryAbs.purs+3−1

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3− func = \ -> "no"

5+func = \ -> "no"

examples/failing/Object.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3test o = o.foo

5test o = o.foo

4

6

5test1 = test {}

7test1 = test {}

examples/failing/OverlappingArguments.purs+2

@@ -1,3 +1,5 @@

1module OverlappingArguments where

1module OverlappingArguments where

2

2

3+import Prelude

4+

3f x x = x

5f x x = x

examples/failing/OverlappingBinders.purs+2

@@ -1,5 +1,7 @@

1module OverlappingBinders where

1module OverlappingBinders where

2

2

3+import Prelude

4+

3data S a = S a (S a)

5data S a = S a (S a)

4

6

5f x = case x of

7f x = case x of

examples/failing/OverlappingInstances.purs+2

@@ -1,5 +1,7 @@

1module OverlappingInstances where

1module OverlappingInstances where

2

2

3+import Prelude

4+

3data A = A

5data A = A

4

6

5instance showA1 :: Show A where

7instance showA1 :: Show A where

examples/failing/OverlappingInstances2.purs+2

@@ -1,5 +1,7 @@

1module OverlappingInstances where

1module OverlappingInstances where

2

2

3+import Prelude

4+

3data A = A | B

5data A = A | B

4

6

5instance eqA1 :: Eq A where

7instance eqA1 :: Eq A where

examples/failing/OverlappingVars.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class OverlappingVars a where

5class OverlappingVars a where

4 f :: a -> a

6 f :: a -> a

5

7

examples/failing/Rank2Types.purs+3−3

@@ -1,7 +1,7 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− foreign import test :: (forall a. a -> a) -> Number

5+foreign import test :: (forall a. a -> a) -> Number

6

6

7− test1 = test (\n -> n + 1)

7+test1 = test (\n -> n + 1)

examples/failing/Reserved.purs+2

@@ -1,4 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3(<) :: Number -> Number -> Number

5(<) :: Number -> Number -> Number

4(<) a b = !(a >= b)

6(<) a b = !(a >= b)

examples/failing/RowConstructors1.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Foo = Bar

5data Foo = Bar

4type Baz = { | Foo }

6type Baz = { | Foo }

5

7

examples/failing/RowConstructors2.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type Foo r = (x :: Number | r)

5type Foo r = (x :: Number | r)

4type Bar = { | Foo }

6type Bar = { | Foo }

5

7

examples/failing/RowConstructors3.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type Foo = { x :: Number }

5type Foo = { x :: Number }

4type Bar = { | Foo }

6type Bar = { | Foo }

5

7

examples/failing/SkolemEscape.purs+4−2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3− foreign import foo :: (forall a. a -> a) -> Number

3+import Prelude

4

4

5+foreign import foo :: (forall a. a -> a) -> Number

6+

5− test = \x -> foo x

7+test = \x -> foo x

examples/failing/Superclasses1.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Su a where

5class Su a where

4 su :: a -> a

6 su :: a -> a

5

7

examples/failing/Superclasses2.purs+2

@@ -1,5 +1,7 @@

1module CycleInSuperclasses where

1module CycleInSuperclasses where

2

2

3+import Prelude

4+

3class (Foo a) <= Bar a

5class (Foo a) <= Bar a

4

6

5class (Bar a) <= Foo a

7class (Bar a) <= Foo a

examples/failing/Superclasses3.purs+2

@@ -1,5 +1,7 @@

1module UnknownSuperclassTypeVar where

1module UnknownSuperclassTypeVar where

2

2

3+import Prelude

4+

3class Foo a

5class Foo a

4

6

5class (Foo b) <= Bar a

7class (Foo b) <= Bar a

examples/failing/Superclasses4.purs+2

@@ -1,5 +1,7 @@

1module OverlappingInstances where

1module OverlappingInstances where

2

2

3+import Prelude

4+

3class Foo a

5class Foo a

4

6

5instance foo1 :: Foo Number

7instance foo1 :: Foo Number

examples/failing/TopLevelCaseNoArgs.purs+6−3

@@ -1,4 +1,7 @@

1module Main where

1module Main where

2+

3+import Prelude

4+

2− foo :: Number

5+foo :: Number

3− foo = 1

6+foo = 1

4− foo = 2

7+foo = 2

examples/failing/TypeClassInstances.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class A a where

5class A a where

4 a :: a -> String

6 a :: a -> String

5 b :: a -> Number

7 b :: a -> Number

examples/failing/TypeError.purs+2−2

@@ -1,5 +1,5 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− test = 1 ++ "A"

5+test = 1 ++ "A"

examples/failing/TypeSynonyms.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type T1 = Array T2

5type T1 = Array T2

4

6

5type T2 = T1

7type T2 = T1

examples/failing/TypeSynonyms2.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Foo a where

5class Foo a where

4 foo :: a -> String

6 foo :: a -> String

5

7

examples/failing/TypeSynonyms3.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Foo a where

5class Foo a where

4 foo :: a -> String

6 foo :: a -> String

5

7

examples/failing/TypeSynonyms4.purs+2

@@ -1,5 +1,7 @@

1module TypeSynonyms4 where

1module TypeSynonyms4 where

2

2

3+import Prelude

4+

3type F x y = x -> y

5type F x y = x -> y

4

6

5type G x = F x

7type G x = F x

examples/failing/TypeSynonyms5.purs+2

@@ -1,3 +1,5 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type T = T

5type T = T

examples/failing/TypeWildcards1.purs+2

@@ -1,4 +1,6 @@

1module TypeWildcards where

1module TypeWildcards where

2

2

3+import Prelude

4+

3type Test = _

5type Test = _

4

6

examples/failing/TypeWildcards2.purs+2

@@ -1,4 +1,6 @@

1module TypeWildcards where

1module TypeWildcards where

2

2

3+import Prelude

4+

3data Test = Test _

5data Test = Test _

4

6

examples/failing/TypeWildcards3.purs+2

@@ -1,5 +1,7 @@

1module TypeWildcards where

1module TypeWildcards where

2

2

3+import Prelude

4+

3data Foo a = Foo

5data Foo a = Foo

4

6

5instance showFoo :: Show (Foo _) where

7instance showFoo :: Show (Foo _) where

examples/failing/UnderscoreModuleName.purs+2

@@ -1,3 +1,5 @@

1module Bad_Module where

1module Bad_Module where

2

2

3+import Prelude

4+

3main = Debug.Trace.trace "Done"

5main = Debug.Trace.trace "Done"

examples/failing/UnifyInTypeInstanceLookup.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Z = Z

5data Z = Z

4data S n = S n

6data S n = S n

5

7

examples/failing/UnknownType.purs+2

@@ -1,4 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3test :: Number -> Something

5test :: Number -> Something

4test = {}

6test = {}

examples/manual/QualifiedNames.purs+2

@@ -1,5 +1,7 @@

1module Data.Either where

1module Data.Either where

2

2

3+import Prelude

4+

3data Either a b = Left a | Right b

5data Either a b = Left a | Right b

4

6

5module Main where

7module Main where

examples/manual/failing/ArgLengthMismatch.purs+4−2

@@ -1,4 +1,6 @@

1module ArgLengthMismatch where

1module ArgLengthMismatch where

2

2

3+import Prelude

4+

3− f x y = true

5+f x y = true

4− f = false

6+f = false

examples/manual/failing/ExportExplicit.purs+4−2

@@ -1,5 +1,7 @@

1-- should fail as z does not exist in the module

1-- should fail as z does not exist in the module

2module M1 (x, y, z) where

2module M1 (x, y, z) where

3

3

4+import Prelude

5+

4− x = 1

6+x = 1

5− y = 2

7+y = 2

examples/manual/failing/ExportExplicit2.purs+4−2

@@ -1,5 +1,7 @@

1-- should fail as Y is not a data constructor for X

1-- should fail as Y is not a data constructor for X

2module M1 (X(Y)) where

2module M1 (X(Y)) where

3

3

4+import Prelude

5+

4− data X = X

6+data X = X

5− data Y = Y

7+data Y = Y

examples/manual/failing/OrphanTypeDecl.purs+1−1

@@ -1,3 +1,3 @@

1module OrphanTypeDecl where

1module OrphanTypeDecl where

2

2

3− fn :: Number -> Boolean

3+fn :: Number -> Boolean

examples/manual/failing/RedefinedFixity.purs+5−3

@@ -1,6 +1,8 @@

1module RedefinedFixity where

1module RedefinedFixity where

2

2

3− (!?) x y = x + y

3+import Prelude

4

4

5+(!?) x y = x + y

6+

5− infix 2 !?

7+infix 2 !?

6− infix 2 !?

8+infix 2 !?

examples/manual/failing/RequiredHiddenType.purs+4−4

@@ -1,8 +1,8 @@

1-- exporting `a` should fail as `A` is hidden

1-- exporting `a` should fail as `A` is hidden

2module Foo (B(..), a, b) where

2module Foo (B(..), a, b) where

3

3

4− data A = A

4+data A = A

5− data B = B

5+data B = B

6

6

7− a = A

7+a = A

8− b = B

8+b = B

examples/manual/passing/ExportedInstanceDeclarations.purs+2

@@ -8,6 +8,8 @@ module ExportedInstanceDeclarations

8 , foo

8 , foo

9 ) where

9 ) where

10

10

11+import Prelude

12+

11data Const a b = Const a

13data Const a b = Const a

12

14

13class Foo a where

15class Foo a where

examples/manual/passing/TransitiveImport.purs+3

@@ -1,5 +1,7 @@

1module Test where

1module Test where

2

2

3+ import Prelude

4+

3 class TestCls a where

5 class TestCls a where

4 test :: a -> a

6 test :: a -> a

5

7

@@ -12,6 +14,7 @@ module Middle where

12

14

13module Main where

15module Main where

14

16

17+ import Prelude

15 import Middle

18 import Middle

16 import Debug.Trace

19 import Debug.Trace

17

20

examples/passing/652.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Foo a b

5class Foo a b

4

6

5class Bar a c

7class Bar a c

examples/passing/810.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Maybe a = Nothing | Just a

5data Maybe a = Nothing | Just a

4

6

5test :: forall a. Maybe a -> Maybe a

7test :: forall a. Maybe a -> Maybe a

examples/passing/ArrayType.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Pointed p where

5class Pointed p where

4 point :: forall a. a -> p a

6 point :: forall a. a -> p a

5

7

examples/passing/Auto.purs+9−7

@@ -1,13 +1,15 @@

1module Main where

1module Main where

2

2

3− data Auto s i o = Auto { state :: s, step :: s -> i -> o }

3+import Prelude

4

4

5− type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r

5+data Auto s i o = Auto { state :: s, step :: s -> i -> o }

6

6

7− exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o

7+type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r

8− exists = \state step f -> f (Auto { state: state, step: step })

9

8

10− run :: forall i o. SomeAuto i o -> i -> o

9+exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o

11− run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)

10+exists = \state step f -> f (Auto { state: state, step: step })

12

11

12+run :: forall i o. SomeAuto i o -> i -> o

13+run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)

14+

13− main = Debug.Trace.trace "Done"

15+main = Debug.Trace.trace "Done"

examples/passing/AutoPrelude.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Debug.Trace

4import Debug.Trace

4

5

5f x = x * 10.0

6f x = x * 10.0

examples/passing/AutoPrelude2.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import qualified Prelude as P

4import qualified Prelude as P

4import Debug.Trace

5import Debug.Trace

5

6

examples/passing/BindersInFunctions.purs+1−7

@@ -1,16 +1,10 @@

1module Main where

1module Main where

2

2

3import Prelude

3import Prelude

4+import Assert

4

5

5snd = \[_, y] -> y

6snd = \[_, y] -> y

6

7

7−foreign import error

8− """

9− function error(msg) {

10− throw msg;

11− }

12− """ :: forall a. String -> a

13−

14main =

8main =

15 let ts = snd [1.0, 2.0] in

9 let ts = snd [1.0, 2.0] in

16 if ts == 2.0

10 if ts == 2.0

examples/passing/BindingGroups.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3foo = bar

5foo = bar

4 where bar r = r + 1.0

6 where bar r = r + 1.0

5

7

examples/passing/BlockString.purs+3−7

@@ -1,12 +1,8 @@

1module Main where

1module Main where

2

2

3−foreign import foo """

3+import Prelude

4− function foo(s) {

5− return s;

6− }

7−""" :: String -> String

8

4

9−bar :: String -> String

5+foo :: String

10−bar _ = foo "test"

6+foo = """foo"""

11

7

12main = Debug.Trace.trace "Done"

8main = Debug.Trace.trace "Done"

examples/passing/CaseInDo.purs+5−6

@@ -1,20 +1,19 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Debug.Trace

4import Debug.Trace

4import Control.Monad.Eff

5import Control.Monad.Eff

5

6

6−foreign import doIt "function doIt() { global.flag = true; }" :: forall eff. Eff eff Unit

7+doIt :: forall eff. Eff eff Boolean

7−

8+doIt = return true

8−foreign import get "function get() { return global.flag; }" :: forall eff. Eff eff Boolean

9

9

10set = do

10set = do

11 trace "Testing..."

11 trace "Testing..."

12 case 0 of

12 case 0 of

13 0 -> doIt

13 0 -> doIt

14− _ -> return unit

14+ _ -> return false

15

15

16main = do

16main = do

17− set

17+ b <- set

18− b <- get

19 case b of

18 case b of

20 true -> trace "Done"

19 true -> trace "Done"

examples/passing/CaseStatement.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data A = A | B | C

5data A = A | B | C

4

6

5f a _ A = a

7f a _ A = a

examples/passing/CheckFunction.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0

5test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0

4

6

5main = Debug.Trace.trace "Done"

7main = Debug.Trace.trace "Done"

examples/passing/CheckSynonymBug.purs+4−11

@@ -1,16 +1,9 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− type Foo a = Array a

5+type Foo a = Array a

6

6

7− foreign import length

7+foo _ = length ([] :: Foo Number)

8− """

9− function length(a) {

10− return a.length;

11− }

12− """ :: forall a. Array a -> Number

13

8

14− foo _ = length ([] :: Foo Number)

15−

16− main = Debug.Trace.trace "Done"

9+main = Debug.Trace.trace "Done"

examples/passing/CheckTypeClass.purs+11−9

@@ -1,16 +1,18 @@

1module Main where

1module Main where

2

2

3− data Bar a = Bar

3+import Prelude

4− data Baz

5

4

6− class Foo a where

5+data Bar a = Bar

7− foo :: Bar a -> Baz

6+data Baz

8

7

9− foo_ :: forall a. (Foo a) => a -> Baz

8+class Foo a where

10− foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)

9+ foo :: Bar a -> Baz

11

10

12− mkBar :: forall a. a -> Bar a

11+foo_ :: forall a. (Foo a) => a -> Baz

13− mkBar _ = Bar

12+foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)

14

13

14+mkBar :: forall a. a -> Bar a

15+mkBar _ = Bar

16+

15− main = Debug.Trace.trace "Done"

17+main = Debug.Trace.trace "Done"

16

18

examples/passing/Church.purs+10−10

@@ -1,18 +1,18 @@

1module Main where

1module Main where

2

2

3− import Prelude ()

3+import Prelude ()

4

4

5− type List a = forall r. r -> (a -> r -> r) -> r

5+type List a = forall r. r -> (a -> r -> r) -> r

6

6

7− empty :: forall a. List a

7+empty :: forall a. List a

8− empty = \r f -> r

8+empty = \r f -> r

9

9

10− cons :: forall a. a -> List a -> List a

10+cons :: forall a. a -> List a -> List a

11− cons = \a l r f -> f a (l r f)

11+cons = \a l r f -> f a (l r f)

12

12

13− append :: forall a. List a -> List a -> List a

13+append :: forall a. List a -> List a -> List a

14− append = \l1 l2 r f -> l2 (l1 r f) f

14+append = \l1 l2 r f -> l2 (l1 r f) f

15

15

16− test = append (cons 1 empty) (cons 2 empty)

16+test = append (cons 1 empty) (cons 2 empty)

17

17

18− main = Debug.Trace.trace "Done"

18+main = Debug.Trace.trace "Done"

examples/passing/Collatz.purs+1−12

@@ -1,20 +1,9 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4import Control.Monad.ST

5import Control.Monad.ST

5

6

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

7collatz :: Number -> Number

19collatz n = runPure (runST (do

8collatz n = runPure (runST (do

20 r <- newSTRef n

9 r <- newSTRef n

examples/passing/Comparisons.purs+2−12

@@ -1,19 +1,9 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4import Debug.Trace

5import Debug.Trace

5−

6+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

7

18main = do

8main = do

19 assert (1.0 < 2.0)

9 assert (1.0 < 2.0)

examples/passing/Conditional.purs+4−4

@@ -1,9 +1,9 @@

1module Main where

1module Main where

2

2

3− import Prelude ()

3+import Prelude ()

4

4

5− fns = \f -> if f true then f else \x -> x

5+fns = \f -> if f true then f else \x -> x

6

6

7− not = \x -> if x then false else true

7+not = \x -> if x then false else true

8

8

9− main = Debug.Trace.trace "Done"

9+main = Debug.Trace.trace "Done"

examples/passing/DataAndType.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data A = A B

5data A = A B

4

6

5type B = A

7type B = A

examples/passing/DeepArrayBinder.purs+3−8

@@ -1,6 +1,8 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

5+import Assert

4

6

5data List a = Cons a (List a) | Nil

7data List a = Cons a (List a) | Nil

6

8

@@ -8,13 +10,6 @@ match2 :: List Number -> Number

8match2 (Cons x (Cons y xs)) = x * y + match2 xs

10match2 (Cons x (Cons y xs)) = x * y + match2 xs

9match2 _ = 0.0

11match2 _ = 0.0

10

12

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

13main = 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"

14 100.0 -> Debug.Trace.trace "Done"

20− _ -> explode

15+ _ -> error "Incorrect result!"

examples/passing/DeepCase.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Debug.Trace

4import Debug.Trace

4import Control.Monad.Eff

5import Control.Monad.Eff

5import Control.Monad.ST

6import Control.Monad.ST

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/EmptyRow.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Foo r = Foo { | r }

5data Foo r = Foo { | r }

4

6

5test :: Foo ()

7test :: Foo ()

examples/passing/EqOrd.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Pair a b = Pair a b

5data Pair a b = Pair a b

4

6

5instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where

7instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where

examples/passing/ExtendedInfixOperators.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering

5comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering

4comparing f = compare `Data.Function.on` f

6comparing f = compare `Data.Function.on` f

5

7

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+9−15

@@ -1,19 +1,13 @@

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

18− then Debug.Trace.trace "Done"

12+ then Debug.Trace.trace "Done"

19− else error "Not done"

13+ else error "Not done"

examples/passing/Functions.purs+7−7

@@ -1,15 +1,15 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− test1 = \_ -> 0.0

5+test1 = \_ -> 0.0

6

6

7− test2 = \a b -> a + b + 1.0

7+test2 = \a b -> a + b + 1.0

8

8

9− test3 = \a -> a

9+test3 = \a -> a

10

10

11− test4 = \(%%) -> 1.0 %% 2.0

11+test4 = \(%%) -> 1.0 %% 2.0

12

12

13− test5 = \(+++) (***) -> 1.0 +++ 2.0 *** 3.0

13+test5 = \(+++) (***) -> 1.0 +++ 2.0 *** 3.0

14

14

15− main = Debug.Trace.trace "Done"

15+main = Debug.Trace.trace "Done"

examples/passing/Functions2.purs+9−15

@@ -1,19 +1,13 @@

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"

18− then Debug.Trace.trace "Done"

12+ then Debug.Trace.trace "Done"

19− else error "Not done"

13+ else error "Not done"

examples/passing/Guards.purs+1−11

@@ -1,16 +1,6 @@

1module Main where

1module Main where

2

2

3−foreign import jsMod

3+import Prelude

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

4

15collatz = \x -> case x of

5collatz = \x -> case x of

16 y | y % 2.0 == 0.0 -> y / 2.0

6 y | y % 2.0 == 0.0 -> y / 2.0

examples/passing/HoistError.purs+3−10

@@ -1,19 +1,12 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4import Debug.Trace

5import Debug.Trace

5−

6−foreign import f

6+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

7

15main = do

8main = do

16 let x = 0.0

9 let x = 0.0

17− f x

10+ assert $ x == 0.0

18 let x = 1.0 + 1.0

11 let x = 1.0 + 1.0

19 trace "Done"

12 trace "Done"

examples/passing/IfThenElseMaybe.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Maybe a = Nothing | Just a

5data Maybe a = Nothing | Just a

4

6

5test1 = if true then Just 10 else Nothing

7test1 = if true then Just 10 else Nothing

examples/passing/ImplicitEmptyImport.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3main = do

5main = do

4 Debug.Trace.trace "Hello"

6 Debug.Trace.trace "Hello"

5 Debug.Trace.trace "Goodbye"

7 Debug.Trace.trace "Goodbye"

examples/passing/InstanceBeforeClass.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3instance fooNumber :: Foo Number where

5instance fooNumber :: Foo Number where

4 foo = 0.0

6 foo = 0.0

5

7

examples/passing/IntAndChar.purs+6−13

@@ -1,6 +1,8 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

5+import Assert

4

6

5f 1 = 1

7f 1 = 1

6f _ = 0

8f _ = 0

@@ -8,18 +10,9 @@ f _ = 0

8g 'a' = 'a'

10g 'a' = 'a'

9g _ = 'b'

11g _ = 'b'

10

12

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

13main = do

21− assertEqual (f 1) 1

14+ assert $ f 1 == 1

22− assertEqual (f 0) 0

15+ assert $ f 0 == 0

23− assertEqual (g 'a') 'a'

16+ assert $ g 'a' == 'a'

24− assertEqual (g 'b') 'b'

17+ assert $ g 'b' == 'b'

25 Debug.Trace.trace "Done"

18 Debug.Trace.trace "Done"

examples/passing/JSReserved.purs+6−6

@@ -1,12 +1,12 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− yield = 0

5+yield = 0

6− member = 1

6+member = 1

7

7

8− public = \return -> return

8+public = \return -> return

9

9

10− this catch = catch

10+this catch = catch

11

11

12− main = Debug.Trace.trace "Done"

12+main = Debug.Trace.trace "Done"

examples/passing/KindedType.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type Star2Star f = f :: * -> *

5type Star2Star f = f :: * -> *

4

6

5type Star t = t :: *

7type Star t = t :: *

examples/passing/Let2.purs+3−1

@@ -1,6 +1,8 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3−test =

5+test =

4 let f :: Number -> Boolean

6 let f :: Number -> Boolean

5 f 0.0 = false

7 f 0.0 = false

6 f n = g (n - 1.0)

8 f n = g (n - 1.0)

examples/passing/LetInInstance.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Foo a where

5class Foo a where

4 foo :: a -> String

6 foo :: a -> String

5

7

examples/passing/LiberalTypeSynonyms.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type Reader = (->) String

5type Reader = (->) String

4

6

5foo :: Reader String

7foo :: Reader String

examples/passing/Match.purs+5−3

@@ -1,7 +1,9 @@

1module Main where

1module Main where

2

2

3− data Foo a = Foo

3+import Prelude

4

4

5− foo = \f -> case f of Foo -> "foo"

5+data Foo a = Foo

6

6

7+foo = \f -> case f of Foo -> "foo"

8+

7− main = Debug.Trace.trace "Done"

9+main = Debug.Trace.trace "Done"

examples/passing/Monad.purs+21−21

@@ -1,32 +1,32 @@

1module Main where

1module Main where

2

2

3− import Prelude ()

3+import Prelude ()

4

4

5− type Monad m = { return :: forall a. a -> m a

5+type Monad m = { return :: forall a. a -> m a

6− , bind :: forall a b. m a -> (a -> m b) -> m b }

6+ , bind :: forall a b. m a -> (a -> m b) -> m b }

7

7

8− data Id a = Id a

8+data Id a = Id a

9

9

10− id :: Monad Id

10+id :: Monad Id

11− id = { return : Id

11+id = { return : Id

12− , bind : \ma f -> case ma of Id a -> f a }

12+ , bind : \ma f -> case ma of Id a -> f a }

13

13

14− data Maybe a = Nothing | Just a

14+data Maybe a = Nothing | Just a

15

15

16− maybe :: Monad Maybe

16+maybe :: Monad Maybe

17− maybe = { return : Just

17+maybe = { return : Just

18− , bind : \ma f -> case ma of

18+ , bind : \ma f -> case ma of

19− Nothing -> Nothing

19+ Nothing -> Nothing

20− Just a -> f a

20+ Just a -> f a

21− }

21+ }

22

22

23− test :: forall m. Monad m -> m Number

23+test :: forall m. Monad m -> m Number

24− test = \m -> m.bind (m.return 1.0) (\n1 ->

24+test = \m -> m.bind (m.return 1.0) (\n1 ->

25− m.bind (m.return "Test") (\n2 ->

25+ m.bind (m.return "Test") (\n2 ->

26− m.return n1))

26+ m.return n1))

27

27

28− test1 = test id

28+test1 = test id

29

29

30− test2 = test maybe

30+test2 = test maybe

31

31

32− main = Debug.Trace.trace "Done"

32+main = Debug.Trace.trace "Done"

examples/passing/MultiArgFunctions.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Data.Function

4import Data.Function

4import Control.Monad.Eff

5import Control.Monad.Eff

5import Debug.Trace

6import Debug.Trace

examples/passing/MutRec.purs+10−10

@@ -1,19 +1,19 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− f 0.0 = 0.0

5+f 0.0 = 0.0

6− f x = g x + 0.0

6+f x = g x + 0.0

7

7

8− g x = f (x / 0.0)

8+g x = f (x / 0.0)

9

9

10− data Even = Zero | Even Odd

10+data Even = Zero | Even Odd

11

11

12− data Odd = Odd Even

12+data Odd = Odd Even

13

13

14− evenToNumber Zero = 0.0

14+evenToNumber Zero = 0.0

15− evenToNumber (Even n) = oddToNumber n + 0.0

15+evenToNumber (Even n) = oddToNumber n + 0.0

16

16

17− oddToNumber (Odd n) = evenToNumber n + 0.0

17+oddToNumber (Odd n) = evenToNumber n + 0.0

18

18

19− main = Debug.Trace.trace "Done"

19+main = Debug.Trace.trace "Done"

examples/passing/MutRec2.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data A = A B

5data A = A B

4

6

5data B = B A

7data B = B A

examples/passing/MutRec3.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data A = A B

5data A = A B

4

6

5data B = B A

7data B = B A

examples/passing/NamedPatterns.purs+6−4

@@ -1,7 +1,9 @@

1module Main where

1module Main where

2

2

3− foo = \x -> case x of

3+import Prelude

4− y@{ foo = "Foo" } -> y

5− y -> y

6

4

5+foo = \x -> case x of

6+ y@{ foo = "Foo" } -> y

7+ y -> y

8+

7− main = Debug.Trace.trace "Done"

9+main = Debug.Trace.trace "Done"

examples/passing/NegativeBinder.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3test :: Number -> Boolean

5test :: Number -> Boolean

4test -1.0 = false

6test -1.0 = false

5test _ = true

7test _ = true

examples/passing/Nested.purs+5−3

@@ -1,7 +1,9 @@

1module Main where

1module Main where

2

2

3− data Extend r a = Extend { prev :: r a, next :: a }

3+import Prelude

4

4

5− data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)

5+data Extend r a = Extend { prev :: r a, next :: a }

6

6

7+data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)

8+

7− main = Debug.Trace.trace "Done"

9+main = Debug.Trace.trace "Done"

examples/passing/NestedTypeSynonyms.purs+6−6

@@ -1,11 +1,11 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− type X = String

5+type X = String

6− type Y = X -> X

6+type Y = X -> X

7

7

8− fn :: Y

8+fn :: Y

9− fn a = a

9+fn a = a

10

10

11− main = Debug.Trace.print (fn "Done")

11+main = Debug.Trace.print (fn "Done")

examples/passing/NestedWhere.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3f x = g x

5f x = g x

4 where

6 where

5 g x = go x

7 g x = go x

examples/passing/Newtype.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4import Debug.Trace

5import Debug.Trace

5

6

examples/passing/NewtypeEff.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Debug.Trace

4import Debug.Trace

4import Control.Monad.Eff

5import Control.Monad.Eff

5

6

examples/passing/NewtypeWithRecordUpdate.purs+2−1

@@ -2,12 +2,13 @@

2

2

3module Main where

3module Main where

4

4

5+import Prelude

5import Debug.Trace

6import Debug.Trace

6

7

7newtype NewType a = NewType (Object a)

8newtype NewType a = NewType (Object a)

8

9

9rec1 :: Object (a :: Number, b :: Number, c:: Number)

10rec1 :: Object (a :: Number, b :: Number, c:: Number)

10−rec1 = { a: 0.0, b: 0.0, c: 0.0 }

11+rec1 = { a: 0.0, b: 0.0, c: 0.0 }

11

12

12rec2 :: NewType (a :: Number, b :: Number, c :: Number)

13rec2 :: NewType (a :: Number, b :: Number, c :: Number)

13rec2 = NewType (rec1 { a = 1.0 })

14rec2 = NewType (rec1 { a = 1.0 })

examples/passing/ObjectGetter.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3getX = _.x

5getX = _.x

4

6

5point = { x: 1.0, y: 0.0 }

7point = { x: 1.0, y: 0.0 }

examples/passing/ObjectSynonym.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type Inner = Number

5type Inner = Number

4

6

5inner :: Inner

7inner :: Inner

examples/passing/ObjectUpdate.purs+13−11

@@ -1,18 +1,20 @@

1module Main where

1module Main where

2

2

3− update1 = \o -> o { foo = "Foo" }

3+import Prelude

4

4

5− update2 :: forall r. { foo :: String | r } -> { foo :: String | r }

6− update2 = \o -> o { foo = "Foo" }

5+update1 = \o -> o { foo = "Foo" }

7

6

8− replace = \o -> case o of

7+update2 :: forall r. { foo :: String | r } -> { foo :: String | r }

9− { foo = "Foo" } -> o { foo = "Bar" }

8+update2 = \o -> o { foo = "Foo" }

10− { foo = "Bar" } -> o { bar = "Baz" }

11− o -> o

12

9

13− polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }

10+replace = \o -> case o of

14− polyUpdate = \o -> o { foo = "Foo" }

11+ { foo = "Foo" } -> o { foo = "Bar" }

12+ { foo = "Bar" } -> o { bar = "Baz" }

13+ o -> o

15

14

16− inferPolyUpdate = \o -> o { foo = "Foo" }

15+polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }

16+polyUpdate = \o -> o { foo = "Foo" }

17

17

18+inferPolyUpdate = \o -> o { foo = "Foo" }

19+

18− main = Debug.Trace.trace ((update1 {foo: ""}).foo)

20+main = Debug.Trace.trace ((update1 {foo: ""}).foo)

examples/passing/ObjectUpdate2.purs+4−1

@@ -1,8 +1,11 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type X r = { | r }

5type X r = { | r }

4

6

5−foreign import x "var x = {};" :: forall r. X r

7+x :: X (baz :: String)

8+x = { baz: "baz" }

6

9

7blah :: forall r. X r -> X r

10blah :: forall r. X r -> X r

8blah x = x

11blah x = x

examples/passing/ObjectUpdater.purs+6−17

@@ -1,20 +1,9 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4import Debug.Trace

5import Debug.Trace

5−

6+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

7

19getValue :: forall e. Eff (| e) Boolean

8getValue :: forall e. Eff (| e) Boolean

20getValue = return true

9getValue = return true

@@ -22,14 +11,14 @@ getValue = return true

22main = do

11main = do

23 let record = { value: false }

12 let record = { value: false }

24 record' <- record { value = _ } <$> getValue

13 record' <- record { value = _ } <$> getValue

25− print $ record'.value === true

14+ assert $ record'.value == true

26

15

27 let point = { x: 1.0, y: 1.0 }

16 let point = { x: 1.0, y: 1.0 }

28 x = 10.0

17 x = 10.0

29 point' = (point { x = _, y = x }) 100.0

18 point' = (point { x = _, y = x }) 100.0

30

19

31− print $ point'.x === 100.0

20+ assert $ point'.x == 100.0

32− print $ point'.y === 10.0

21+ assert $ point'.y == 10.0

33

22

34 let record2 = (_ { x = _ }) { x: 0.0 } 10.0

23 let record2 = (_ { x = _ }) { x: 0.0 } 10.0

35− print $ record2.x === 10.0

24+ assert $ record2.x == 10.0

examples/passing/ObjectWildcards.purs+4−15

@@ -1,31 +1,20 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4import Debug.Trace

5import Debug.Trace

6+import Assert

5

7

6mkRecord = { foo: _, bar: _, baz: "baz" }

8mkRecord = { foo: _, bar: _, baz: "baz" }

7

9

8getValue :: forall e. Eff (| e) Boolean

10getValue :: forall e. Eff (| e) Boolean

9getValue = return true

11getValue = return true

10

12

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

13main = do

25 obj <- { value: _ } <$> getValue

14 obj <- { value: _ } <$> getValue

26 print obj.value

15 print obj.value

27 let x = 1.0

16 let x = 1.0

28 point <- { x: _, y: x } <$> return 2.0

17 point <- { x: _, y: x } <$> return 2.0

29− print $ point.x === 2.0

18+ assert $ point.x == 2.0

30− print $ point.y === 1.0

19+ assert $ point.y == 1.0

31 trace (mkRecord 1.0 "Done!").bar

20 trace (mkRecord 1.0 "Done!").bar

examples/passing/Objects.purs+20−20

@@ -1,35 +1,35 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− test = \x -> x.foo + x.bar + 1.0

5+test = \x -> x.foo + x.bar + 1.0

6

6

7− append = \o -> { foo: o.foo, bar: 1.0 }

7+append = \o -> { foo: o.foo, bar: 1.0 }

8

8

9− apTest = append({foo : "Foo", baz: "Baz"})

9+apTest = append({foo : "Foo", baz: "Baz"})

10

10

11− f = (\a -> a.b.c) { b: { c: 1.0, d: "Hello" }, e: "World" }

11+f = (\a -> a.b.c) { b: { c: 1.0, d: "Hello" }, e: "World" }

12

12

13− g = (\a -> a.f { x: 1.0, y: "y" }) { f: \o -> o.x + 1.0 }

13+g = (\a -> a.f { x: 1.0, y: "y" }) { f: \o -> o.x + 1.0 }

14

14

15− typed :: { foo :: Number }

15+typed :: { foo :: Number }

16− typed = { foo: 0.0 }

16+typed = { foo: 0.0 }

17

17

18− test2 = \x -> x."!@#"

18+test2 = \x -> x."!@#"

19

19

20− test3 = typed."foo"

20+test3 = typed."foo"

21

21

22− test4 = test2 weirdObj

22+test4 = test2 weirdObj

23− where

23+ where

24− weirdObj :: { "!@#" :: Number }

24+ weirdObj :: { "!@#" :: Number }

25− weirdObj = { "!@#": 1.0 }

25+ weirdObj = { "!@#": 1.0 }

26

26

27− test5 = case { "***": 1.0 } of

27+test5 = case { "***": 1.0 } of

28− { "***" = n } -> n

28+ { "***" = n } -> n

29

29

30− test6 = case { "***": 1.0 } of

30+test6 = case { "***": 1.0 } of

31− { "***": n } -> n

31+ { "***": n } -> n

32

32

33− test7 {a: snoog , b : blah } = blah

33+test7 {a: snoog , b : blah } = blah

34

34

35− main = Debug.Trace.trace "Done"

35+main = Debug.Trace.trace "Done"

examples/passing/OneConstructor.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data One a = One a

5data One a = One a

4

6

5one' (One a) = a

7one' (One a) = a

examples/passing/OperatorAssociativity.purs+16−41

@@ -1,50 +1,25 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4import Debug.Trace

5import Debug.Trace

5−

6+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

7

20bug :: Number -> Number -> Number

8bug :: Number -> Number -> Number

21bug a b = 0.0 - (a - b)

9bug a b = 0.0 - (a - b)

22

10

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

11main = do

31− assert (bug 0.0 2.0 == 2.0) "bug 0.0 2.0 == 2.0"

12+ 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"

13+ 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"

14+ 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"

15+ 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"

16+ assert ((6.0 / 3.0) * 2.0 == 4.0)

37−

38− assert (not (1.0 < 0.0) == true) "not (1.0 < 0.0) == true"

17+ assert (not (1.0 < 0.0) == true)

39− assert (not ((negate 1.0) < 0.0) == false) "not ((negate 1.0) < 0.0) == false"

18+ 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"

19+ 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"

20+ 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"

21+ 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"

22+ 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"

23+ 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"

24+ assert (10.0 * 5.0 - 1.0 == 49.0)

49−

50− trace "Success!"

25+ trace "Success!"

examples/passing/OperatorInlining.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Debug.Trace

4import Debug.Trace

4

5

5main = do

6main = do

examples/passing/OperatorSections.purs+6−16

@@ -1,21 +1,11 @@

1module Main where

1module Main where

2

2

3−foreign import eqeqeq

3+import Prelude

4− """

4+import Assert

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

5

16main = do

6main = do

17− Debug.Trace.print $ (/ 2.0) 4.0 === 2.0

7+ assert $ (/ 2.0) 4.0 == 2.0

18− Debug.Trace.print $ (2.0 /) 4.0 === 0.5

8+ assert $ (2.0 /) 4.0 == 0.5

19− Debug.Trace.print $ (`const` 1.0) 2.0 === 2.0

9+ assert $ (`const` 1.0) 2.0 == 2.0

20− Debug.Trace.print $ (1.0 `const`) 2.0 === 1.0

10+ assert $ (1.0 `const`) 2.0 == 1.0

21 Debug.Trace.trace "Done!"

11 Debug.Trace.trace "Done!"

examples/passing/Operators.purs+68−67

@@ -1,98 +1,99 @@

1module Main where

1module Main where

2

2

3+import Prelude

3− import Control.Monad.Eff

4+import Control.Monad.Eff

4− import Debug.Trace

5+import Debug.Trace

5

6

6− (?!) :: forall a. a -> a -> a

7+(?!) :: forall a. a -> a -> a

7− (?!) x _ = x

8+(?!) x _ = x

8

9

9− bar :: String -> String -> String

10+bar :: String -> String -> String

10− bar = \s1 s2 -> s1 ++ s2

11+bar = \s1 s2 -> s1 ++ s2

11

12

12− test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n

13+test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n

13− test1 x y z = x * y + z x y

14+test1 x y z = x * y + z x y

14

15

15− test2 = (\x -> x.foo false) { foo : \_ -> 1.0 }

16+test2 = (\x -> x.foo false) { foo : \_ -> 1.0 }

16

17

17− test3 = (\x y -> x)(1.0 + 2.0 * (1.0 + 2.0)) (true && (false || false))

18+test3 = (\x y -> x)(1.0 + 2.0 * (1.0 + 2.0)) (true && (false || false))

18

19

19− k = \x -> \y -> x

20+k = \x -> \y -> x

20

21

21− test4 = 1 `k` 2

22+test4 = 1 `k` 2

22

23

23− infixl 5 %%

24+infixl 5 %%

24

25

25− (%%) :: Number -> Number -> Number

26+(%%) :: Number -> Number -> Number

26− (%%) x y = x * y + y

27+(%%) x y = x * y + y

27

28

28− test5 = 1.0 %% 2.0 %% 3.0

29+test5 = 1.0 %% 2.0 %% 3.0

29

30

30− test6 = ((\x -> x) `k` 2.0) 3.0

31+test6 = ((\x -> x) `k` 2.0) 3.0

31

32

32− (<+>) :: String -> String -> String

33+(<+>) :: String -> String -> String

33− (<+>) = \s1 s2 -> s1 ++ s2

34+(<+>) = \s1 s2 -> s1 ++ s2

34

35

35− test7 = "Hello" <+> "World!"

36+test7 = "Hello" <+> "World!"

36

37

37− (@@) :: forall a b. (a -> b) -> a -> b

38+(@@) :: forall a b. (a -> b) -> a -> b

38− (@@) = \f x -> f x

39+(@@) = \f x -> f x

39

40

40− foo :: String -> String

41+foo :: String -> String

41− foo = \s -> s

42+foo = \s -> s

42

43

43− test8 = foo @@ "Hello World"

44+test8 = foo @@ "Hello World"

44

45

45− test9 = Main.foo @@ "Hello World"

46+test9 = Main.foo @@ "Hello World"

46

47

47− test10 = "Hello" `Main.bar` "World"

48+test10 = "Hello" `Main.bar` "World"

48

49

49− (...) :: forall a. Array a -> Array a -> Array a

50+(...) :: forall a. Array a -> Array a -> Array a

50− (...) = \as -> \bs -> as

51+(...) = \as -> \bs -> as

51

52

52− test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0]

53+test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0]

53

54

54− test12 (<%>) a b = a <%> b

55+test12 (<%>) a b = a <%> b

55

56

56− test13 = \(<%>) a b -> a <%> b

57+test13 = \(<%>) a b -> a <%> b

57

58

58− test14 :: Number -> Number -> Boolean

59+test14 :: Number -> Number -> Boolean

59− test14 a b = a < b

60+test14 a b = a < b

60

61

61− test15 :: Number -> Number -> Boolean

62+test15 :: Number -> Number -> Boolean

62− test15 a b = const false $ a `test14` b

63+test15 a b = const false $ a `test14` b

63

64

64− test17 :: Number

65+test17 :: Number

65− test17 = negate (-1.0)

66+test17 = negate (-1.0)

66

67

67− test18 :: Number

68+test18 :: Number

68− test18 = negate $ negate 1.0

69+test18 = negate $ negate 1.0

69

70

70− test19 :: Number

71+test19 :: Number

71− test19 = negate $ negate (-1.0)

72+test19 = negate $ negate (-1.0)

72

73

73− test20 :: Number

74+test20 :: Number

74− test20 = 1.0 @ 2.0

75+test20 = 1.0 @ 2.0

75− where

76+ where

76− (@) x y = x + y * y

77+ (@) x y = x + y * y

77

78

78− main = do

79+main = do

79− let t1 = test1 1.0 2.0 (\x y -> x + y)

80+ let t1 = test1 1.0 2.0 (\x y -> x + y)

80− let t2 = test2

81+ let t2 = test2

81− let t3 = test3

82+ let t3 = test3

82− let t4 = test4

83+ let t4 = test4

83− let t5 = test5

84+ let t5 = test5

84− let t6 = test6

85+ let t6 = test6

85− let t7 = test7

86+ let t7 = test7

86− let t8 = test8

87+ let t8 = test8

87− let t9 = test9

88+ let t9 = test9

88− let t10 = test10

89+ let t10 = test10

89− let t11 = test11

90+ let t11 = test11

90− let t12 = test12 k 1.0 2.0

91+ let t12 = test12 k 1.0 2.0

91− let t13 = test13 k 1.0 2.0

92+ let t13 = test13 k 1.0 2.0

92− let t14 = test14 1.0 2.0

93+ let t14 = test14 1.0 2.0

93− let t15 = test15 1.0 2.0

94+ let t15 = test15 1.0 2.0

94− let t17 = test17

95+ let t17 = test17

95− let t18 = test18

96+ let t18 = test18

96− let t19 = test19

97+ let t19 = test19

97− let t20 = test20

98+ let t20 = test20

98− trace "Done"

99+ trace "Done"

examples/passing/PartialFunction.purs+3−12

@@ -1,19 +1,10 @@

1module Main where

1module Main where

2

2

3−foreign import testError

3+import Prelude

4− """

4+import Assert

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

5

15fn :: Number -> Number

6fn :: Number -> Number

16fn 0.0 = 0.0

7fn 0.0 = 0.0

17fn 1.0 = 2.0

8fn 1.0 = 2.0

18

9

19−main = Debug.Trace.trace (show $ testError $ \_ -> fn 2.0)

10+main = assertPartial $ \_ -> fn 2.0

examples/passing/Patterns.purs+15−15

@@ -1,22 +1,22 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− test = \x -> case x of

5+test = \x -> case x of

6− { str = "Foo", bool = true } -> true

6+ { str = "Foo", bool = true } -> true

7− { str = "Bar", bool = b } -> b

7+ { str = "Bar", bool = b } -> b

8− _ -> false

8+ _ -> false

9

9

10− f = \o -> case o of

10+f = \o -> case o of

11− { foo = "Foo" } -> o.bar

11+ { foo = "Foo" } -> o.bar

12− _ -> 0

12+ _ -> 0

13

13

14− h = \o -> case o of

14+h = \o -> case o of

15− a@[_,_,_] -> a

15+ a@[_,_,_] -> a

16− _ -> []

16+ _ -> []

17

17

18− isDesc :: Array Number -> Boolean

18+isDesc :: Array Number -> Boolean

19− isDesc [x, y] | x > y = true

19+isDesc [x, y] | x > y = true

20− isDesc _ = false

20+isDesc _ = false

21

21

22− main = Debug.Trace.trace "Done"

22+main = Debug.Trace.trace "Done"

examples/passing/Person.purs+6−13

@@ -1,18 +1,11 @@

1module Main where

1module Main where

2

2

3− import Prelude ((++))

3+import Prelude

4

4

5− data Person = Person { name :: String, age :: Number }

5+data Person = Person { name :: String, age :: Number }

6

6

7− foreign import itoa

7+showPerson :: Person -> String

8− """

8+showPerson = \p -> case p of

9− function itoa(n) {

9+ Person o -> o.name ++ ", aged " ++ show o.age

10− return n.toString();

11− }

12− """ :: Number -> String

13

10

14− showPerson :: Person -> String

15− showPerson = \p -> case p of

16− Person o -> o.name ++ ", aged " ++ itoa(o.age)

17−

18− main = Debug.Trace.trace "Done"

11+main = Debug.Trace.trace "Done"

examples/passing/Rank2Data.purs+18−18

@@ -1,29 +1,29 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− data Id = Id forall a. a -> a

5+data Id = Id forall a. a -> a

6

6

7− runId = \id a -> case id of

7+runId = \id a -> case id of

8− Id f -> f a

8+ Id f -> f a

9

9

10− data Nat = Nat forall r. r -> (r -> r) -> r

10+data Nat = Nat forall r. r -> (r -> r) -> r

11

11

12− runNat = \nat -> case nat of

12+runNat = \nat -> case nat of

13− Nat f -> f 0.0 (\n -> n + 1.0)

13+ Nat f -> f 0.0 (\n -> n + 1.0)

14

14

15− zero' = Nat (\zero' _ -> zero')

15+zero' = Nat (\zero' _ -> zero')

16

16

17− succ = \n -> case n of

17+succ = \n -> case n of

18− Nat f -> Nat (\zero' succ -> succ (f zero' succ))

18+ Nat f -> Nat (\zero' succ -> succ (f zero' succ))

19

19

20− add = \n m -> case n of

20+add = \n m -> case n of

21− Nat f -> case m of

21+ Nat f -> case m of

22− Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)

22+ Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)

23

23

24− one' = succ zero'

24+one' = succ zero'

25− two = succ zero'

25+two = succ zero'

26− four = add two two

26+four = add two two

27− fourNumber = runNat four

27+fourNumber = runNat four

28

28

29− main = Debug.Trace.trace "Done'"

29+main = Debug.Trace.trace "Done'"

examples/passing/Rank2Object.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Debug.Trace

4import Debug.Trace

4

5

5data Foo = Foo { id :: forall a. a -> a }

6data Foo = Foo { id :: forall a. a -> a }

examples/passing/Rank2TypeSynonym.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4

5

5type Foo a = forall f. (Monad f) => f a

6type Foo a = forall f. (Monad f) => f a

examples/passing/Rank2Types.purs+6−6

@@ -1,11 +1,11 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− test1 :: (forall a. (a -> a)) -> Number

5+test1 :: (forall a. (a -> a)) -> Number

6− test1 = \f -> f 0.0

6+test1 = \f -> f 0.0

7

7

8− forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b

8+forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b

9− forever = \bind action -> bind action $ \_ -> forever bind action

9+forever = \bind action -> bind action $ \_ -> forever bind action

10

10

11− main = Debug.Trace.trace "Done"

11+main = Debug.Trace.trace "Done"

examples/passing/RebindableSyntax.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3example1 :: String

5example1 :: String

4example1 = do

6example1 = do

5 "Do"

7 "Do"

examples/passing/Recursion.purs+6−6

@@ -1,10 +1,10 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− fib = \n -> case n of

5+fib = \n -> case n of

6− 0.0 -> 1.0

6+ 0.0 -> 1.0

7− 1.0 -> 1.0

7+ 1.0 -> 1.0

8− n -> fib (n - 1.0) + fib (n - 2.0)

8+ n -> fib (n - 1.0) + fib (n - 2.0)

9

9

10− main = Debug.Trace.trace "Done"

10+main = Debug.Trace.trace "Done"

examples/passing/ReservedWords.purs+9−7

@@ -1,13 +1,15 @@

1-- See https://github.com/purescript/purescript/issues/606

1-- See https://github.com/purescript/purescript/issues/606

2module Main where

2module Main where

3

3

4− o :: { type :: String }

4+import Prelude

5− o = { type: "o" }

6

5

7− p :: { type :: String }

6+o :: { type :: String }

8− p = o { type = "p" }

7+o = { type: "o" }

9

8

10− f :: forall r. { type :: String | r } -> String

9+p :: { type :: String }

11− f { type = "p" } = "Done"

10+p = o { type = "p" }

12

11

12+f :: forall r. { type :: String | r } -> String

13+f { type = "p" } = "Done"

14+

13− main = Debug.Trace.trace $ f { type: p.type, foo: "bar" }

15+main = Debug.Trace.trace $ f { type: p.type, foo: "bar" }

examples/passing/RowConstructors.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type Foo = (x :: Number | (y :: Number | (z :: Number)))

5type Foo = (x :: Number | (y :: Number | (z :: Number)))

4type Bar = (x :: Number, y :: Number, z :: Number)

6type Bar = (x :: Number, y :: Number, z :: Number)

5type Baz = { w :: Number | Bar }

7type Baz = { w :: Number | Bar }

examples/passing/RowPolyInstanceContext.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class T s m where

5class T s m where

4 state :: (s -> s) -> m Unit

6 state :: (s -> s) -> m Unit

5

7

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/ScopedTypeVariables.purs+3−1

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3test1 :: forall a. (a -> a) -> a -> a

5test1 :: forall a. (a -> a) -> a -> a

4test1 f x = g (g x)

6test1 f x = g (g x)

5 where

7 where

@@ -15,7 +17,7 @@ test2 = h

15 g :: b -> b

17 g :: b -> b

16 g y = f (f y)

18 g y = f (f y)

17

19

18−test3 :: Number

20+test3 :: Number

19test3 = ((\b -> b :: b) :: forall b. b -> b) 0.0

21test3 = ((\b -> b :: b) :: forall b. b -> b) 0.0

20

22

21test4 :: forall a. (a -> a) -> a -> a

23test4 :: forall a. (a -> a) -> a -> a

examples/passing/Sequence.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4

5

5data List a = Cons a (List a) | Nil

6data List a = Cons a (List a) | Nil

examples/passing/SequenceDesugared.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4

5

5data List a = Cons a (List a) | Nil

6data List a = Cons a (List a) | Nil

examples/passing/ShadowedRename.purs+3−10

@@ -1,21 +1,14 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Control.Monad.Eff

4import Control.Monad.Eff

4import Debug.Trace

5import Debug.Trace

5−

6−foreign import f

6+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

7

15foo foo = let foo_1 = \_ -> foo

8foo foo = let foo_1 = \_ -> foo

16 foo_2 = foo_1 unit + 1.0

9 foo_2 = foo_1 unit + 1.0

17 in foo_2

10 in foo_2

18

11

19main = do

12main = do

20− f (foo 1.0)

13+ assert $ foo 1.0 == 2.0

21 trace "Done"

14 trace "Done"

examples/passing/ShadowedTCO.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3runNat f = f 0.0 (\n -> n + 1.0)

5runNat f = f 0.0 (\n -> n + 1.0)

4

6

5zero' z _ = z

7zero' z _ = z

examples/passing/ShadowedTCOLet.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3f x y z =

5f x y z =

4 let f 1.0 2.0 3.0 = 1.0

6 let f 1.0 2.0 3.0 = 1.0

5 in f x z y

7 in f x z y

examples/passing/SignedNumericLiterals.purs+12−10

@@ -1,15 +1,17 @@

1module Main where

1module Main where

2

2

3− p = 0.5

3+import Prelude

4− q = 1.0

5− x = -1.0

6− y = -0.5

7− z = 0.5

8− w = 1.0

9

4

10− f :: Number -> Number

5+p = 0.5

11− f x = -x

6+q = 1.0

7+x = -1.0

8+y = -0.5

9+z = 0.5

10+w = 1.0

12

11

13− test1 = 2.0 - 1.0

12+f :: Number -> Number

13+f x = -x

14

14

15+test1 = 2.0 - 1.0

16+

15− main = Debug.Trace.trace "Done"

17+main = Debug.Trace.trace "Done"

examples/passing/Superclasses1.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Su a where

5class Su a where

4 su :: a -> a

6 su :: a -> a

5

7

examples/passing/Superclasses2.purs+1

@@ -1,5 +1,6 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Prelude.Unsafe (unsafeIndex)

4import Prelude.Unsafe (unsafeIndex)

4

5

5class Su a where

6class Su a where

examples/passing/Superclasses3.purs+1−1

@@ -1,7 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

3import Debug.Trace

4import Debug.Trace

4−

5import Control.Monad.Eff

5import Control.Monad.Eff

6

6

7class (Monad m) <= MonadWriter w m where

7class (Monad m) <= MonadWriter w m where

examples/passing/TCOCase.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Data = One | More Data

5data Data = One | More Data

4

6

5main = Debug.Trace.trace (from (to 10000.0 One))

7main = Debug.Trace.trace (from (to 10000.0 One))

examples/passing/Tick.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3test' x = x

5test' x = x

4

6

5main = Debug.Trace.trace "Done"

7main = Debug.Trace.trace "Done"

examples/passing/TopLevelCase.purs+1−11

@@ -1,16 +1,6 @@

1module Main where

1module Main where

2

2

3−foreign import jsMod

3+import Prelude

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

4

15gcd :: Number -> Number -> Number

5gcd :: Number -> Number -> Number

16gcd 0.0 x = x

6gcd 0.0 x = 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

examples/passing/TypeClassMemberOrderChange.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class Test a where

5class Test a where

4 fn :: a -> a -> a

6 fn :: a -> a -> a

5 val :: a

7 val :: a

examples/passing/TypeClassesWithOverlappingTypeVariables.purs+6−6

@@ -1,11 +1,11 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− data Either a b = Left a | Right b

5+data Either a b = Left a | Right b

6

6

7− instance functorEither :: Prelude.Functor (Either a) where

7+instance functorEither :: Prelude.Functor (Either a) where

8− (<$>) _ (Left x) = Left x

8+ (<$>) _ (Left x) = Left x

9− (<$>) f (Right y) = Right (f y)

9+ (<$>) f (Right y) = Right (f y)

10

10

11− main = Debug.Trace.trace "Done"

11+main = Debug.Trace.trace "Done"

examples/passing/TypeDecl.purs+7−7

@@ -1,12 +1,12 @@

1module Main where

1module Main where

2

2

3− import Prelude

3+import Prelude

4

4

5− k :: String -> Number -> String

5+k :: String -> Number -> String

6− k x y = x

6+k x y = x

7

7

8− iterate :: forall a. Number -> (a -> a) -> a -> a

8+iterate :: forall a. Number -> (a -> a) -> a -> a

9− iterate 0.0 f a = a

9+iterate 0.0 f a = a

10− iterate n f a = iterate (n - 1.0) f (f a)

10+iterate n f a = iterate (n - 1.0) f (f a)

11

11

12− main = Debug.Trace.trace "Done"

12+main = Debug.Trace.trace "Done"

examples/passing/TypeSynonymInData.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3type A a = Array a

5type A a = Array a

4

6

5data Foo a = Foo (A a) | Bar

7data Foo a = Foo (A a) | Bar

examples/passing/TypeSynonyms.purs+20−18

@@ -1,25 +1,27 @@

1module Main where

1module Main where

2

2

3− type Lens a b =

3+import Prelude

4− { get :: a -> b

5− , set :: a -> b -> a

6− }

7

4

8− composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c

5+type Lens a b =

9− composeLenses = \l1 -> \l2 ->

10− { get: \a -> l2.get (l1.get a)

6+ { get :: a -> b

11− , set: \a c -> l1.set a (l2.set (l1.get a) c)

7+ , set :: a -> b -> a

12− }

8+ }

13

9

14− type Pair a b = { fst :: a, snd :: b }

10+composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c

11+composeLenses = \l1 -> \l2 ->

12+ { get: \a -> l2.get (l1.get a)

13+ , set: \a c -> l1.set a (l2.set (l1.get a) c)

14+ }

15

15

16− fst :: forall a b. Lens (Pair a b) a

17− fst =

18− { get: \p -> p.fst

19− , set: \p a -> { fst: a, snd: p.snd }

16+type Pair a b = { fst :: a, snd :: b }

20− }

21

17

22− test1 :: forall a b c. Lens (Pair (Pair a b) c) a

18+fst :: forall a b. Lens (Pair a b) a

23− test1 = composeLenses fst fst

19+fst =

20+ { get: \p -> p.fst

21+ , set: \p a -> { fst: a, snd: p.snd }

22+ }

24

23

24+test1 :: forall a b c. Lens (Pair (Pair a b) c) a

25+test1 = composeLenses fst fst

26+

25− main = Debug.Trace.trace "Done"

27+main = Debug.Trace.trace "Done"

examples/passing/TypeWildcards.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3testTopLevel :: _ -> _

5testTopLevel :: _ -> _

4testTopLevel n = n + 1.0

6testTopLevel n = n + 1.0

5

7

examples/passing/TypeWildcardsRecordExtension.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3foo :: forall a. {b :: Number | a} -> {b :: Number | _}

5foo :: forall a. {b :: Number | a} -> {b :: Number | _}

4foo f = f

6foo f = f

5

7

examples/passing/TypedWhere.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data E a b = L a | R b

5data E a b = L a | R b

4

6

5data L a = C a (L a) | N

7data L a = C a (L a) | N

examples/passing/UnderscoreIdent.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3data Data_type = Con_Structor | Con_2 String

5data Data_type = Con_Structor | Con_2 String

4

6

5type Type_name = Data_type

7type Type_name = Data_type

examples/passing/UnknownInTypeClassLookup.purs+2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3+import Prelude

4+

3class EQ a b

5class EQ a b

4

6

5instance eqAA :: EQ a a

7instance eqAA :: EQ a a

examples/passing/iota.purs+4−4

@@ -1,9 +1,9 @@

1module Main where

1module Main where

2

2

3− s = \x -> \y -> \z -> x z (y z)

3+s = \x -> \y -> \z -> x z (y z)

4

4

5− k = \x -> \y -> x

5+k = \x -> \y -> x

6

6

7− iota = \x -> x s k

7+iota = \x -> x s k

8

8

9− main = Debug.Trace.trace "Done"

9+main = Debug.Trace.trace "Done"

examples/passing/s.purs+4−2

@@ -1,5 +1,7 @@

1module Main where

1module Main where

2

2

3− s = \x y z -> x z (y z)

3+import Prelude

4

4

5+s = \x y z -> x z (y z)

6+

5− main = Debug.Trace.trace "Done"

7+main = Debug.Trace.trace "Done"

hierarchy/Main.hs+3−6

@@ -27,12 +27,9 @@ import System.FilePath ((</>))

27import System.Exit (exitFailure, exitSuccess)

27import System.Exit (exitFailure, exitSuccess)

28import System.IO (hPutStr, stderr)

28import System.IO (hPutStr, stderr)

29

29

30−import Text.Parsec as Par (ParseError)

31−

32import qualified Language.PureScript as P

30import qualified Language.PureScript as P

33import qualified Paths_purescript as Paths

31import qualified Paths_purescript as Paths

34

32

35−

36data HierarchyOptions = HierarchyOptions

33data HierarchyOptions = HierarchyOptions

37 { hierachyInput :: FilePath

34 { hierachyInput :: FilePath

38 , hierarchyOutput :: Maybe FilePath

35 , hierarchyOutput :: Maybe FilePath

@@ -53,16 +50,16 @@ instance Ord SuperMap where

53runModuleName :: P.ModuleName -> String

50runModuleName :: P.ModuleName -> String

54runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)

51runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)

55

52

56−readInput :: FilePath -> IO (Either Par.ParseError [P.Module])

53+readInput :: FilePath -> IO (Either P.MultipleErrors [P.Module])

57readInput filename = do

54readInput filename = do

58 content <- readFile filename

55 content <- readFile filename

59− return $ fmap (map snd) $ P.parseModulesFromFiles id [(filename, content)]

56+ return $ map snd <$> P.parseModulesFromFiles id [(filename, content)]

60

57

61compile :: HierarchyOptions -> IO ()

58compile :: HierarchyOptions -> IO ()

62compile (HierarchyOptions input mOutput) = do

59compile (HierarchyOptions input mOutput) = do

63 modules <- readInput input

60 modules <- readInput input

64 case modules of

61 case modules of

65− Left err -> hPutStr stderr (show err) >> exitFailure

62+ Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure

66 Right ms -> do

63 Right ms -> do

67 for_ ms $ \(P.Module _ moduleName decls _) ->

64 for_ ms $ \(P.Module _ moduleName decls _) ->

68 let name = runModuleName moduleName

65 let name = runModuleName moduleName

psc-docs/Main.hs−1

@@ -93,7 +93,6 @@ docgen (PSCDocsOptions fmt input output) =

93 let fp = fst (head grp)

93 let fp = fst (head grp)

94 createDirectoryIfMissing True (takeDirectory fp)

94 createDirectoryIfMissing True (takeDirectory fp)

95 writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)

95 writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)

96−

97 where

96 where

98 guardMissing [] = return ()

97 guardMissing [] = return ()

99 guardMissing [mn] = do

98 guardMissing [mn] = do

psc-docs/Tags.hs+1−1

@@ -11,7 +11,7 @@ tags = concatMap dtags . P.exportedDeclarations

11 names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames

11 names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames

12 where consNames = map (\(cname, _) -> P.runProperName cname) dcons

12 where consNames = map (\(cname, _) -> P.runProperName cname) dcons

13 names (P.TypeDeclaration ident _) = [show ident]

13 names (P.TypeDeclaration ident _) = [show ident]

14− names (P.ExternDeclaration _ ident _ _) = [show ident]

14+ names (P.ExternDeclaration ident _) = [show ident]

15 names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]

15 names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]

16 names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]

16 names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]

17 names (P.TypeInstanceDeclaration name _ _ _ _) = [show name]

17 names (P.TypeInstanceDeclaration name _ _ _ _) = [show name]

psc-make/Main.hs+46−66

@@ -12,103 +12,88 @@

12--

12--

13-----------------------------------------------------------------------------

13-----------------------------------------------------------------------------

14

14

15−{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}

15+{-# LANGUAGE DataKinds #-}

16+{-# LANGUAGE FlexibleContexts #-}

17+{-# LANGUAGE RecordWildCards #-}

18+{-# LANGUAGE TupleSections #-}

16

19

17module Main where

20module Main where

18

21

19import Control.Applicative

22import Control.Applicative

20import Control.Monad

23import Control.Monad

21import Control.Monad.Error.Class (MonadError(..))

24import Control.Monad.Error.Class (MonadError(..))

22−import Control.Monad.Trans.Except

23−import Control.Monad.Reader

24import Control.Monad.Writer

25import Control.Monad.Writer

25

26

26import Data.Version (showVersion)

27import Data.Version (showVersion)

27−import Data.Traversable (traverse)

28+import qualified Data.Map as M

28

29

29import Options.Applicative as Opts

30import Options.Applicative as Opts

30

31

31−import System.Directory

32− (doesFileExist, getModificationTime, createDirectoryIfMissing)

33−import System.FilePath (takeDirectory)

34import System.Exit (exitSuccess, exitFailure)

32import System.Exit (exitSuccess, exitFailure)

35−import System.IO.Error (tryIOError)

33+import System.IO (hPutStrLn, stderr)

36

34

37import qualified Language.PureScript as P

35import qualified Language.PureScript as P

38import qualified Paths_purescript as Paths

36import qualified Paths_purescript as Paths

39

37

38+import Make

40

39

41data PSCMakeOptions = PSCMakeOptions

40data PSCMakeOptions = PSCMakeOptions

42− { pscmInput :: [FilePath]

41+ { pscmInput :: [FilePath]

42+ , pscmForeignInput :: [FilePath]

43− , pscmOutputDir :: FilePath

43+ , pscmOutputDir :: FilePath

44− , pscmOpts :: P.Options P.Make

44+ , pscmOpts :: P.Options P.Make

45− , pscmUsePrefix :: Bool

45+ , pscmUsePrefix :: Bool

46 }

46 }

47

47

48data InputOptions = InputOptions

48data InputOptions = InputOptions

49− { ioNoPrelude :: Bool

50− , ioInputFiles :: [FilePath]

49+ { ioInputFiles :: [FilePath]

51 }

50 }

52

51

53−readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]

54−readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile

55−

56−newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }

57− deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader (P.Options P.Make))

58−

59−runMake :: P.Options P.Make -> Make a -> IO (Either P.MultipleErrors (a, P.MultipleErrors))

60−runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake

61−

62−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a

63−makeIO f io = do

64− e <- liftIO $ tryIOError io

65− either (throwError . P.singleError . f) return e

66−

67−instance P.MonadMake Make where

68− getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do

69− exists <- doesFileExist path

70− traverse (const $ getModificationTime path) $ guard exists

71− readTextFile path = do

72− verboseErrorsEnabled <- asks P.optionsVerboseErrors

73− makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ do

74− when verboseErrorsEnabled $ putStrLn $ "Reading " ++ path

75− readFile path

76− writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do

77− mkdirp path

78− putStrLn $ "Writing " ++ path

79− writeFile path text

80− progress = liftIO . putStrLn

81−

82compile :: PSCMakeOptions -> IO ()

52compile :: PSCMakeOptions -> IO ()

83−compile (PSCMakeOptions input outputDir opts usePrefix) = do

53+compile (PSCMakeOptions input inputForeign outputDir opts usePrefix) = do

84− modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)

54+ moduleFiles <- readInput (InputOptions input)

85− case modules of

55+ foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)

56+ case runWriterT (parseInputs moduleFiles foreignFiles) of

86− Left err -> do

57+ Left errs -> do

87− print err

58+ hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

88 exitFailure

59 exitFailure

89− Right ms -> do

60+ Right ((ms, foreigns), warnings) -> do

61+ when (P.nonEmpty warnings) $

62+ hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)

63+ let filePathMap = M.fromList $ map (\(fp, P.Module _ mn _ _) -> (mn, fp)) ms

64+ makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix

90− e <- runMake opts $ P.make outputDir ms prefix

65+ e <- runMake opts $ P.make makeActions ms

91 case e of

66 case e of

92 Left errs -> do

67 Left errs -> do

93 putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

68 putStrLn (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

94 exitFailure

69 exitFailure

95− Right (_, warnings) -> do

70+ Right (_, warnings') -> do

96− when (P.nonEmpty warnings) $

71+ when (P.nonEmpty warnings') $

97− putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)

72+ putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')

98 exitSuccess

73 exitSuccess

99− where

100− prefix = if usePrefix

101− then ["Generated by psc-make version " ++ showVersion Paths.version]

102− else []

103

74

104−mkdirp :: FilePath -> IO ()

75+readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]

105−mkdirp = createDirectoryIfMissing True . takeDirectory

76+readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile

77+

78+parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

79+ => [(Either P.RebuildPolicy FilePath, String)]

80+ -> [(FilePath, P.ForeignJS)]

81+ -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName (FilePath, P.ForeignJS))

82+parseInputs modules foreigns =

83+ (,) <$> P.parseModulesFromFiles (either (const "") id) modules

84+ <*> P.parseForeignModulesFromFiles foreigns

106

85

107inputFile :: Parser FilePath

86inputFile :: Parser FilePath

108inputFile = strArgument $

87inputFile = strArgument $

109 metavar "FILE"

88 metavar "FILE"

110 <> help "The input .purs file(s)"

89 <> help "The input .purs file(s)"

111

90

91+inputForeignFile :: Parser FilePath

92+inputForeignFile = strOption $

93+ short 'f'

94+ <> long "ffi"

95+ <> help "The input .js file(s) providing foreign import implementations"

96+

112outputDirectory :: Parser FilePath

97outputDirectory :: Parser FilePath

113outputDirectory = strOption $

98outputDirectory = strOption $

114 short 'o'

99 short 'o'

@@ -122,11 +107,6 @@ noTco = switch $

122 long "no-tco"

107 long "no-tco"

123 <> help "Disable tail call optimizations"

108 <> help "Disable tail call optimizations"

124

109

125−noPrelude :: Parser Bool

126−noPrelude = switch $

127− long "no-prelude"

128− <> help "Omit the automatic Prelude import"

129−

130noMagicDo :: Parser Bool

110noMagicDo :: Parser Bool

131noMagicDo = switch $

111noMagicDo = switch $

132 long "no-magic-do"

112 long "no-magic-do"

@@ -157,8 +137,7 @@ noPrefix = switch $

157

137

158

138

159options :: Parser (P.Options P.Make)

139options :: Parser (P.Options P.Make)

160−options = P.Options <$> noPrelude

140+options = P.Options <$> noTco

161− <*> noTco

162 <*> noMagicDo

141 <*> noMagicDo

163 <*> pure Nothing

142 <*> pure Nothing

164 <*> noOpts

143 <*> noOpts

@@ -168,6 +147,7 @@ options = P.Options <$> noPrelude

168

147

169pscMakeOptions :: Parser PSCMakeOptions

148pscMakeOptions :: Parser PSCMakeOptions

170pscMakeOptions = PSCMakeOptions <$> many inputFile

149pscMakeOptions = PSCMakeOptions <$> many inputFile

150+ <*> many inputForeignFile

171 <*> outputDirectory

151 <*> outputDirectory

172 <*> options

152 <*> options

173 <*> (not <$> noPrefix)

153 <*> (not <$> noPrefix)

psc-make/Make.hsnew file+138

@@ -0,0 +1,138 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Make

4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors

5+-- License : MIT

6+--

7+-- Maintainer : Phil Freeman <paf31@cantab.net>

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+--

13+-----------------------------------------------------------------------------

14+

15+{-# LANGUAGE DataKinds #-}

16+{-# LANGUAGE FlexibleContexts #-}

17+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

18+{-# LANGUAGE TupleSections #-}

19+

20+module Make

21+ ( Make(..)

22+ , runMake

23+ , buildMakeActions

24+ ) where

25+

26+import Control.Applicative

27+import Control.Monad

28+import Control.Monad.Error.Class (MonadError(..))

29+import Control.Monad.Trans.Except

30+import Control.Monad.Reader

31+import Control.Monad.Writer

32+

33+import Data.Maybe (fromMaybe)

34+import Data.Time.Clock

35+import Data.Traversable (traverse)

36+import Data.Version (showVersion)

37+import qualified Data.Map as M

38+

39+import System.Directory

40+ (doesFileExist, getModificationTime, createDirectoryIfMissing)

41+import System.FilePath ((</>), takeDirectory)

42+import System.IO.Error (tryIOError)

43+

44+import qualified Language.PureScript as P

45+import qualified Language.PureScript.CodeGen.JS as J

46+import qualified Language.PureScript.CoreFn as CF

47+import qualified Paths_purescript as Paths

48+

49+newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }

50+ deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader (P.Options P.Make))

51+

52+runMake :: P.Options P.Make -> Make a -> IO (Either P.MultipleErrors (a, P.MultipleErrors))

53+runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake

54+

55+makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a

56+makeIO f io = do

57+ e <- liftIO $ tryIOError io

58+ either (throwError . P.singleError . f) return e

59+

60+-- Traverse (Either e) instance (base 4.7)

61+traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)

62+traverseEither _ (Left x) = pure (Left x)

63+traverseEither f (Right y) = Right <$> f y

64+

65+buildMakeActions :: FilePath

66+ -> M.Map P.ModuleName (Either P.RebuildPolicy String)

67+ -> M.Map P.ModuleName (FilePath, P.ForeignJS)

68+ -> Bool

69+ -> P.MakeActions Make

70+buildMakeActions outputDir filePathMap foreigns usePrefix =

71+ P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress

72+ where

73+

74+ getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))

75+ getInputTimestamp mn = do

76+ let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap

77+ traverseEither getTimestamp path

78+

79+ getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)

80+ getOutputTimestamp mn = do

81+ let filePath = P.runModuleName mn

82+ jsFile = outputDir </> filePath </> "index.js"

83+ externsFile = outputDir </> filePath </> "externs.purs"

84+ min <$> getTimestamp jsFile <*> getTimestamp externsFile

85+

86+ readExterns :: P.ModuleName -> Make (FilePath, String)

87+ readExterns mn = do

88+ let path = outputDir </> P.runModuleName mn </> "externs.purs"

89+ (path, ) <$> readTextFile path

90+

91+ codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()

92+ codegen m _ nextVar exts = do

93+ let mn = CF.moduleName m

94+ foreignInclude <- case mn `M.lookup` foreigns of

95+ Just (path, _)

96+ | not $ requiresForeign m -> do

97+ tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path

98+ return Nothing

99+ | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]

100+ Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn

101+ | otherwise -> return Nothing

102+ pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude

103+ let filePath = P.runModuleName mn

104+ jsFile = outputDir </> filePath </> "index.js"

105+ externsFile = outputDir </> filePath </> "externs.purs"

106+ foreignFile = outputDir </> filePath </> "foreign.js"

107+ prefix = ["Generated by psc-make version " ++ showVersion Paths.version | usePrefix]

108+ js = unlines $ map ("// " ++) prefix ++ [pjs]

109+ writeTextFile jsFile js

110+ maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns

111+ writeTextFile externsFile exts

112+

113+ requiresForeign :: CF.Module a -> Bool

114+ requiresForeign = not . null . CF.moduleForeign

115+

116+ getTimestamp :: FilePath -> Make (Maybe UTCTime)

117+ getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do

118+ exists <- doesFileExist path

119+ traverse (const $ getModificationTime path) $ guard exists

120+

121+ readTextFile :: FilePath -> Make String

122+ readTextFile path = do

123+ verboseErrorsEnabled <- asks P.optionsVerboseErrors

124+ makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ do

125+ when verboseErrorsEnabled $ putStrLn $ "Reading " ++ path

126+ readFile path

127+

128+ writeTextFile :: FilePath -> String -> Make ()

129+ writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do

130+ mkdirp path

131+ putStrLn $ "Writing " ++ path

132+ writeFile path text

133+ where

134+ mkdirp :: FilePath -> IO ()

135+ mkdirp = createDirectoryIfMissing True . takeDirectory

136+

137+ progress :: String -> Make ()

138+ progress = liftIO . putStrLn

psc/Main.hs+46−33

@@ -12,12 +12,17 @@

12--

12--

13-----------------------------------------------------------------------------

13-----------------------------------------------------------------------------

14

14

15−{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}

15+{-# LANGUAGE DataKinds #-}

16+{-# LANGUAGE FlexibleContexts #-}

17+{-# LANGUAGE RecordWildCards #-}

18+{-# LANGUAGE ScopedTypeVariables #-}

19+{-# LANGUAGE TupleSections #-}

16

20

17module Main where

21module Main where

18

22

19import Control.Applicative

23import Control.Applicative

20import Control.Monad

24import Control.Monad

25+import Control.Monad.Error.Class (MonadError(..))

21import Control.Monad.Reader

26import Control.Monad.Reader

22import Control.Monad.Writer

27import Control.Monad.Writer

23

28

@@ -25,27 +30,29 @@ import Data.Maybe (fromMaybe)

25import Data.Version (showVersion)

30import Data.Version (showVersion)

26

31

27import Options.Applicative as Opts

32import Options.Applicative as Opts

33+

28import System.Directory (createDirectoryIfMissing)

34import System.Directory (createDirectoryIfMissing)

29−import System.FilePath (takeDirectory)

30import System.Exit (exitSuccess, exitFailure)

35import System.Exit (exitSuccess, exitFailure)

36+import System.FilePath (takeDirectory)

31import System.IO (hPutStrLn, stderr)

37import System.IO (hPutStrLn, stderr)

32

38

39+import qualified Data.Map as M

33import qualified Language.PureScript as P

40import qualified Language.PureScript as P

34import qualified Paths_purescript as Paths

41import qualified Paths_purescript as Paths

35

42

36data PSCOptions = PSCOptions

43data PSCOptions = PSCOptions

37− { pscInput :: [FilePath]

44+ { pscInput :: [FilePath]

45+ , pscForeignInput :: [FilePath]

38− , pscOpts :: P.Options P.Compile

46+ , pscOpts :: P.Options P.Compile

39− , pscStdIn :: Bool

47+ , pscStdIn :: Bool

40− , pscOutput :: Maybe FilePath

48+ , pscOutput :: Maybe FilePath

41− , pscExterns :: Maybe FilePath

49+ , pscExterns :: Maybe FilePath

42− , pscUsePrefix :: Bool

50+ , pscUsePrefix :: Bool

43 }

51 }

44

52

45data InputOptions = InputOptions

53data InputOptions = InputOptions

46− { ioNoPrelude :: Bool

54+ { ioUseStdIn :: Bool

47− , ioUseStdIn :: Bool

48− , ioInputFiles :: [FilePath]

55+ , ioInputFiles :: [FilePath]

49 }

56 }

50

57

51readInput :: InputOptions -> IO [(Maybe FilePath, String)]

58readInput :: InputOptions -> IO [(Maybe FilePath, String)]

@@ -59,20 +66,24 @@ runPSC :: P.Options P.Compile -> PSC a -> Either P.MultipleErrors (a, P.Multiple

59runPSC opts rwe = runWriterT (runReaderT rwe opts)

66runPSC opts rwe = runWriterT (runReaderT rwe opts)

60

67

61compile :: PSCOptions -> IO ()

68compile :: PSCOptions -> IO ()

62−compile (PSCOptions input opts stdin output externs usePrefix) = do

69+compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do

63− modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)

70+ let prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]

64− case modules of

71+ moduleFiles <- readInput (InputOptions stdin input)

72+ foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)

73+ case runWriterT (parseInputs moduleFiles foreignFiles) of

65− Left err -> do

74+ Left errs -> do

66− hPutStrLn stderr $ show err

75+ hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

67 exitFailure

76 exitFailure

68− Right ms -> do

77+ Right ((ms, foreigns), warnings) -> do

78+ when (P.nonEmpty warnings) $

79+ hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)

69− case runPSC opts (P.compile (map snd ms) prefix) of

80+ case runPSC opts (P.compileJS ms foreigns prefix) of

70 Left errs -> do

81 Left errs -> do

71 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

82 hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)

72 exitFailure

83 exitFailure

73− Right ((js, exts, _), warnings) -> do

84+ Right ((js, exts, _), warnings') -> do

74− when (P.nonEmpty warnings) $

85+ when (P.nonEmpty warnings') $

75− hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)

86+ hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')

76 case output of

87 case output of

77 Just path -> mkdirp path >> writeFile path js

88 Just path -> mkdirp path >> writeFile path js

78 Nothing -> putStrLn js

89 Nothing -> putStrLn js

@@ -80,10 +91,12 @@ compile (PSCOptions input opts stdin output externs usePrefix) = do

80 Just path -> mkdirp path >> writeFile path exts

91 Just path -> mkdirp path >> writeFile path exts

81 Nothing -> return ()

92 Nothing -> return ()

82 exitSuccess

93 exitSuccess

83− where

94+

84− prefix = if usePrefix

95+parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

85− then ["Generated by psc version " ++ showVersion Paths.version]

96+ => [(Maybe FilePath, String)] -> [(FilePath, P.ForeignJS)] -> m ([P.Module], M.Map P.ModuleName (FilePath, P.ForeignJS))

86− else []

97+parseInputs modules foreigns =

98+ (,) <$> (map snd <$> P.parseModulesFromFiles (fromMaybe "") modules)

99+ <*> P.parseForeignModulesFromFiles foreigns

87

100

88mkdirp :: FilePath -> IO ()

101mkdirp :: FilePath -> IO ()

89mkdirp = createDirectoryIfMissing True . takeDirectory

102mkdirp = createDirectoryIfMissing True . takeDirectory

@@ -139,11 +152,6 @@ noTco = switch $

139 long "no-tco"

152 long "no-tco"

140 <> help "Disable tail call optimizations"

153 <> help "Disable tail call optimizations"

141

154

142−noPrelude :: Parser Bool

143−noPrelude = switch $

144− long "no-prelude"

145− <> help "Omit the automatic Prelude import"

146−

147comments :: Parser Bool

155comments :: Parser Bool

148comments = switch $

156comments = switch $

149 short 'c'

157 short 'c'

@@ -161,6 +169,12 @@ inputFile = strArgument $

161 metavar "FILE"

169 metavar "FILE"

162 <> help "The input .purs file(s)"

170 <> help "The input .purs file(s)"

163

171

172+inputForeignFile :: Parser FilePath

173+inputForeignFile = strOption $

174+ short 'f'

175+ <> long "ffi"

176+ <> help "The input .js file(s) providing foreign import implementations"

177+

164outputFile :: Parser (Maybe FilePath)

178outputFile :: Parser (Maybe FilePath)

165outputFile = optional . strOption $

179outputFile = optional . strOption $

166 short 'o'

180 short 'o'

@@ -180,8 +194,7 @@ noPrefix = switch $

180 <> help "Do not include comment header"

194 <> help "Do not include comment header"

181

195

182options :: Parser (P.Options P.Compile)

196options :: Parser (P.Options P.Compile)

183−options = P.Options <$> noPrelude

197+options = P.Options <$> noTco

184− <*> noTco

185 <*> noMagicDo

198 <*> noMagicDo

186 <*> runMain

199 <*> runMain

187 <*> noOpts

200 <*> noOpts

@@ -196,6 +209,7 @@ options = P.Options <$> noPrelude

196

209

197pscOptions :: Parser PSCOptions

210pscOptions :: Parser PSCOptions

198pscOptions = PSCOptions <$> many inputFile

211pscOptions = PSCOptions <$> many inputFile

212+ <*> many inputForeignFile

199 <*> options

213 <*> options

200 <*> useStdIn

214 <*> useStdIn

201 <*> outputFile

215 <*> outputFile

@@ -212,4 +226,3 @@ main = execParser opts >>= compile

212

226

213 version :: Parser (a -> a)

227 version :: Parser (a -> a)

214 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

228 version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

215−

psci/Completion.hs+1−1

@@ -199,7 +199,7 @@ identNames = nubOnFst . mapMaybe getDeclName . P.exportedDeclarations

199 where

199 where

200 getDeclName :: P.Declaration -> Maybe (P.Ident, P.Declaration)

200 getDeclName :: P.Declaration -> Maybe (P.Ident, P.Declaration)

201 getDeclName d@(P.ValueDeclaration ident _ _ _) = Just (ident, d)

201 getDeclName d@(P.ValueDeclaration ident _ _ _) = Just (ident, d)

202− getDeclName d@(P.ExternDeclaration _ ident _ _) = Just (ident, d)

202+ getDeclName d@(P.ExternDeclaration ident _) = Just (ident, d)

203 getDeclName (P.PositionedDeclaration _ _ d) = getDeclName d

203 getDeclName (P.PositionedDeclaration _ _ d) = getDeclName d

204 getDeclName _ = Nothing

204 getDeclName _ = Nothing

205

205

psci/IO.hsnew file+21

@@ -0,0 +1,21 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : IO

4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors

5+-- License : MIT

6+--

7+-- Maintainer : Phil Freeman <paf31@cantab.net>

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+--

13+-----------------------------------------------------------------------------

14+

15+module IO where

16+

17+import System.Directory (createDirectoryIfMissing)

18+import System.FilePath (takeDirectory)

19+

20+mkdirp :: FilePath -> IO ()

21+mkdirp = createDirectoryIfMissing True . takeDirectory

psci/Make.hsnew file+127

@@ -0,0 +1,127 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Make

4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors

5+-- License : MIT

6+--

7+-- Maintainer : Phil Freeman <paf31@cantab.net>

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+--

13+-----------------------------------------------------------------------------

14+

15+{-# LANGUAGE DataKinds #-}

16+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

17+{-# LANGUAGE TupleSections #-}

18+

19+module Make where

20+

21+import Data.List (isPrefixOf)

22+import Data.Maybe (fromMaybe)

23+import Data.Time.Clock

24+import Data.Traversable (traverse)

25+import qualified Data.Map as M

26+

27+import Control.Applicative

28+import Control.Monad

29+import Control.Monad.Error.Class (MonadError(..))

30+import Control.Monad.IO.Class (MonadIO, liftIO)

31+import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)

32+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)

33+import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)

34+

35+import System.Directory (getModificationTime, doesFileExist)

36+import System.FilePath ((</>), pathSeparator)

37+import System.IO.Error (tryIOError)

38+

39+import qualified Language.PureScript as P

40+import qualified Language.PureScript.CodeGen.JS as J

41+import qualified Language.PureScript.CoreFn as CF

42+

43+import IO (mkdirp)

44+

45+options :: P.Options P.Make

46+options = P.Options False False Nothing False False False P.MakeOptions

47+

48+modulesDir :: FilePath

49+modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"

50+

51+newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }

52+ deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader (P.Options P.Make))

53+

54+runMake :: Make a -> IO (Either P.MultipleErrors a)

55+runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake

56+

57+makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a

58+makeIO f io = do

59+ e <- liftIO $ tryIOError io

60+ either (throwError . P.singleError . f) return e

61+

62+-- Traverse (Either e) instance (base 4.7)

63+traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)

64+traverseEither _ (Left x) = pure (Left x)

65+traverseEither f (Right y) = Right <$> f y

66+

67+buildMakeActions :: M.Map P.ModuleName (Either P.RebuildPolicy String)

68+ -> M.Map P.ModuleName P.ForeignJS

69+ -> P.MakeActions Make

70+buildMakeActions filePathMap foreigns =

71+ P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress

72+ where

73+

74+ getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))

75+ getInputTimestamp mn = do

76+ let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap

77+ traverseEither getTimestamp path

78+

79+ getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)

80+ getOutputTimestamp mn = do

81+ let filePath = P.runModuleName mn

82+ jsFile = modulesDir </> filePath </> "index.js"

83+ externsFile = modulesDir </> filePath </> "externs.purs"

84+ min <$> getTimestamp jsFile <*> getTimestamp externsFile

85+

86+ readExterns :: P.ModuleName -> Make (FilePath, String)

87+ readExterns mn = do

88+ let path = modulesDir </> P.runModuleName mn </> "externs.purs"

89+ (path, ) <$> readTextFile path

90+

91+ codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()

92+ codegen m _ nextVar exts = do

93+ let mn = CF.moduleName m

94+ foreignInclude <- case CF.moduleName m `M.lookup` foreigns of

95+ Just path

96+ | not $ requiresForeign m -> do tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path

97+ return Nothing

98+ | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]

99+ Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn

100+ | otherwise -> return Nothing

101+ pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude

102+ let filePath = P.runModuleName $ CF.moduleName m

103+ jsFile = modulesDir </> filePath </> "index.js"

104+ externsFile = modulesDir </> filePath </> "externs.purs"

105+ foreignFile = modulesDir </> filePath </> "foreign.js"

106+ writeTextFile jsFile pjs

107+ maybe (return ()) (writeTextFile foreignFile) $ CF.moduleName m `M.lookup` foreigns

108+ writeTextFile externsFile exts

109+

110+ requiresForeign :: CF.Module a -> Bool

111+ requiresForeign = not . null . CF.moduleForeign

112+

113+ getTimestamp :: FilePath -> Make (Maybe UTCTime)

114+ getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do

115+ exists <- doesFileExist path

116+ traverse (const $ getModificationTime path) $ guard exists

117+

118+ readTextFile :: FilePath -> Make String

119+ readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ readFile path

120+

121+ writeTextFile :: FilePath -> String -> Make ()

122+ writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do

123+ mkdirp path

124+ writeFile path text

125+

126+ progress :: String -> Make ()

127+ progress s = unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s

psci/PSCi.hs+60−86

@@ -13,50 +13,47 @@

13--

13--

14-----------------------------------------------------------------------------

14-----------------------------------------------------------------------------

15

15

16−{-# LANGUAGE DataKinds #-}

17{-# LANGUAGE DoAndIfThenElse #-}

16{-# LANGUAGE DoAndIfThenElse #-}

18−{-# LANGUAGE FlexibleContexts #-}

19{-# LANGUAGE GeneralizedNewtypeDeriving #-}

17{-# LANGUAGE GeneralizedNewtypeDeriving #-}

20{-# LANGUAGE RecordWildCards #-}

18{-# LANGUAGE RecordWildCards #-}

19+{-# LANGUAGE TupleSections #-}

21

20

22module PSCi where

21module PSCi where

23

22

24import Data.Foldable (traverse_)

23import Data.Foldable (traverse_)

25−import Data.List (intercalate, nub, sort, isPrefixOf)

24+import Data.List (intercalate, nub, sort)

26import Data.Traversable (traverse)

25import Data.Traversable (traverse)

26+import Data.Tuple (swap)

27import Data.Version (showVersion)

27import Data.Version (showVersion)

28import qualified Data.Map as M

28import qualified Data.Map as M

29

29

30import Control.Applicative

30import Control.Applicative

31+import Control.Arrow (first)

31import Control.Monad

32import Control.Monad

32−import Control.Monad.IO.Class (MonadIO, liftIO)

33−import Control.Monad.Error.Class (MonadError(..))

34−import Control.Monad.Trans.Except (ExceptT(..), runExceptT)

35−import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)

36−import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, runWriter)

37import Control.Monad.Trans.Class

33import Control.Monad.Trans.Class

34+import Control.Monad.Trans.Except (runExceptT)

38import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

35import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

39import Control.Monad.Trans.State.Strict

36import Control.Monad.Trans.State.Strict

37+import Control.Monad.Writer (runWriter)

40import qualified Control.Monad.Trans.State.Lazy as L

38import qualified Control.Monad.Trans.State.Lazy as L

41

39

42import Options.Applicative as Opts

40import Options.Applicative as Opts

43

41

44import System.Console.Haskeline

42import System.Console.Haskeline

45−import System.Directory (createDirectoryIfMissing, getModificationTime, doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)

43+import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)

46import System.Exit

44import System.Exit

47−import System.FilePath (pathSeparator, takeDirectory, (</>), isPathSeparator)

45+import System.FilePath (pathSeparator, (</>), isPathSeparator)

48−import System.IO.Error (tryIOError)

49import System.Process (readProcessWithExitCode)

46import System.Process (readProcessWithExitCode)

50

47

51−import qualified Text.Parsec as Par (ParseError)

52−

53import qualified Language.PureScript as P

48import qualified Language.PureScript as P

54import qualified Language.PureScript.Names as N

49import qualified Language.PureScript.Names as N

55import qualified Paths_purescript as Paths

50import qualified Paths_purescript as Paths

56

51

57import qualified Directive as D

52import qualified Directive as D

58−import Parser (parseCommand)

59import Completion (completion)

53import Completion (completion)

54+import IO (mkdirp)

55+import Make

56+import Parser (parseCommand)

60import Types

57import Types

61

58

62-- | The name of the PSCI support module

59-- | The name of the PSCI support module

@@ -65,7 +62,7 @@ supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]

65

62

66-- | Support module, contains code to evaluate terms

63-- | Support module, contains code to evaluate terms

67supportModule :: P.Module

64supportModule :: P.Module

68−supportModule =

65+supportModule =

69 case P.parseModulesFromFiles id [("", code)] of

66 case P.parseModulesFromFiles id [("", code)] of

70 Right [(_, P.Module cs _ ds exps)] -> P.Module cs supportModuleName ds exps

67 Right [(_, P.Module cs _ ds exps)] -> P.Module cs supportModuleName ds exps

71 _ -> error "Support module could not be parsed"

68 _ -> error "Support module could not be parsed"

@@ -90,11 +87,6 @@ supportModule =

90 ]

87 ]

91

88

92-- File helpers

89-- File helpers

93−-- |

94−-- Load the necessary modules.

95−--

96−defaultImports :: [ImportedModule]

97−defaultImports = [(P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]

98

90

99-- |

91-- |

100-- Locates the node executable.

92-- Locates the node executable.

@@ -120,12 +112,12 @@ getHistoryFilename = do

120loadModule :: FilePath -> IO (Either String [P.Module])

112loadModule :: FilePath -> IO (Either String [P.Module])

121loadModule filename = do

113loadModule filename = do

122 content <- readFile filename

114 content <- readFile filename

123− return $ either (Left . show) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]

115+ return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]

124

116

125-- |

117-- |

126−-- Load all modules, including the Prelude

118+-- Load all modules.

127--

119--

128−loadAllModules :: [FilePath] -> IO (Either Par.ParseError [(Either P.RebuildPolicy FilePath, P.Module)])

120+loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(Either P.RebuildPolicy FilePath, P.Module)])

129loadAllModules files = do

121loadAllModules files = do

130 filesAndContent <- forM files $ \filename -> do

122 filesAndContent <- forM files $ \filename -> do

131 content <- readFile filename

123 content <- readFile filename

@@ -140,7 +132,7 @@ loadAllImportedModules = do

140 files <- PSCI . lift $ fmap psciImportedFilenames get

132 files <- PSCI . lift $ fmap psciImportedFilenames get

141 modulesOrFirstError <- psciIO $ loadAllModules files

133 modulesOrFirstError <- psciIO $ loadAllModules files

142 case modulesOrFirstError of

134 case modulesOrFirstError of

143− Left err -> psciIO $ print err

135+ Left errs -> printErrors errs

144 Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }

136 Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }

145

137

146-- |

138-- |

@@ -149,6 +141,7 @@ loadAllImportedModules = do

149expandTilde :: FilePath -> IO FilePath

141expandTilde :: FilePath -> IO FilePath

150expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory

142expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory

151expandTilde p = return p

143expandTilde p = return p

144+

152-- Messages

145-- Messages

153

146

154-- |

147-- |

@@ -162,13 +155,12 @@ helpMessage = "The following commands are available:\n\n " ++

162 line :: (Directive, String, String) -> String

155 line :: (Directive, String, String) -> String

163 line (dir, arg, desc) =

156 line (dir, arg, desc) =

164 let cmd = ':' : D.stringFor dir

157 let cmd = ':' : D.stringFor dir

165− in intercalate " "

166− [ cmd

158+ in unwords [ cmd

167− , replicate (11 - length cmd) ' '

159+ , replicate (11 - length cmd) ' '

168− , arg

160+ , arg

169− , replicate (11 - length arg) ' '

161+ , replicate (11 - length arg) ' '

170− , desc

162+ , desc

171− ]

163+ ]

172

164

173 extraHelp =

165 extraHelp =

174 "Further information is available on the PureScript wiki:\n" ++

166 "Further information is available on the PureScript wiki:\n" ++

@@ -196,14 +188,6 @@ prologueMessage = intercalate "\n"

196quitMessage :: String

188quitMessage :: String

197quitMessage = "See ya!"

189quitMessage = "See ya!"

198

190

199−

200−-- Compilation

201−

202−-- | Compilation options.

203−--

204−options :: P.Options P.Make

205−options = P.Options False False False Nothing False False False P.MakeOptions

206−

207-- |

191-- |

208-- PSCI monad

192-- PSCI monad

209--

193--

@@ -212,30 +196,6 @@ newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Fu

212psciIO :: IO a -> PSCI a

196psciIO :: IO a -> PSCI a

213psciIO io = PSCI . lift $ lift io

197psciIO io = PSCI . lift $ lift io

214

198

215−newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }

216− deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader (P.Options P.Make))

217−

218−runMake :: Make a -> IO (Either P.MultipleErrors a)

219−runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake

220−

221−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a

222−makeIO f io = do

223− e <- liftIO $ tryIOError io

224− either (throwError . P.singleError . f) return e

225−

226−instance P.MonadMake Make where

227− getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do

228− exists <- doesFileExist path

229− traverse (const $ getModificationTime path) $ guard exists

230− readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ readFile path

231− writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do

232− mkdirp path

233− writeFile path text

234− progress s = unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s

235−

236−mkdirp :: FilePath -> IO ()

237−mkdirp = createDirectoryIfMissing True . takeDirectory

238−

239-- |

199-- |

240-- Makes a volatile module to execute the current expression.

200-- Makes a volatile module to execute the current expression.

241--

201--

@@ -245,8 +205,8 @@ createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindi

245 moduleName = P.ModuleName [P.ProperName "$PSCI"]

205 moduleName = P.ModuleName [P.ProperName "$PSCI"]

246 trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))

206 trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))

247 mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

207 mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

248− itDecl = P.ValueDeclaration (P.Ident "it") P.Value [] $ Right val

208+ itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val

249− mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] $ Right mainValue

209+ mainDecl = P.ValueDeclaration (P.Ident "main") P.Public [] $ Right mainValue

250 decls = if exec then [itDecl, mainDecl] else [itDecl]

210 decls = if exec then [itDecl, mainDecl] else [itDecl]

251 in

211 in

252 P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing

212 P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing

@@ -276,12 +236,14 @@ createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =

276importDecl :: ImportedModule -> P.Declaration

236importDecl :: ImportedModule -> P.Declaration

277importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ

237importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ

278

238

279−modulesDir :: FilePath

280−modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"

281−

282indexFile :: FilePath

239indexFile :: FilePath

283indexFile = ".psci_modules" ++ pathSeparator : "index.js"

240indexFile = ".psci_modules" ++ pathSeparator : "index.js"

284

241

242+make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> Make P.Environment

243+make PSCiState{..} ms =

244+ let filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)

245+ in P.make (buildMakeActions filePathMap (M.map snd psciForeignFiles)) (psciLoadedModules ++ ms)

246+

285-- |

247-- |

286-- Takes a value declaration and evaluates it with the current state.

248-- Takes a value declaration and evaluates it with the current state.

287--

249--

@@ -290,7 +252,7 @@ handleDeclaration val = do

290 st <- PSCI $ lift get

252 st <- PSCI $ lift get

291 let m = createTemporaryModule True st val

253 let m = createTemporaryModule True st val

292 let nodeArgs = psciNodeFlags st ++ [indexFile]

254 let nodeArgs = psciNodeFlags st ++ [indexFile]

293− e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, supportModule), (Left P.RebuildAlways, m)]) []

255+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, supportModule), (Left P.RebuildAlways, m)]

294 case e of

256 case e of

295 Left errs -> printErrors errs

257 Left errs -> printErrors errs

296 Right _ -> do

258 Right _ -> do

@@ -311,7 +273,7 @@ handleDecls ds = do

311 st <- PSCI $ lift get

273 st <- PSCI $ lift get

312 let st' = updateLets ds st

274 let st' = updateLets ds st

313 let m = createTemporaryModule False st' (P.ObjectLiteral [])

275 let m = createTemporaryModule False st' (P.ObjectLiteral [])

314− e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st' ++ [(Left P.RebuildAlways, m)]) []

276+ e <- psciIO . runMake $ make st' [(Left P.RebuildAlways, m)]

315 case e of

277 case e of

316 Left err -> printErrors err

278 Left err -> printErrors err

317 Right _ -> PSCI $ lift (put st')

279 Right _ -> PSCI $ lift (put st')

@@ -364,7 +326,7 @@ handleImport :: ImportedModule -> PSCI ()

364handleImport im = do

326handleImport im = do

365 st <- updateImportedModules im <$> PSCI (lift get)

327 st <- updateImportedModules im <$> PSCI (lift get)

366 let m = createTemporaryModuleForImports st

328 let m = createTemporaryModuleForImports st

367− e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []

329+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]

368 case e of

330 case e of

369 Left errs -> printErrors errs

331 Left errs -> printErrors errs

370 Right _ -> do

332 Right _ -> do

@@ -378,7 +340,7 @@ handleTypeOf :: P.Expr -> PSCI ()

378handleTypeOf val = do

340handleTypeOf val = do

379 st <- PSCI $ lift get

341 st <- PSCI $ lift get

380 let m = createTemporaryModule False st val

342 let m = createTemporaryModule False st val

381− e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []

343+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]

382 case e of

344 case e of

383 Left errs -> printErrors errs

345 Left errs -> printErrors errs

384 Right env' ->

346 Right env' ->

@@ -411,12 +373,11 @@ printModuleSignatures moduleName env =

411handleBrowse :: P.ModuleName -> PSCI ()

373handleBrowse :: P.ModuleName -> PSCI ()

412handleBrowse moduleName = do

374handleBrowse moduleName = do

413 st <- PSCI $ lift get

375 st <- PSCI $ lift get

414− let loadedModules = psciLoadedModules st

415− env <- psciIO . runMake $ P.make modulesDir loadedModules []

376+ env <- psciIO . runMake $ make st []

416 case env of

377 case env of

417 Left errs -> printErrors errs

378 Left errs -> printErrors errs

418 Right env' ->

379 Right env' ->

419− if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) loadedModules

380+ if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) (psciLoadedModules st)

420 then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."

381 then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."

421 else printModuleSignatures moduleName env'

382 else printModuleSignatures moduleName env'

422

383

@@ -432,7 +393,7 @@ handleKindOf typ = do

432 st <- PSCI $ lift get

393 st <- PSCI $ lift get

433 let m = createTemporaryModuleForKind st typ

394 let m = createTemporaryModuleForKind st typ

434 mName = P.ModuleName [P.ProperName "$PSCI"]

395 mName = P.ModuleName [P.ProperName "$PSCI"]

435− e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []

396+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]

436 case e of

397 case e of

437 Left errs -> printErrors errs

398 Left errs -> printErrors errs

438 Right env' ->

399 Right env' ->

@@ -485,7 +446,7 @@ handleCommand ResetState = do

485 files <- psciImportedFilenames <$> PSCI (lift get)

446 files <- psciImportedFilenames <$> PSCI (lift get)

486 PSCI . lift . modify $ \st -> st

447 PSCI . lift . modify $ \st -> st

487 { psciImportedFilenames = files

448 { psciImportedFilenames = files

488− , psciImportedModules = defaultImports

449+ , psciImportedModules = []

489 , psciLetBindings = []

450 , psciLetBindings = []

490 }

451 }

491 loadAllImportedModules

452 loadAllImportedModules

@@ -521,18 +482,24 @@ loop PSCiOptions{..} = do

521 config <- loadUserConfig

482 config <- loadUserConfig

522 modulesOrFirstError <- loadAllModules psciInputFile

483 modulesOrFirstError <- loadAllModules psciInputFile

523 case modulesOrFirstError of

484 case modulesOrFirstError of

524− Left err -> print err >> exitFailure

485+ Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure

525 Right modules -> do

486 Right modules -> do

526 historyFilename <- getHistoryFilename

487 historyFilename <- getHistoryFilename

527 let settings = defaultSettings { historyFile = Just historyFilename }

488 let settings = defaultSettings { historyFile = Just historyFilename }

489+ foreignsOrError <- runMake $ do

490+ foreignFiles <- forM psciForeignInputFiles (\inFile -> (inFile,) <$> makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile inFile)) (readFile inFile))

491+ P.parseForeignModulesFromFiles foreignFiles

492+ case foreignsOrError of

493+ Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure

494+ Right foreigns ->

528− flip evalStateT (PSCiState psciInputFile defaultImports modules [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do

495+ flip evalStateT (PSCiState psciInputFile [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do

529− outputStrLn prologueMessage

496+ outputStrLn prologueMessage

530− traverse_ (mapM_ (runPSCI . handleCommand)) config

497+ traverse_ (mapM_ (runPSCI . handleCommand)) config

531− unless (consoleIsDefined (map snd modules)) . outputStrLn $ unlines

498+ unless (consoleIsDefined (map snd modules)) . outputStrLn $ unlines

532− [ "PSCi requires the purescript-console module to be installed."

499+ [ "PSCi requires the purescript-console module to be installed."

533− , "For help getting started, visit http://wiki.purescript.org/PSCi"

500+ , "For help getting started, visit http://wiki.purescript.org/PSCi"

534− ]

501+ ]

535− go

502+ go

536 where

503 where

537 go :: InputT (StateT PSCiState IO) ()

504 go :: InputT (StateT PSCiState IO) ()

538 go = do

505 go = do

@@ -554,6 +521,12 @@ inputFile = strArgument $

554 metavar "FILE"

521 metavar "FILE"

555 <> Opts.help "Optional .purs files to load on start"

522 <> Opts.help "Optional .purs files to load on start"

556

523

524+inputForeignFile :: Parser FilePath

525+inputForeignFile = strOption $

526+ short 'f'

527+ <> long "ffi"

528+ <> help "The input .js file(s) providing foreign import implementations"

529+

557nodeFlagsFlag :: Parser [String]

530nodeFlagsFlag :: Parser [String]

558nodeFlagsFlag = option parser $

531nodeFlagsFlag = option parser $

559 long "node-opts"

532 long "node-opts"

@@ -566,6 +539,7 @@ nodeFlagsFlag = option parser $

566psciOptions :: Parser PSCiOptions

539psciOptions :: Parser PSCiOptions

567psciOptions = PSCiOptions <$> multiLineMode

540psciOptions = PSCiOptions <$> multiLineMode

568 <*> many inputFile

541 <*> many inputFile

542+ <*> many inputForeignFile

569 <*> nodeFlagsFlag

543 <*> nodeFlagsFlag

570

544

571runPSCi :: IO ()

545runPSCi :: IO ()

psci/Parser.hs+7−7

@@ -122,13 +122,13 @@ discardPositionInfo (P.PositionedDeclaration _ _ d) = d

122discardPositionInfo d = d

122discardPositionInfo d = d

123

123

124acceptable :: P.Declaration -> Bool

124acceptable :: P.Declaration -> Bool

125−acceptable (P.DataDeclaration _ _ _ _) = True

125+acceptable P.DataDeclaration{} = True

126−acceptable (P.TypeSynonymDeclaration _ _ _) = True

126+acceptable P.TypeSynonymDeclaration{} = True

127−acceptable (P.ExternDeclaration _ _ _ _) = True

127+acceptable P.ExternDeclaration{} = True

128−acceptable (P.ExternDataDeclaration _ _) = True

128+acceptable P.ExternDataDeclaration{} = True

129−acceptable (P.ExternInstanceDeclaration _ _ _ _) = True

129+acceptable P.ExternInstanceDeclaration{} = True

130−acceptable (P.TypeClassDeclaration _ _ _ _) = True

130+acceptable P.TypeClassDeclaration{} = True

131−acceptable (P.TypeInstanceDeclaration _ _ _ _ _) = True

131+acceptable P.TypeInstanceDeclaration{} = True

132acceptable _ = False

132acceptable _ = False

133

133

134parseReplQuery' :: String -> Either String ReplQuery

134parseReplQuery' :: String -> Either String ReplQuery

psci/Types.hs+6−3

@@ -15,12 +15,14 @@

15

15

16module Types where

16module Types where

17

17

18+import qualified Data.Map as M

18import qualified Language.PureScript as P

19import qualified Language.PureScript as P

19

20

20data PSCiOptions = PSCiOptions

21data PSCiOptions = PSCiOptions

21− { psciMultiLineMode :: Bool

22+ { psciMultiLineMode :: Bool

22− , psciInputFile :: [FilePath]

23+ , psciInputFile :: [FilePath]

24+ , psciForeignInputFiles :: [FilePath]

23− , psciInputNodeFlags :: [String]

25+ , psciInputNodeFlags :: [String]

24 }

26 }

25

27

26-- |

28-- |

@@ -33,6 +35,7 @@ data PSCiState = PSCiState

33 { psciImportedFilenames :: [FilePath]

35 { psciImportedFilenames :: [FilePath]

34 , psciImportedModules :: [ImportedModule]

36 , psciImportedModules :: [ImportedModule]

35 , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]

37 , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]

38+ , psciForeignFiles :: M.Map P.ModuleName (FilePath, P.ForeignJS)

36 , psciLetBindings :: [P.Declaration]

39 , psciLetBindings :: [P.Declaration]

37 , psciNodeFlags :: [String]

40 , psciNodeFlags :: [String]

38 }

41 }

psci/tests/Main.hs+17−8

@@ -1,16 +1,19 @@

1−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE RecordWildCards, TupleSections #-}

2

2

3module Main where

3module Main where

4

4

5import Control.Monad.Trans.State.Strict (runStateT)

5import Control.Monad.Trans.State.Strict (runStateT)

6−import Control.Monad (when)

6+import Control.Monad (when, forM)

7+import Control.Applicative

8+import Control.Monad.Writer (runWriterT)

9+import Control.Monad.Trans.Except (runExceptT)

7

10

8−import Data.List (sort)

11+import Data.List (isSuffixOf, sort)

9

12

10import System.Exit (exitFailure)

13import System.Exit (exitFailure)

11import System.Console.Haskeline

14import System.Console.Haskeline

12import System.FilePath ((</>))

15import System.FilePath ((</>))

13−import System.Directory (getCurrentDirectory)

16+import System.Directory (getCurrentDirectory, getDirectoryContents)

14

17

15import Test.HUnit

18import Test.HUnit

16

19

@@ -104,7 +107,8 @@ completionTestData =

104 , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])

107 , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])

105 ]

108 ]

106 where

109 where

110+ allModuleNames = [ "Assert"

107− allModuleNames = [ "Control.Monad.Eff"

111+ , "Control.Monad.Eff"

108 , "Control.Monad.ST"

112 , "Control.Monad.ST"

109 , "Data.Function"

113 , "Data.Function"

110 , "Debug.Trace"

114 , "Debug.Trace"

@@ -127,13 +131,18 @@ runCM act = do

127getPSCiState :: IO PSCiState

131getPSCiState :: IO PSCiState

128getPSCiState = do

132getPSCiState = do

129 cwd <- getCurrentDirectory

133 cwd <- getCurrentDirectory

134+ let preludeDir = cwd </> "tests" </> "prelude"

135+ jsDir = preludeDir </> "js"

130− modulesOrFirstError <- loadAllModules [ cwd </> "tests" </> "prelude.purs" ]

136+ modulesOrFirstError <- loadAllModules [ preludeDir </> "prelude.purs" ]

137+ jsFiles <- map (jsDir </>) . filter (".js" `isSuffixOf`) <$> getDirectoryContents jsDir

138+ foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)

139+ Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles

131 case modulesOrFirstError of

140 case modulesOrFirstError of

132 Left err ->

141 Left err ->

133 print err >> exitFailure

142 print err >> exitFailure

134 Right modules ->

143 Right modules ->

135− let imports = controlMonadSTasST : defaultImports

144+ let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]

136− in return (PSCiState [] imports modules [] [])

145+ in return (PSCiState [] imports modules foreigns [] [])

137

146

138controlMonadSTasST :: ImportedModule

147controlMonadSTasST :: ImportedModule

139controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))

148controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))

purescript.cabal+9−5

@@ -46,6 +46,7 @@ library

46 bytestring -any,

46 bytestring -any,

47 text -any,

47 text -any,

48 split -any

48 split -any

49+

49 exposed-modules: Language.PureScript

50 exposed-modules: Language.PureScript

50 Language.PureScript.AST

51 Language.PureScript.AST

51 Language.PureScript.AST.Binders

52 Language.PureScript.AST.Binders

@@ -89,6 +90,7 @@ library

89 Language.PureScript.Parser.Lexer

90 Language.PureScript.Parser.Lexer

90 Language.PureScript.Parser.Common

91 Language.PureScript.Parser.Common

91 Language.PureScript.Parser.Declarations

92 Language.PureScript.Parser.Declarations

93+ Language.PureScript.Parser.JS

92 Language.PureScript.Parser.Kinds

94 Language.PureScript.Parser.Kinds

93 Language.PureScript.Parser.State

95 Language.PureScript.Parser.State

94 Language.PureScript.Parser.Types

96 Language.PureScript.Parser.Types

@@ -155,18 +157,18 @@ executable psc

155executable psc-make

157executable psc-make

156 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

158 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

157 mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,

159 mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,

158− transformers -any, transformers-compat -any

160+ time -any, transformers -any, transformers-compat -any

159 main-is: Main.hs

161 main-is: Main.hs

160 buildable: True

162 buildable: True

161 hs-source-dirs: psc-make

163 hs-source-dirs: psc-make

162− other-modules:

164+ other-modules: Make

163 ghc-options: -Wall -O2 -fno-warn-unused-do-bind

165 ghc-options: -Wall -O2 -fno-warn-unused-do-bind

164

166

165executable psci

167executable psci

166 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

168 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

167 mtl -any, optparse-applicative >= 0.10.0, parsec -any,

169 mtl -any, optparse-applicative >= 0.10.0, parsec -any,

168 haskeline >= 0.7.0.0, purescript -any, transformers -any,

170 haskeline >= 0.7.0.0, purescript -any, transformers -any,

169− transformers-compat -any, process -any

171+ transformers-compat -any, process -any, time -any

170

172

171 main-is: Main.hs

173 main-is: Main.hs

172 buildable: True

174 buildable: True

@@ -176,6 +178,8 @@ executable psci

176 Directive

178 Directive

177 Completion

179 Completion

178 PSCi

180 PSCi

181+ Make

182+ IO

179 ghc-options: -Wall -O2

183 ghc-options: -Wall -O2

180

184

181executable psc-docs

185executable psc-docs

@@ -219,7 +223,7 @@ executable psc-hierarchy

219test-suite tests

223test-suite tests

220 build-depends: base >=4 && <5, containers -any, directory -any,

224 build-depends: base >=4 && <5, containers -any, directory -any,

221 filepath -any, mtl -any, parsec -any, purescript -any,

225 filepath -any, mtl -any, parsec -any, purescript -any,

222− transformers -any, process -any

226+ transformers -any, process -any, transformers-compat -any

223 type: exitcode-stdio-1.0

227 type: exitcode-stdio-1.0

224 main-is: Main.hs

228 main-is: Main.hs

225 buildable: True

229 buildable: True

@@ -229,7 +233,7 @@ test-suite psci-tests

229 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

233 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

230 mtl -any, optparse-applicative >= 0.10.0, parsec -any,

234 mtl -any, optparse-applicative >= 0.10.0, parsec -any,

231 haskeline >= 0.7.0.0, purescript -any, transformers -any,

235 haskeline >= 0.7.0.0, purescript -any, transformers -any,

232− transformers-compat -any, process -any, HUnit -any

236+ transformers-compat -any, process -any, HUnit -any, time -any

233 type: exitcode-stdio-1.0

237 type: exitcode-stdio-1.0

234 main-is: Main.hs

238 main-is: Main.hs

235 buildable: True

239 buildable: True

src/Language/PureScript.hs+110−105

@@ -14,17 +14,19 @@

14-----------------------------------------------------------------------------

14-----------------------------------------------------------------------------

15

15

16{-# LANGUAGE DataKinds #-}

16{-# LANGUAGE DataKinds #-}

17−{-# LANGUAGE QuasiQuotes #-}

18−{-# LANGUAGE TemplateHaskell #-}

19{-# LANGUAGE FlexibleContexts #-}

17{-# LANGUAGE FlexibleContexts #-}

18+{-# LANGUAGE RecordWildCards #-}

20{-# LANGUAGE ScopedTypeVariables #-}

19{-# LANGUAGE ScopedTypeVariables #-}

21

20

22module Language.PureScript

21module Language.PureScript

23 ( module P

22 ( module P

24 , compile

23 , compile

25 , compile'

24 , compile'

25+ , compileJS

26 , RebuildPolicy(..)

26 , RebuildPolicy(..)

27− , MonadMake(..)

27+ , MakeActions(..)

28+ , SupplyVar()

29+ , Externs()

28 , make

30 , make

29 , version

31 , version

30 ) where

32 ) where

@@ -34,7 +36,6 @@ import Data.List (sortBy, groupBy, intercalate)

34import Data.Maybe (fromMaybe)

36import Data.Maybe (fromMaybe)

35import Data.Time.Clock

37import Data.Time.Clock

36import Data.Version (Version)

38import Data.Version (Version)

37−import qualified Data.Traversable as T (traverse)

38import qualified Data.Map as M

39import qualified Data.Map as M

39import qualified Data.Set as S

40import qualified Data.Set as S

40

41

@@ -44,12 +45,11 @@ 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−

48+import Control.Monad.Supply.Class (MonadSupply, fresh)

48−import System.FilePath ((</>))

49

49

50import Language.PureScript.AST as P

50import Language.PureScript.AST as P

51import Language.PureScript.Comments as P

51import Language.PureScript.Comments as P

52−import Language.PureScript.CodeGen as P

52+import Language.PureScript.CodeGen.Externs (moduleToPs)

53import Language.PureScript.DeadCodeElimination as P

53import Language.PureScript.DeadCodeElimination as P

54import Language.PureScript.Environment as P

54import Language.PureScript.Environment as P

55import Language.PureScript.Errors as P

55import Language.PureScript.Errors as P

@@ -67,6 +67,7 @@ import Language.PureScript.TypeChecker as P

67import Language.PureScript.Types as P

67import Language.PureScript.Types as P

68import qualified Language.PureScript.CoreFn as CoreFn

68import qualified Language.PureScript.CoreFn as CoreFn

69import qualified Language.PureScript.Constants as C

69import qualified Language.PureScript.Constants as C

70+import qualified Language.PureScript.CodeGen.JS as J

70

71

71import qualified Paths_purescript as Paths

72import qualified Paths_purescript as Paths

72

73

@@ -90,17 +91,15 @@ import qualified Paths_purescript as Paths

90-- * Pretty-print the generated Javascript

91-- * Pretty-print the generated Javascript

91--

92--

92compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

93compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

93− => [Module] -> [String] -> m (String, String, Environment)

94+ => [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)

94compile = compile' initEnvironment

95compile = compile' initEnvironment

95

96

96compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

97compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

97− => Environment -> [Module] -> [String] -> m (String, String, Environment)

98+ => Environment -> [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)

98−compile' env ms prefix = do

99+compile' env ms = do

99− noPrelude <- asks optionsNoPrelude

100− unless noPrelude (checkPreludeIsDefined ms)

101 additional <- asks optionsAdditional

100 additional <- asks optionsAdditional

102 mainModuleIdent <- asks (fmap moduleNameFromString . optionsMain)

101 mainModuleIdent <- asks (fmap moduleNameFromString . optionsMain)

103− (sorted, _) <- sortModules $ map importPrim $ if noPrelude then ms else map importPrelude ms

102+ (sorted, _) <- sortModules $ map importPrim ms

104 mapM_ lint sorted

103 mapM_ lint sorted

105 (desugared, nextVar) <- runSupplyT 0 $ desugar sorted

104 (desugared, nextVar) <- runSupplyT 0 $ desugar sorted

106 (elaborated, env') <- runCheck' env $ forM desugared $ typeCheckModule mainModuleIdent

105 (elaborated, env') <- runCheck' env $ forM desugared $ typeCheckModule mainModuleIdent

@@ -111,46 +110,92 @@ compile' env ms prefix = do

111 renamed = renameInModules elim

110 renamed = renameInModules elim

112 codeGenModuleNames = moduleNameFromString `map` codeGenModules additional

111 codeGenModuleNames = moduleNameFromString `map` codeGenModules additional

113 modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed

112 modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed

114− js <- concat <$> (evalSupplyT nextVar $ T.traverse moduleToJs modulesToCodeGen)

115− let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped

113+ exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped

116− js' <- generateMain env' js

114+ return (modulesToCodeGen, env', nextVar, exts)

117− let pjs = unlines $ map ("// " ++) prefix ++ [prettyPrintJS js']

118− return (pjs, exts, env')

119

115

116+-- |

117+-- Compile a collection of modules to JavaScript and externs files

118+--

120−generateMain :: (MonadError MultipleErrors m, MonadReader (Options Compile) m) => Environment -> [JS] -> m [JS]

119+compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)

120+ => [P.Module] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> [String] -> m (String, String, Environment)

121+compileJS ms foreigns prefix = do

122+ (modulesToCodeGen, env, nextVar, exts) <- compile ms

123+ js <- concat <$> evalSupplyT nextVar (P.parU modulesToCodeGen codegenModule)

124+ js' <- generateMain env js

125+ let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']

126+ return (pjs, exts, env)

127+

128+ where

129+

130+ codegenModule :: (Functor n, Applicative n, MonadError P.MultipleErrors n, MonadWriter P.MultipleErrors n, MonadReader (P.Options P.Compile) n, MonadSupply n)

131+ => CoreFn.Module CoreFn.Ann -> n [J.JS]

132+ codegenModule m =

133+ let requiresForeign = not $ null (CoreFn.moduleForeign m)

134+ mn = CoreFn.moduleName m

135+ in case mn `M.lookup` foreigns of

136+ Just (path, js)

137+ | not requiresForeign -> do

138+ tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path

139+ J.moduleToJs m Nothing

140+ | otherwise -> J.moduleToJs m $ Just $

141+ J.JSApp (J.JSFunction Nothing [] $

142+ J.JSBlock [ J.JSVariableIntroduction "exports" (Just $ J.JSObjectLiteral [])

143+ , J.JSRaw js

144+ , J.JSReturn (J.JSVar "exports")

145+ ]) []

146+ Nothing | requiresForeign -> throwError . P.errorMessage $ P.MissingFFIModule mn

147+ | otherwise -> J.moduleToJs m Nothing

148+

149+ generateMain :: P.Environment -> [J.JS] -> m [J.JS]

121−generateMain env js = do

150+ generateMain env js = do

122− main <- asks optionsMain

151+ mainName <- asks P.optionsMain

123− additional <- asks optionsAdditional

152+ additional <- asks P.optionsAdditional

124− case moduleNameFromString <$> main of

153+ case P.moduleNameFromString <$> mainName of

125− Just mmi -> do

154+ Just mmi -> do

126− when ((mmi, Ident C.main) `M.notMember` names env) $

155+ when ((mmi, P.Ident C.main) `M.notMember` P.names env) $

127− throwError . errorMessage $ NameIsUndefined (Ident C.main)

156+ throwError . P.errorMessage $ P.NameIsUndefined (P.Ident C.main)

128− return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (browserNamespace additional)))) []]

157+ return $ js ++ [J.mainCall mmi (P.browserNamespace additional)]

129− _ -> return js

158+ _ -> return js

130

159

131-- |

160-- |

132−-- A type class which collects the IO actions we need to be able to run in "make" mode

161+-- Actions that require implementations when running in "make" mode.

133--

162--

134−class (MonadReader (P.Options P.Make) m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MonadMake m where

163+data MakeActions m = MakeActions {

135 -- |

164 -- |

136− -- Get a file timestamp

165+ -- Get the timestamp for the input file(s) for a module. If there are multiple

166+ -- files (.purs and foreign files, for example) the timestamp should be for

167+ -- the most recently modified file.

137 --

168 --

138− getTimestamp :: FilePath -> m (Maybe UTCTime)

169+ getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))

139−

140 -- |

170 -- |

141− -- Read a file as a string

171+ -- Get the timestamp for the output files for a module. This should be the

172+ -- timestamp for the oldest modified file, or Nothing if any of the required

173+ -- output files are missing.

142 --

174 --

175+ , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)

176+ -- |

177+ -- Read the externs file for a module as a string and also return the actual

178+ -- path for the file.

143− readTextFile :: FilePath -> m String

179+ , readExterns :: ModuleName -> m (FilePath, String)

144−

145 -- |

180 -- |

146− -- Write a text file

181+ -- Run the code generator for the module and write any required output files.

147 --

182 --

148− writeTextFile :: FilePath -> String -> m ()

183+ , codegen :: CoreFn.Module CoreFn.Ann -> Environment -> SupplyVar -> Externs -> m ()

149−

150 -- |

184 -- |

151− -- Respond to a progress update

185+ -- Respond to a progress update.

152 --

186 --

153− progress :: String -> m ()

187+ , progress :: String -> m ()

188+ }

189+

190+-- |

191+-- Generated code for an externs file.

192+--

193+type Externs = String

194+

195+-- |

196+-- A value to be used in the Supply monad.

197+--

198+type SupplyVar = Integer

154

199

155-- |

200-- |

156-- Determines when to rebuild a module

201-- Determines when to rebuild a module

@@ -161,79 +206,47 @@ data RebuildPolicy

161 -- | Always rebuild this module

206 -- | Always rebuild this module

162 | RebuildAlways deriving (Show, Eq, Ord)

207 | RebuildAlways deriving (Show, Eq, Ord)

163

208

164−-- Traverse (Either e) instance (base 4.7)

165−traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)

166−traverseEither _ (Left x) = pure (Left x)

167−traverseEither f (Right y) = Right <$> f y

168−

169-- |

209-- |

170-- Compiles in "make" mode, compiling each module separately to a js files and an externs file

210-- Compiles in "make" mode, compiling each module separately to a js files and an externs file

171--

211--

172-- If timestamps have not changed, the externs file can be used to provide the module's types without

212-- If timestamps have not changed, the externs file can be used to provide the module's types without

173-- having to typecheck the module again.

213-- having to typecheck the module again.

174--

214--

175−make :: forall m. (Functor m, Applicative m, Monad m, MonadMake m)

215+make :: forall m. (Functor m, Applicative m, Monad m, MonadReader (P.Options P.Make) m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

216+ => MakeActions m

176− => FilePath -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment

217+ -> [(Either RebuildPolicy FilePath, Module)]

177−make outputDir ms prefix = do

218+ -> m Environment

178− noPrelude <- asks optionsNoPrelude

219+make MakeActions{..} ms = do

179− unless noPrelude (checkPreludeIsDefined (map snd ms))

180− let filePathMap = M.fromList (map (\(fp, Module _ mn _ _) -> (mn, fp)) ms)

181−

182− (sorted, graph) <- sortModules $ map importPrim $ if noPrelude then map snd ms else map (importPrelude . snd) ms

220+ (sorted, graph) <- sortModules $ map (importPrim . snd) ms

183−

184 mapM_ lint sorted

221 mapM_ lint sorted

185−

186 toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do

222 toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do

187− let filePath = runModuleName moduleName'

223+ inputTimestamp <- getInputTimestamp moduleName'

188−

224+ outputTimestamp <- getOutputTimestamp moduleName'

189− jsFile = outputDir </> filePath </> "index.js"

190− externsFile = outputDir </> filePath </> "externs.purs"

191− inputFile = fromMaybe (error "Module has no filename in 'make'") $ M.lookup moduleName' filePathMap

192−

193− jsTimestamp <- getTimestamp jsFile

194− externsTimestamp <- getTimestamp externsFile

195− inputTimestamp <- traverseEither getTimestamp inputFile

196−

197− return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of

225+ return $ case (inputTimestamp, outputTimestamp) of

198− (Right (Just t1), Just t2, Just t3) | t1 < min t2 t3 -> s

226+ (Right (Just t1), Just t2) | t1 < t2 -> s

199− (Left RebuildNever, Just _, Just _) -> s

227+ (Left RebuildNever, Just _) -> s

200 _ -> S.insert moduleName' s) S.empty sorted

228 _ -> S.insert moduleName' s) S.empty sorted

201

229

202 marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted

230 marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted

203−

204 (desugared, nextVar) <- runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)

231 (desugared, nextVar) <- runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)

205−

206 evalSupplyT nextVar $ go initEnvironment desugared

232 evalSupplyT nextVar $ go initEnvironment desugared

207−

208 where

233 where

234+

209 go :: Environment -> [(Bool, Module)] -> SupplyT m Environment

235 go :: Environment -> [(Bool, Module)] -> SupplyT m Environment

210 go env [] = return env

236 go env [] = return env

211 go env ((False, m) : ms') = do

237 go env ((False, m) : ms') = do

212 (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m

238 (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m

213−

214 go env' ms'

239 go env' ms'

215 go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do

240 go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do

216− let filePath = runModuleName moduleName'

217− jsFile = outputDir </> filePath </> "index.js"

218− externsFile = outputDir </> filePath </> "externs.purs"

219−

220− lift . progress $ "Compiling " ++ runModuleName moduleName'

241+ lift $ progress $ "Compiling " ++ runModuleName moduleName'

221−

222 (Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m

242 (Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m

223−

224 regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated

243 regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated

225−

226 let mod' = Module coms moduleName' regrouped exps

244 let mod' = Module coms moduleName' regrouped exps

227 corefn = CoreFn.moduleToCoreFn env' mod'

245 corefn = CoreFn.moduleToCoreFn env' mod'

228 [renamed] = renameInModules [corefn]

246 [renamed] = renameInModules [corefn]

229−

230− pjs <- prettyPrintJS <$> moduleToJs renamed

231− let js = unlines $ map ("// " ++) prefix ++ [pjs]

232− let exts = unlines $ map ("-- " ++) prefix ++ [moduleToPs mod' env']

247+ exts = moduleToPs mod' env'

233−

248+ nextVar <- fresh

234− lift $ writeTextFile jsFile js

249+ lift $ codegen renamed env' nextVar exts

235− lift $ writeTextFile externsFile exts

236−

237 go env' ms'

250 go env' ms'

238

251

239 rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

252 rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

@@ -243,18 +256,16 @@ make outputDir ms prefix = do

243 toRebuild' = toRebuild `S.union` S.fromList deps

256 toRebuild' = toRebuild `S.union` S.fromList deps

244 (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'

257 (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'

245 rebuildIfNecessary graph toRebuild (Module _ moduleName' _ _ : ms') = do

258 rebuildIfNecessary graph toRebuild (Module _ moduleName' _ _ : ms') = do

246− let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"

259+ (path, externs) <- readExterns moduleName'

247− externs <- readTextFile externsFile

248− externsModules <- fmap (map snd) . either (throwError . errorMessage . ErrorParsingExterns) return $ P.parseModulesFromFiles id [(externsFile, externs)]

260+ externsModules <- fmap (map snd) . alterErrors $ P.parseModulesFromFiles id [(path, externs)]

249 case externsModules of

261 case externsModules of

250 [m'@(Module _ moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'

262 [m'@(Module _ moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'

251− _ -> throwError . errorMessage . InvalidExternsFile $ externsFile

263+ _ -> throwError . errorMessage . InvalidExternsFile $ path

252−

264+ where

253−checkPreludeIsDefined :: (MonadWriter MultipleErrors m) => [Module] -> m ()

265+ alterErrors = flip catchError $ \(MultipleErrors errs) ->

254−checkPreludeIsDefined ms = do

266+ throwError . MultipleErrors $ flip map errs $ \e -> case e of

255− let mns = map getModuleName ms

267+ SimpleErrorWrapper (ErrorParsingModule err) -> SimpleErrorWrapper (ErrorParsingExterns err)

256− unless (preludeModuleName `elem` mns) $

268+ _ -> e

257− tell (errorMessage PreludeNotPresent)

258

269

259reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]

270reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]

260reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

271reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

@@ -277,11 +288,5 @@ addDefaultImport toImport m@(Module coms mn decls exps) =

277importPrim :: Module -> Module

288importPrim :: Module -> Module

278importPrim = addDefaultImport (ModuleName [ProperName C.prim])

289importPrim = addDefaultImport (ModuleName [ProperName C.prim])

279

290

280−preludeModuleName :: ModuleName

281−preludeModuleName = ModuleName [ProperName C.prelude]

282−

283−importPrelude :: Module -> Module

284−importPrelude = addDefaultImport preludeModuleName

285−

286version :: Version

291version :: Version

287version = Paths.version

292version = Paths.version

src/Language/PureScript/AST/Declarations.hs+3−4

@@ -26,7 +26,6 @@ import Language.PureScript.Names

26import Language.PureScript.Kinds

26import Language.PureScript.Kinds

27import Language.PureScript.TypeClassDictionaries

27import Language.PureScript.TypeClassDictionaries

28import Language.PureScript.Comments

28import Language.PureScript.Comments

29−import Language.PureScript.CodeGen.JS.AST

30import Language.PureScript.Environment

29import Language.PureScript.Environment

31

30

32-- |

31-- |

@@ -122,9 +121,9 @@ data Declaration

122 --

121 --

123 | BindingGroupDeclaration [(Ident, NameKind, Expr)]

122 | BindingGroupDeclaration [(Ident, NameKind, Expr)]

124 -- |

123 -- |

125− -- A foreign import declaration (type, name, optional inline Javascript, type)

124+ -- A foreign import declaration (name, type)

126 --

125 --

127− | ExternDeclaration ForeignImportType Ident (Maybe JS) Type

126+ | ExternDeclaration Ident Type

128 -- |

127 -- |

129 -- A data type foreign import (name, kind)

128 -- A data type foreign import (name, kind)

130 --

129 --

@@ -255,7 +254,7 @@ data Expr

255 --

254 --

256 | StringLiteral String

255 | StringLiteral String

257 -- |

256 -- |

258− -- A character literal

257+ -- A character literal

259 --

258 --

260 | CharLiteral Char

259 | CharLiteral Char

261 -- |

260 -- |

src/Language/PureScript/AST/Exported.hs+1−1

@@ -109,7 +109,7 @@ isExported (Just exps) decl = any (matches decl) exps

109 where

109 where

110 matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'

110 matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'

111 matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'

111 matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'

112− matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'

112+ matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'

113 matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'

113 matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'

114 matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'

114 matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'

115 matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'

115 matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'

src/Language/PureScript/AST/Traversals.hs+1−1

@@ -387,7 +387,7 @@ accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder

387accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)

387accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)

388 where

388 where

389 forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)

389 forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)

390− forDecls (ExternDeclaration _ _ _ ty) = f ty

390+ forDecls (ExternDeclaration _ ty) = f ty

391 forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

391 forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

392 forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)

392 forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)

393 forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

393 forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)

src/Language/PureScript/CodeGen/Externs.hs+4−4

@@ -24,13 +24,13 @@ import qualified Data.Map as M

24import Control.Monad.Writer

24import Control.Monad.Writer

25

25

26import Language.PureScript.AST

26import Language.PureScript.AST

27+import Language.PureScript.Comments

27import Language.PureScript.Environment

28import Language.PureScript.Environment

28import Language.PureScript.Kinds

29import Language.PureScript.Kinds

29import Language.PureScript.Names

30import Language.PureScript.Names

30import Language.PureScript.Pretty

31import Language.PureScript.Pretty

31import Language.PureScript.TypeClassDictionaries

32import Language.PureScript.TypeClassDictionaries

32import Language.PureScript.Types

33import Language.PureScript.Types

33−import Language.PureScript.Comments

34

34

35-- |

35-- |

36-- Generate foreign imports for all declarations in a module

36-- Generate foreign imports for all declarations in a module

@@ -54,7 +54,7 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri

54 exportsOp (PositionedDeclarationRef _ _ r) = exportsOp r

54 exportsOp (PositionedDeclarationRef _ _ r) = exportsOp r

55 exportsOp (ValueRef ident') = ident' == Op op

55 exportsOp (ValueRef ident') = ident' == Op op

56 exportsOp _ = False

56 exportsOp _ = False

57− declToPs (PositionedDeclaration _ com d) = mapM commentToPs com >> declToPs d

57+ declToPs (PositionedDeclaration _ com d) = mapM_ commentToPs com >> declToPs d

58 declToPs _ = return ()

58 declToPs _ = return ()

59

59

60 commentToPs :: Comment -> Writer [String] ()

60 commentToPs :: Comment -> Writer [String] ()

@@ -63,7 +63,7 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri

63

63

64 exportToPs :: DeclarationRef -> Writer [String] ()

64 exportToPs :: DeclarationRef -> Writer [String] ()

65 exportToPs (PositionedDeclarationRef _ _ r) = exportToPs r

65 exportToPs (PositionedDeclarationRef _ _ r) = exportToPs r

66− exportToPs (TypeRef pn dctors) = do

66+ exportToPs (TypeRef pn dctors) =

67 case Qualified (Just moduleName) pn `M.lookup` types env of

67 case Qualified (Just moduleName) pn `M.lookup` types env of

68 Nothing -> error $ show pn ++ " has no kind in exportToPs"

68 Nothing -> error $ show pn ++ " has no kind in exportToPs"

69 Just (kind, ExternData) ->

69 Just (kind, ExternData) ->

@@ -90,7 +90,7 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri

90 exportToPs (ValueRef ident) =

90 exportToPs (ValueRef ident) =

91 case (moduleName, ident) `M.lookup` names env of

91 case (moduleName, ident) `M.lookup` names env of

92 Nothing -> error $ show ident ++ " has no type in exportToPs"

92 Nothing -> error $ show ident ++ " has no type in exportToPs"

93− Just (ty, nameKind, _) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->

93+ Just (ty, nk, _) | nk == Public || nk == External ->

94 tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]

94 tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]

95 _ -> return ()

95 _ -> return ()

96 exportToPs (TypeClassRef className) =

96 exportToPs (TypeClassRef className) =

src/Language/PureScript/CodeGen/JS.hs+27−12

@@ -18,14 +18,14 @@

18{-# LANGUAGE FlexibleContexts #-}

18{-# LANGUAGE FlexibleContexts #-}

19{-# LANGUAGE ScopedTypeVariables #-}

19{-# LANGUAGE ScopedTypeVariables #-}

20

20

21−module Language.PureScript.CodeGen.JS (

21+module Language.PureScript.CodeGen.JS

22− module AST,

22+ ( module AST

23− module Common,

23+ , module Common

24− moduleToJs

24+ , moduleToJs

25+ , mainCall

25−) where

26+ ) where

26

27

27−import Data.List ((\\), delete)

28+import Data.List ((\\), delete, intersect)

28−import Data.Maybe (mapMaybe)

29import qualified Data.Traversable as T (traverse)

29import qualified Data.Traversable as T (traverse)

30

30

31import Control.Applicative

31import Control.Applicative

@@ -49,19 +49,22 @@ import qualified Language.PureScript.Constants as C

49-- module.

49-- module.

50--

50--

51moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)

51moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)

52− => Module Ann -> m [JS]

52+ => Module Ann -> Maybe JS -> m [JS]

53−moduleToJs (Module coms mn imps exps foreigns decls) = do

53+moduleToJs (Module coms mn imps exps foreigns decls) foreign = do

54 additional <- asks optionsAdditional

54 additional <- asks optionsAdditional

55 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps

55 jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps

56− let foreigns' = mapMaybe (\(_, js, _) -> js) foreigns

57 jsDecls <- mapM bindToJs decls

56 jsDecls <- mapM bindToJs decls

58 optimized <- T.traverse (T.traverse optimize) jsDecls

57 optimized <- T.traverse (T.traverse optimize) jsDecls

59 let isModuleEmpty = null exps

58 let isModuleEmpty = null exps

60 comments <- not <$> asks optionsNoComments

59 comments <- not <$> asks optionsNoComments

61 let strict = JSStringLiteral "use strict"

60 let strict = JSStringLiteral "use strict"

62 let header = if comments && not (null coms) then JSComment coms strict else strict

61 let header = if comments && not (null coms) then JSComment coms strict else strict

62+ let foreign' = [JSVariableIntroduction "$foreign" foreign | not $ null foreigns || foreign == Nothing]

63− let moduleBody = header : jsImports ++ foreigns' ++ concat optimized

63+ let moduleBody = header : foreign' ++ jsImports ++ concat optimized

64+ let foreignExps = exps `intersect` (fst `map` foreigns)

65+ let standardExps = exps \\ foreignExps

64− let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) exps

66+ let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps

67+ ++ map (runIdent &&& foreignIdent) foreignExps

65 return $ case additional of

68 return $ case additional of

66 MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']

69 MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']

67 CompileOptions ns _ _ | not isModuleEmpty ->

70 CompileOptions ns _ _ | not isModuleEmpty ->

@@ -171,6 +174,12 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do

171 unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])

174 unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])

172 unApp (App _ val arg) args = unApp val (arg : args)

175 unApp (App _ val arg) args = unApp val (arg : args)

173 unApp other args = (other, args)

176 unApp other args = (other, args)

177+ valueToJs (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =

178+ return $ if mn' == mn

179+ then foreignIdent ident

180+ else varToJs qi

181+ valueToJs (Var (_, _, _, Just IsForeign) ident) =

182+ error $ "Encountered an unqualified reference to a foreign ident " ++ show ident

174 valueToJs (Var _ ident) =

183 valueToJs (Var _ ident) =

175 return $ varToJs ident

184 return $ varToJs ident

176 valueToJs (Case (maybeSpan, _, _, _) values binders) = do

185 valueToJs (Case (maybeSpan, _, _, _) values binders) = do

@@ -247,6 +256,9 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do

247 qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (JSVar (moduleNameToJs mn'))

256 qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (JSVar (moduleNameToJs mn'))

248 qualifiedToJS f (Qualified _ a) = JSVar $ identToJs (f a)

257 qualifiedToJS f (Qualified _ a) = JSVar $ identToJs (f a)

249

258

259+ foreignIdent :: Ident -> JS

260+ foreignIdent ident = accessorString (runIdent ident) (JSVar "$foreign")

261+

250 -- |

262 -- |

251 -- Generate code in the simplified Javascript intermediate representation for pattern match binders

263 -- Generate code in the simplified Javascript intermediate representation for pattern match binders

252 -- and guards.

264 -- and guards.

@@ -352,3 +364,6 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do

352 done'' <- go done' (index + 1) bs'

364 done'' <- go done' (index + 1) bs'

353 js <- binderToJs elVar done'' binder

365 js <- binderToJs elVar done'' binder

354 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)

366 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)

367+

368+mainCall :: ModuleName -> String -> JS

369+mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []

src/Language/PureScript/CoreFn/Desugar.hs+13−4

@@ -102,7 +102,7 @@ moduleToCoreFn env (A.Module coms mn decls (Just exps)) =

102 exprToCoreFn ss com ty (A.App v1 v2) =

102 exprToCoreFn ss com ty (A.App v1 v2) =

103 App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)

103 App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)

104 exprToCoreFn ss com ty (A.Var ident) =

104 exprToCoreFn ss com ty (A.Var ident) =

105− Var (ss, com, ty, Nothing) ident

105+ Var (ss, com, ty, getValueMeta ident) ident

106 exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =

106 exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =

107 Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]

107 Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]

108 [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]

108 [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]

@@ -167,6 +167,15 @@ moduleToCoreFn env (A.Module coms mn decls (Just exps)) =

167 binderToCoreFn _ com (A.PositionedBinder ss com1 b) =

167 binderToCoreFn _ com (A.PositionedBinder ss com1 b) =

168 binderToCoreFn (Just ss) (com ++ com1) b

168 binderToCoreFn (Just ss) (com ++ com1) b

169

169

170+ -- |

171+ -- Gets metadata for values.

172+ --

173+ getValueMeta :: Qualified Ident -> Maybe Meta

174+ getValueMeta name =

175+ case lookupValue env name of

176+ Just (_, External, _) -> Just IsForeign

177+ _ -> Nothing

178+

170 -- |

179 -- |

171 -- Gets metadata for data constructors.

180 -- Gets metadata for data constructors.

172 --

181 --

@@ -198,7 +207,7 @@ findQualModules decls =

198 fqValues (A.Var (Qualified (Just mn) _)) = [mn]

207 fqValues (A.Var (Qualified (Just mn) _)) = [mn]

199 fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]

208 fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]

200 fqValues _ = []

209 fqValues _ = []

201−

210+

202 fqBinders :: A.Binder -> [ModuleName]

211 fqBinders :: A.Binder -> [ModuleName]

203 fqBinders (A.ConstructorBinder (Qualified (Just mn) _) _) = [mn]

212 fqBinders (A.ConstructorBinder (Qualified (Just mn) _) _) = [mn]

204 fqBinders _ = []

213 fqBinders _ = []

@@ -215,8 +224,8 @@ importToCoreFn _ = Nothing

215-- Desugars foreign declarations from AST to CoreFn representation.

224-- Desugars foreign declarations from AST to CoreFn representation.

216--

225--

217externToCoreFn :: A.Declaration -> Maybe ForeignDecl

226externToCoreFn :: A.Declaration -> Maybe ForeignDecl

218−externToCoreFn (A.ExternDeclaration _ name js ty) = Just (name, js, ty)

227+externToCoreFn (A.ExternDeclaration name ty) = Just (name, ty)

219−externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, Nothing, tyObject)

228+externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, tyObject)

220externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d

229externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d

221externToCoreFn _ = Nothing

230externToCoreFn _ = Nothing

222

231

src/Language/PureScript/CoreFn/Meta.hs+5−1

@@ -35,7 +35,11 @@ data Meta

35 -- |

35 -- |

36 -- The contained value is a typeclass dictionary constructor

36 -- The contained value is a typeclass dictionary constructor

37 --

37 --

38− | IsTypeClassConstructor deriving (Show, D.Data, D.Typeable)

38+ | IsTypeClassConstructor

39+ -- |

40+ -- The contained reference is for a foreign member

41+ --

42+ | IsForeign deriving (Show, D.Data, D.Typeable)

39

43

40-- |

44-- |

41-- Data constructor metadata

45-- Data constructor metadata

src/Language/PureScript/CoreFn/Module.hs+1−2

@@ -14,7 +14,6 @@

14

14

15module Language.PureScript.CoreFn.Module where

15module Language.PureScript.CoreFn.Module where

16

16

17−import Language.PureScript.CodeGen.JS.AST

18import Language.PureScript.Comments

17import Language.PureScript.Comments

19import Language.PureScript.CoreFn.Expr

18import Language.PureScript.CoreFn.Expr

20import Language.PureScript.Names

19import Language.PureScript.Names

@@ -29,4 +28,4 @@ data Module a = Module

29 , moduleDecls :: [Bind a]

28 , moduleDecls :: [Bind a]

30 } deriving (Show)

29 } deriving (Show)

31

30

32−type ForeignDecl = (Ident, Maybe JS, Type)

31+type ForeignDecl = (Ident, Type)

src/Language/PureScript/DeadCodeElimination.hs+1−1

@@ -50,7 +50,7 @@ bindIdents (Rec names) = map fst names

50-- Extract the ident for a foreign declaration.

50-- Extract the ident for a foreign declaration.

51--

51--

52foreignIdent :: ForeignDecl -> Ident

52foreignIdent :: ForeignDecl -> Ident

53−foreignIdent (name, _, _) = name

53+foreignIdent = fst

54

54

55-- |

55-- |

56-- Key type to use in graph

56-- Key type to use in graph

src/Language/PureScript/Docs/ParseAndDesugar.hs+2−6

@@ -16,14 +16,13 @@ import Control.Monad.IO.Class (MonadIO(..))

16

16

17import Web.Bower.PackageMeta (PackageName)

17import Web.Bower.PackageMeta (PackageName)

18

18

19−import qualified Text.Parsec as Parsec

20import qualified Language.PureScript as P

19import qualified Language.PureScript as P

21import qualified Language.PureScript.Constants as C

20import qualified Language.PureScript.Constants as C

22import Language.PureScript.Docs.Types

21import Language.PureScript.Docs.Types

23import Language.PureScript.Docs.Render

22import Language.PureScript.Docs.Render

24

23

25data ParseDesugarError

24data ParseDesugarError

26− = ParseError Parsec.ParseError

25+ = ParseError P.MultipleErrors

27 | SortModulesError P.MultipleErrors

26 | SortModulesError P.MultipleErrors

28 | DesugarError P.MultipleErrors

27 | DesugarError P.MultipleErrors

29 deriving (Show)

28 deriving (Show)

@@ -58,7 +57,7 @@ parseAndDesugar inputFiles depsFiles callback = do

58 ms <- throwLeft ParseError eParsed

57 ms <- throwLeft ParseError eParsed

59

58

60 let depsModules = getDepsModuleNames (map (\(fp, m) -> (,m) <$> fp) ms)

59 let depsModules = getDepsModuleNames (map (\(fp, m) -> (,m) <$> fp) ms)

61− let eSorted = P.sortModules . map (importPrim . importPrelude . snd) $ ms

60+ let eSorted = P.sortModules . map (importPrim . snd) $ ms

62 (ms', _) <- throwLeft SortModulesError eSorted

61 (ms', _) <- throwLeft SortModulesError eSorted

63

62

64 modules <- throwLeft DesugarError (desugar ms')

63 modules <- throwLeft DesugarError (desugar ms')

@@ -94,9 +93,6 @@ addDefaultImport toImport m@(P.Module coms mn decls exps) =

94importPrim :: P.Module -> P.Module

93importPrim :: P.Module -> P.Module

95importPrim = addDefaultImport (P.ModuleName [P.ProperName C.prim])

94importPrim = addDefaultImport (P.ModuleName [P.ProperName C.prim])

96

95

97−importPrelude :: P.Module -> P.Module

98−importPrelude = addDefaultImport (P.ModuleName [P.ProperName C.prelude])

99−

100desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]

96desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]

101desugar = P.evalSupplyT 0 . desugar'

97desugar = P.evalSupplyT 0 . desugar'

102 where

98 where

src/Language/PureScript/Docs/Render.hs+2−2

@@ -74,7 +74,7 @@ groupChildren (partitionEithers -> (children, toplevels)) =

74

74

75getDeclarationTitle :: P.Declaration -> Maybe String

75getDeclarationTitle :: P.Declaration -> Maybe String

76getDeclarationTitle (P.TypeDeclaration name _) = Just (show name)

76getDeclarationTitle (P.TypeDeclaration name _) = Just (show name)

77−getDeclarationTitle (P.ExternDeclaration _ name _ _) = Just (show name)

77+getDeclarationTitle (P.ExternDeclaration name _) = Just (show name)

78getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (show name)

78getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (show name)

79getDeclarationTitle (P.ExternDataDeclaration name _) = Just (show name)

79getDeclarationTitle (P.ExternDataDeclaration name _) = Just (show name)

80getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (show name)

80getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (show name)

@@ -93,7 +93,7 @@ renderDeclaration (P.TypeDeclaration ident' ty) title =

93 code = ident (show ident')

93 code = ident (show ident')

94 <> sp <> syntax "::" <> sp

94 <> sp <> syntax "::" <> sp

95 <> renderType ty

95 <> renderType ty

96−renderDeclaration (P.ExternDeclaration _ ident' _ ty) title =

96+renderDeclaration (P.ExternDeclaration ident' ty) title =

97 basicDeclaration title code

97 basicDeclaration title code

98 where

98 where

99 code = ident (show ident')

99 code = ident (show ident')

src/Language/PureScript/Environment.hs+16−32

@@ -62,19 +62,6 @@ data Environment = Environment {

62initEnvironment :: Environment

62initEnvironment :: Environment

63initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty M.empty

63initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty M.empty

64

64

65−-- |

66−-- The type of a foreign import

67−--

68−data ForeignImportType

69− -- |

70− -- A regular foreign import

71− --

72− = ForeignImport

73− -- |

74− -- A foreign import which contains inline Javascript as a string literal

75− --

76− | InlineJavascript deriving (Show, Eq, Data, Typeable)

77−

78-- |

65-- |

79-- The visibility of a name in scope

66-- The visibility of a name in scope

80--

67--

@@ -89,33 +76,23 @@ data NameVisibility

89 | Defined deriving (Show, Eq)

76 | Defined deriving (Show, Eq)

90

77

91-- |

78-- |

92−-- The kind of a name

79+-- A flag for whether a name is for an private or public value - only public values will be

80+-- included in a generated externs file.

93--

81--

94data NameKind

82data NameKind

95 -- |

83 -- |

96− -- A value introduced as a binding in a module

84+ -- A private value introduced as an artifact of code generation (class instances, class member

97− --

85+ -- accessors, etc.)

98− = Value

99− -- |

100− -- A type class dictionary member accessor import, generated during desugaring of type class declarations

101− --

102− | TypeClassAccessorImport

103− -- |

104− -- A foreign import

105− --

106− | Extern ForeignImportType

107− -- |

108− -- A local name introduced using a lambda abstraction, variable introduction or binder

109 --

86 --

110− | LocalVariable

87+ = Private

111 -- |

88 -- |

112− -- A data constructor

89+ -- A public value for a module member or foreing import declaration

113 --

90 --

114− | DataConstructor

91+ | Public

115 -- |

92 -- |

116− -- A type class dictionary, generated during desugaring of type class declarations

93+ -- A name for member introduced by foreign import

117 --

94 --

118− | TypeInstanceDictionaryValue deriving (Show, Eq, Data, Typeable)

95+ | External deriving (Show, Eq, Data, Typeable)

119

96

120-- |

97-- |

121-- The kinds of a type

98-- The kinds of a type

@@ -261,3 +238,10 @@ isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool

261isNewtypeConstructor e ctor = case lookupConstructor e ctor of

238isNewtypeConstructor e ctor = case lookupConstructor e ctor of

262 (Newtype, _, _, _) -> True

239 (Newtype, _, _, _) -> True

263 (Data, _, _, _) -> False

240 (Data, _, _, _) -> False

241+

242+-- |

243+-- Finds information about values from the current environment.

244+--

245+lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)

246+lookupValue env (Qualified (Just mn) ident) = (mn, ident) `M.lookup` names env

247+lookupValue _ _ = Nothing

src/Language/PureScript/Errors.hs+299−201

@@ -51,7 +51,11 @@ import qualified Text.Parsec as P

51--

51--

52data SimpleErrorMessage

52data SimpleErrorMessage

53 = ErrorParsingExterns P.ParseError

53 = ErrorParsingExterns P.ParseError

54− | ErrorParsingPrelude P.ParseError

54+ | ErrorParsingFFIModule FilePath

55+ | ErrorParsingModule P.ParseError

56+ | MissingFFIModule ModuleName

57+ | MultipleFFIModules ModuleName [FilePath]

58+ | UnnecessaryFFIModule ModuleName FilePath

55 | InvalidExternsFile FilePath

59 | InvalidExternsFile FilePath

56 | CannotGetFileInfo FilePath

60 | CannotGetFileInfo FilePath

57 | CannotReadFile FilePath

61 | CannotReadFile FilePath

@@ -115,13 +119,12 @@ data SimpleErrorMessage

115 | TransitiveExportError DeclarationRef [DeclarationRef]

119 | TransitiveExportError DeclarationRef [DeclarationRef]

116 | ShadowedName Ident

120 | ShadowedName Ident

117 | WildcardInferredType Type

121 | WildcardInferredType Type

118− | PreludeNotPresent

119 deriving (Show)

122 deriving (Show)

120

123

121-- |

124-- |

122-- Wrapper of simpler errors

125-- Wrapper of simpler errors

123--

126--

124−data ErrorMessage

127+data ErrorMessage

125 = NotYetDefined [Ident] ErrorMessage

128 = NotYetDefined [Ident] ErrorMessage

126 | ErrorUnifyingTypes Type Type ErrorMessage

129 | ErrorUnifyingTypes Type Type ErrorMessage

127 | ErrorInExpression Expr ErrorMessage

130 | ErrorInExpression Expr ErrorMessage

@@ -142,10 +145,10 @@ data ErrorMessage

142 | PositionedError SourceSpan ErrorMessage

145 | PositionedError SourceSpan ErrorMessage

143 | SimpleErrorWrapper SimpleErrorMessage

146 | SimpleErrorWrapper SimpleErrorMessage

144 deriving (Show)

147 deriving (Show)

145−

148+

146instance UnificationError Type ErrorMessage where

149instance UnificationError Type ErrorMessage where

147 occursCheckFailed t = SimpleErrorWrapper $ InfiniteType t

150 occursCheckFailed t = SimpleErrorWrapper $ InfiniteType t

148−

151+

149instance UnificationError Kind ErrorMessage where

152instance UnificationError Kind ErrorMessage where

150 occursCheckFailed k = SimpleErrorWrapper $ InfiniteKind k

153 occursCheckFailed k = SimpleErrorWrapper $ InfiniteKind k

151

154

@@ -155,7 +158,11 @@ instance UnificationError Kind ErrorMessage where

155errorCode :: ErrorMessage -> String

158errorCode :: ErrorMessage -> String

156errorCode em = case unwrapErrorMessage em of

159errorCode em = case unwrapErrorMessage em of

157 (ErrorParsingExterns _) -> "ErrorParsingExterns"

160 (ErrorParsingExterns _) -> "ErrorParsingExterns"

158− (ErrorParsingPrelude _) -> "ErrorParsingPrelude"

161+ (ErrorParsingFFIModule _) -> "ErrorParsingFFIModule"

162+ (ErrorParsingModule _) -> "ErrorParsingModule"

163+ MissingFFIModule{} -> "MissingFFIModule"

164+ MultipleFFIModules{} -> "MultipleFFIModules"

165+ UnnecessaryFFIModule{} -> "UnnecessaryFFIModule"

159 (InvalidExternsFile _) -> "InvalidExternsFile"

166 (InvalidExternsFile _) -> "InvalidExternsFile"

160 (CannotGetFileInfo _) -> "CannotGetFileInfo"

167 (CannotGetFileInfo _) -> "CannotGetFileInfo"

161 (CannotReadFile _) -> "CannotReadFile"

168 (CannotReadFile _) -> "CannotReadFile"

@@ -219,17 +226,16 @@ errorCode em = case unwrapErrorMessage em of

219 (TransitiveExportError _ _) -> "TransitiveExportError"

226 (TransitiveExportError _ _) -> "TransitiveExportError"

220 (ShadowedName _) -> "ShadowedName"

227 (ShadowedName _) -> "ShadowedName"

221 (WildcardInferredType _) -> "WildcardInferredType"

228 (WildcardInferredType _) -> "WildcardInferredType"

222− PreludeNotPresent -> "PreludeNotPresent"

223

229

224-- |

230-- |

225-- A stack trace for an error

231-- A stack trace for an error

226--

232--

227−newtype MultipleErrors = MultipleErrors

233+newtype MultipleErrors = MultipleErrors

228 { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)

234 { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)

229−

235+

230instance UnificationError Type MultipleErrors where

236instance UnificationError Type MultipleErrors where

231 occursCheckFailed = occursCheckFailed

237 occursCheckFailed = occursCheckFailed

232−

238+

233instance UnificationError Kind MultipleErrors where

239instance UnificationError Kind MultipleErrors where

234 occursCheckFailed = occursCheckFailed

240 occursCheckFailed = occursCheckFailed

235

241

@@ -288,7 +294,7 @@ unwrapErrorMessage em = case em of

288 (SimpleErrorWrapper sem) -> sem

294 (SimpleErrorWrapper sem) -> sem

289

295

290replaceUnknowns :: Type -> State UnknownMap Type

296replaceUnknowns :: Type -> State UnknownMap Type

291−replaceUnknowns = everywhereOnTypesM replaceTypes

297+replaceUnknowns = everywhereOnTypesM replaceTypes

292 where

298 where

293 lookupTable :: (LabelType, Unknown) -> UnknownMap -> (Unknown, UnknownMap)

299 lookupTable :: (LabelType, Unknown) -> UnknownMap -> (Unknown, UnknownMap)

294 lookupTable x m = case M.lookup x m of

300 lookupTable x m = case M.lookup x m of

@@ -348,195 +354,287 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag

348 where

354 where

349 wikiUri :: String

355 wikiUri :: String

350 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e

356 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e

351−

357+

352 go :: ErrorMessage -> Box.Box

358 go :: ErrorMessage -> Box.Box

353− goSimple (CannotGetFileInfo path) = paras [ line "Unable to read file info: "

359+ goSimple (CannotGetFileInfo path) =

360+ paras [ line "Unable to read file info: "

354− , indent . line $ path

361+ , indent . line $ path

355− ]

362+ ]

356− goSimple (CannotReadFile path) = paras [ line "Unable to read file: "

363+ goSimple (CannotReadFile path) =

364+ paras [ line "Unable to read file: "

357− , indent . line $ path

365+ , indent . line $ path

358− ]

366+ ]

359− goSimple (CannotWriteFile path) = paras [ line "Unable to write file: "

367+ goSimple (CannotWriteFile path) =

368+ paras [ line "Unable to write file: "

360− , indent . line $ path

369+ , indent . line $ path

361− ]

370+ ]

371+ goSimple (ErrorParsingExterns err) =

362− goSimple (ErrorParsingExterns err) = paras [ line "Error parsing externs files: "

372+ paras [ line "Error parsing externs files: "

363− , indent . line . show $ err

373+ , indent . line . show $ err

374+ ]

375+ goSimple (ErrorParsingFFIModule path) =

376+ paras [ line "Unable to parse module from FFI file: "

377+ , indent . line $ path

364− ]

378+ ]

365− goSimple (ErrorParsingPrelude err) = paras [ line "Error parsing prelude: "

379+ goSimple (ErrorParsingModule err) =

380+ paras [ line "Unable to parse module: "

366− , indent . line . show $ err

381+ , indent . line . show $ err

367− ]

382+ ]

383+ goSimple (MissingFFIModule mn) =

384+ line $ "Missing FFI implementations for module " ++ show mn

385+ goSimple (UnnecessaryFFIModule mn path) =

386+ paras [ line $ "Unnecessary FFI implementations have been provided for module " ++ show mn ++ ": "

387+ , indent . line $ path

388+ ]

389+ goSimple (MultipleFFIModules mn paths) =

390+ paras $ [ line $ "Multiple FFI implementations have been provided for module " ++ show mn ++ ": " ]

391+ ++ map (indent . line) paths

392+ goSimple (InvalidExternsFile path) =

368− goSimple (InvalidExternsFile path) = paras [ line "Externs file is invalid: "

393+ paras [ line "Externs file is invalid: "

369− , indent . line $ path

394+ , indent . line $ path

370− ]

395+ ]

396+ goSimple InvalidDoBind =

371− goSimple InvalidDoBind = line "Bind statement cannot be the last statement in a do block"

397+ line "Bind statement cannot be the last statement in a do block"

398+ goSimple InvalidDoLet =

372− goSimple InvalidDoLet = line "Let statement cannot be the last statement in a do block"

399+ line "Let statement cannot be the last statement in a do block"

373− goSimple CannotReorderOperators = line "Unable to reorder operators"

400+ goSimple CannotReorderOperators =

401+ line "Unable to reorder operators"

402+ goSimple UnspecifiedSkolemScope =

374− goSimple UnspecifiedSkolemScope = line "Skolem variable scope is unspecified"

403+ line "Skolem variable scope is unspecified"

404+ goSimple OverlappingNamesInLet =

375− goSimple OverlappingNamesInLet = line "Overlapping names in let binding."

405+ line "Overlapping names in let binding."

406+ goSimple (InfiniteType ty) =

376− goSimple (InfiniteType ty) = paras [ line "Infinite type detected: "

407+ paras [ line "Infinite type detected: "

377− , indent $ line $ prettyPrintType ty

408+ , indent $ line $ prettyPrintType ty

378− ]

409+ ]

410+ goSimple (InfiniteKind ki) =

379− goSimple (InfiniteKind ki) = paras [ line "Infinite kind detected: "

411+ paras [ line "Infinite kind detected: "

380− , indent $ line $ prettyPrintKind ki

412+ , indent $ line $ prettyPrintKind ki

381− ]

413+ ]

414+ goSimple (MultipleFixities name) =

382− goSimple (MultipleFixities name) = line $ "Multiple fixity declarations for " ++ show name

415+ line $ "Multiple fixity declarations for " ++ show name

416+ goSimple (OrphanTypeDeclaration nm) =

383− goSimple (OrphanTypeDeclaration nm) = line $ "Orphan type declaration for " ++ show nm

417+ line $ "Orphan type declaration for " ++ show nm

418+ goSimple (OrphanFixityDeclaration op) =

384− goSimple (OrphanFixityDeclaration op) = line $ "Orphan fixity declaration for " ++ show op

419+ line $ "Orphan fixity declaration for " ++ show op

420+ goSimple (RedefinedModule name) =

385− goSimple (RedefinedModule name) = line $ "Module " ++ show name ++ " has been defined multiple times"

421+ line $ "Module " ++ show name ++ " has been defined multiple times"

422+ goSimple (RedefinedIdent name) =

386− goSimple (RedefinedIdent name) = line $ "Name " ++ show name ++ " has been defined multiple times"

423+ line $ "Name " ++ show name ++ " has been defined multiple times"

387− goSimple (UnknownModule mn) = line $ "Unknown module " ++ show mn

424+ goSimple (UnknownModule mn) =

425+ line $ "Unknown module " ++ show mn

388− goSimple (UnknownType name) = line $ "Unknown type " ++ show name

426+ goSimple (UnknownType name) =

427+ line $ "Unknown type " ++ show name

389− goSimple (UnknownTypeClass name) = line $ "Unknown type class " ++ show name

428+ goSimple (UnknownTypeClass name) =

429+ line $ "Unknown type class " ++ show name

390− goSimple (UnknownValue name) = line $ "Unknown value " ++ show name

430+ goSimple (UnknownValue name) =

431+ line $ "Unknown value " ++ show name

391− goSimple (UnknownTypeConstructor name) = line $ "Unknown type constructor " ++ show name

432+ goSimple (UnknownTypeConstructor name) =

433+ line $ "Unknown type constructor " ++ show name

434+ goSimple (UnknownDataConstructor dc tc) =

392− goSimple (UnknownDataConstructor dc tc) = line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc

435+ line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc

436+ goSimple (ConflictingImport nm mn) =

393− goSimple (ConflictingImport nm mn) = line $ "Cannot declare `" ++ nm ++ "` since another declaration of that name was imported from `" ++ show mn ++ "`"

437+ line $ "Cannot declare `" ++ nm ++ "` since another declaration of that name was imported from `" ++ show mn ++ "`"

438+ goSimple (ConflictingImports nm m1 m2) =

394− goSimple (ConflictingImports nm m1 m2) = line $ "Conflicting imports for " ++ nm ++ " from modules " ++ show m1 ++ " and " ++ show m2

439+ line $ "Conflicting imports for " ++ nm ++ " from modules " ++ show m1 ++ " and " ++ show m2

440+ goSimple (ConflictingTypeDecls nm) =

395− goSimple (ConflictingTypeDecls nm) = line $ "Conflicting type declarations for " ++ show nm

441+ line $ "Conflicting type declarations for " ++ show nm

442+ goSimple (ConflictingCtorDecls nm) =

396− goSimple (ConflictingCtorDecls nm) = line $ "Conflicting data constructor declarations for " ++ show nm

443+ line $ "Conflicting data constructor declarations for " ++ show nm

444+ goSimple (TypeConflictsWithClass nm) =

397− goSimple (TypeConflictsWithClass nm) = line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"

445+ line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"

446+ goSimple (CtorConflictsWithClass nm) =

398− goSimple (CtorConflictsWithClass nm) = line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"

447+ line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"

448+ goSimple (ClassConflictsWithType nm) =

399− goSimple (ClassConflictsWithType nm) = line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"

449+ line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"

450+ goSimple (ClassConflictsWithCtor nm) =

400− goSimple (ClassConflictsWithCtor nm) = line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"

451+ line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"

452+ goSimple (DuplicateClassExport nm) =

401− goSimple (DuplicateClassExport nm) = line $ "Duplicate export declaration for type class " ++ show nm

453+ line $ "Duplicate export declaration for type class " ++ show nm

454+ goSimple (DuplicateValueExport nm) =

402− goSimple (DuplicateValueExport nm) = line $ "Duplicate export declaration for value " ++ show nm

455+ line $ "Duplicate export declaration for value " ++ show nm

456+ goSimple (CycleInDeclaration nm) =

403− goSimple (CycleInDeclaration nm) = line $ "Cycle in declaration of " ++ show nm

457+ line $ "Cycle in declaration of " ++ show nm

458+ goSimple (CycleInModules mns) =

404− goSimple (CycleInModules mns) = line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)

459+ line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)

460+ goSimple (CycleInTypeSynonym pn) =

405− goSimple (CycleInTypeSynonym pn) = line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn

461+ line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn

406− goSimple (NameIsUndefined ident) = line $ show ident ++ " is undefined"

462+ goSimple (NameIsUndefined ident) =

463+ line $ show ident ++ " is undefined"

464+ goSimple (NameNotInScope ident) =

407− goSimple (NameNotInScope ident) = line $ show ident ++ " may not be defined in the current scope"

465+ line $ show ident ++ " may not be defined in the current scope"

466+ goSimple (UndefinedTypeVariable name) =

408− goSimple (UndefinedTypeVariable name) = line $ "Type variable " ++ show name ++ " is undefined"

467+ line $ "Type variable " ++ show name ++ " is undefined"

468+ goSimple (PartiallyAppliedSynonym name) =

409− goSimple (PartiallyAppliedSynonym name) = line $ "Partially applied type synonym " ++ show name

469+ line $ "Partially applied type synonym " ++ show name

470+ goSimple (EscapedSkolem binding) =

410− goSimple (EscapedSkolem binding) = paras $ [ line "Rigid/skolem type variable has escaped." ]

471+ paras $ [ line "Rigid/skolem type variable has escaped." ]

411− <> foldMap (\expr -> [ line "Relevant expression: "

472+ <> foldMap (\expr -> [ line "Relevant expression: "

412− , indent $ line $ prettyPrintValue expr

473+ , indent $ line $ prettyPrintValue expr

413− ]) binding

474+ ]) binding

414− goSimple (TypesDoNotUnify t1 t2) = paras [ line "Cannot unify type"

475+ goSimple (TypesDoNotUnify t1 t2)

476+ = paras [ line "Cannot unify type"

415− , indent $ line $ prettyPrintType t1

477+ , indent $ line $ prettyPrintType t1

416− , line "with type"

478+ , line "with type"

417− , indent $ line $ prettyPrintType t2

479+ , indent $ line $ prettyPrintType t2

418− ]

480+ ]

419− goSimple (KindsDoNotUnify k1 k2) = paras [ line "Cannot unify kind"

481+ goSimple (KindsDoNotUnify k1 k2) =

482+ paras [ line "Cannot unify kind"

420− , indent $ line $ prettyPrintKind k1

483+ , indent $ line $ prettyPrintKind k1

421− , line "with kind"

484+ , line "with kind"

422− , indent $ line $ prettyPrintKind k2

485+ , indent $ line $ prettyPrintKind k2

423− ]

486+ ]

487+ goSimple (ConstrainedTypeUnified t1 t2) =

424− goSimple (ConstrainedTypeUnified t1 t2) = paras [ line "Cannot unify constrained type"

488+ paras [ line "Cannot unify constrained type"

425− , indent $ line $ prettyPrintType t1

489+ , indent $ line $ prettyPrintType t1

426− , line "with type"

490+ , line "with type"

427− , indent $ line $ prettyPrintType t2

491+ , indent $ line $ prettyPrintType t2

428− ]

492+ ]

493+ goSimple (OverlappingInstances nm ts ds) =

429− goSimple (OverlappingInstances nm ts ds) = paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"

494+ paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"

430− , paras $ map prettyPrintDictionaryValue ds

495+ , paras $ map prettyPrintDictionaryValue ds

431− ]

496+ ]

497+ goSimple (NoInstanceFound nm ts) =

432− goSimple (NoInstanceFound nm ts) = line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)

498+ line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)

499+ goSimple (DuplicateLabel l expr) =

433− goSimple (DuplicateLabel l expr) = paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]

500+ paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]

434− <> foldMap (\expr' -> [ line "Relevant expression: "

501+ <> foldMap (\expr' -> [ line "Relevant expression: "

435− , indent $ line $ prettyPrintValue expr'

502+ , indent $ line $ prettyPrintValue expr'

436− ]) expr

503+ ]) expr

437− goSimple (DuplicateTypeArgument name) = line $ "Duplicate type argument " ++ show name

504+ goSimple (DuplicateTypeArgument name) =

505+ line $ "Duplicate type argument " ++ show name

506+ goSimple (DuplicateValueDeclaration nm) =

438− goSimple (DuplicateValueDeclaration nm) = line $ "Duplicate value declaration for " ++ show nm

507+ line $ "Duplicate value declaration for " ++ show nm

508+ goSimple (ArgListLengthsDiffer ident) =

439− goSimple (ArgListLengthsDiffer ident) = line $ "Argument list lengths differ in declaration " ++ show ident

509+ line $ "Argument list lengths differ in declaration " ++ show ident

510+ goSimple (OverlappingArgNames ident) =

440− goSimple (OverlappingArgNames ident) = line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident

511+ line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident

512+ goSimple (MissingClassMember ident) =

441− goSimple (MissingClassMember ident) = line $ "Member " ++ show ident ++ " has not been implemented"

513+ line $ "Member " ++ show ident ++ " has not been implemented"

514+ goSimple (ExpectedType kind) =

442− goSimple (ExpectedType kind) = line $ "Expected type of kind *, was " ++ prettyPrintKind kind

515+ line $ "Expected type of kind *, was " ++ prettyPrintKind kind

516+ goSimple (IncorrectConstructorArity nm) =

443− goSimple (IncorrectConstructorArity nm) = line $ "Wrong number of arguments to constructor " ++ show nm

517+ line $ "Wrong number of arguments to constructor " ++ show nm

444− goSimple SubsumptionCheckFailed = line $ "Unable to check type subsumption"

518+ goSimple SubsumptionCheckFailed = line $ "Unable to check type subsumption"

445− goSimple (ExprDoesNotHaveType expr ty) = paras [ line "Expression"

519+ goSimple (ExprDoesNotHaveType expr ty) =

520+ paras [ line "Expression"

446− , indent $ line $ prettyPrintValue expr

521+ , indent $ line $ prettyPrintValue expr

447− , line "does not have type"

522+ , line "does not have type"

448− , indent $ line $ prettyPrintType ty

523+ , indent $ line $ prettyPrintType ty

449− ]

524+ ]

525+ goSimple (PropertyIsMissing prop row) =

450− goSimple (PropertyIsMissing prop row) = line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop

526+ line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop

527+ goSimple (CannotApplyFunction fn arg) =

451− goSimple (CannotApplyFunction fn arg) = paras [ line "Cannot apply function of type"

528+ paras [ line "Cannot apply function of type"

452− , indent $ line $ prettyPrintType fn

529+ , indent $ line $ prettyPrintType fn

453− , line "to argument"

530+ , line "to argument"

454− , indent $ line $ prettyPrintValue arg

531+ , indent $ line $ prettyPrintValue arg

455− ]

532+ ]

533+ goSimple TypeSynonymInstance =

456− goSimple TypeSynonymInstance = line "Type synonym instances are disallowed"

534+ line "Type synonym instances are disallowed"

535+ goSimple InvalidNewtype =

457− goSimple InvalidNewtype = line "Newtypes must define a single constructor with a single argument"

536+ line "Newtypes must define a single constructor with a single argument"

537+ goSimple (InvalidInstanceHead ty) =

458− goSimple (InvalidInstanceHead ty) = paras [ line "Invalid type in class instance head:"

538+ paras [ line "Invalid type in class instance head:"

459− , indent $ line $ prettyPrintType ty

539+ , indent $ line $ prettyPrintType ty

460− ]

540+ ]

541+ goSimple (TransitiveExportError x ys) =

461− goSimple (TransitiveExportError x ys) = paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")

542+ paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")

462− : map (line . prettyPrintExport) ys

543+ : map (line . prettyPrintExport) ys

544+ goSimple (ShadowedName nm) =

463− goSimple (ShadowedName nm) = line $ "Name '" ++ show nm ++ "' was shadowed."

545+ line $ "Name '" ++ show nm ++ "' was shadowed."

546+ goSimple (WildcardInferredType ty) =

464− goSimple (WildcardInferredType ty) = line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty

547+ line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty

465− goSimple PreludeNotPresent = paras [ line $ "There is no Prelude module loaded, and the --no-prelude option was not specified."

548+ go (NotYetDefined names err) =

466− , line $ "You probably need to install the Prelude and other dependencies using Bower."

467− ]

468− go (NotYetDefined names err) = paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"

549+ paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"

469− , indent $ go err

550+ , indent $ go err

470− ]

551+ ]

471− go (ErrorUnifyingTypes t1 t2 err) = paras [ line "Error unifying type "

552+ go (ErrorUnifyingTypes t1 t2 err) =

553+ paras [ line "Error unifying type "

472− , indent $ line $ prettyPrintType t1

554+ , indent $ line $ prettyPrintType t1

473− , line "with type"

555+ , line "with type"

474− , indent $ line $ prettyPrintType t2

556+ , indent $ line $ prettyPrintType t2

475− , go err

557+ , go err

476− ]

558+ ]

477− go (ErrorInExpression expr err) = paras [ line "Error in expression:"

559+ go (ErrorInExpression expr err) =

560+ paras [ line "Error in expression:"

478− , indent $ line $ prettyPrintValue expr

561+ , indent $ line $ prettyPrintValue expr

479− , go err

562+ , go err

480− ]

563+ ]

564+ go (ErrorInModule mn err) =

481− go (ErrorInModule mn err) = paras [ line $ "Error in module " ++ show mn ++ ":"

565+ paras [ line $ "Error in module " ++ show mn ++ ":"

482− , go err

566+ , go err

483− ]

567+ ]

568+ go (ErrorInSubsumption t1 t2 err) =

484− go (ErrorInSubsumption t1 t2 err) = paras [ line "Error checking that type "

569+ paras [ line "Error checking that type "

485− , indent $ line $ prettyPrintType t1

570+ , indent $ line $ prettyPrintType t1

486− , line "subsumes type"

571+ , line "subsumes type"

487− , indent $ line $ prettyPrintType t2

572+ , indent $ line $ prettyPrintType t2

488− , go err

573+ , go err

489− ]

574+ ]

575+ go (ErrorInInstance name ts err) =

490− go (ErrorInInstance name ts err) = paras [ line $ "Error in type class instance " ++ show name ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"

576+ paras [ line $ "Error in type class instance " ++ show name ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"

491− , go err

577+ , go err

492− ]

578+ ]

579+ go (ErrorCheckingKind ty err) =

493− go (ErrorCheckingKind ty err) = paras [ line "Error checking kind of type "

580+ paras [ line "Error checking kind of type "

494− , indent $ line $ prettyPrintType ty

581+ , indent $ line $ prettyPrintType ty

495− , go err

582+ , go err

496− ]

583+ ]

584+ go (ErrorInferringType expr err) =

497− go (ErrorInferringType expr err) = paras [ line "Error inferring type of value "

585+ paras [ line "Error inferring type of value "

498− , indent $ line $ prettyPrintValue expr

586+ , indent $ line $ prettyPrintValue expr

499− , go err

587+ , go err

500− ]

588+ ]

589+ go (ErrorCheckingType expr ty err) =

501− go (ErrorCheckingType expr ty err) = paras [ line "Error checking that value "

590+ paras [ line "Error checking that value "

502− , indent $ line $ prettyPrintValue expr

591+ , indent $ line $ prettyPrintValue expr

503− , line "has type"

592+ , line "has type"

504− , indent $ line $ prettyPrintType ty

593+ , indent $ line $ prettyPrintType ty

505− , go err

594+ , go err

506− ]

595+ ]

596+ go (ErrorInApplication f t a err) =

507− go (ErrorInApplication f t a err) = paras [ line "Error applying function"

597+ paras [ line "Error applying function"

508− , indent $ line $ prettyPrintValue f

598+ , indent $ line $ prettyPrintValue f

509− , line "of type"

599+ , line "of type"

510− , indent $ line $ prettyPrintType t

600+ , indent $ line $ prettyPrintType t

511− , line "to argument"

601+ , line "to argument"

512− , indent $ line $ prettyPrintValue a

602+ , indent $ line $ prettyPrintValue a

513− , go err

603+ , go err

514− ]

604+ ]

605+ go (ErrorInDataConstructor nm err) =

515− go (ErrorInDataConstructor nm err) = paras [ line $ "Error in data constructor " ++ show nm ++ ":"

606+ paras [ line $ "Error in data constructor " ++ show nm ++ ":"

516− , go err

607+ , go err

517− ]

608+ ]

609+ go (ErrorInTypeConstructor nm err) =

518− go (ErrorInTypeConstructor nm err) = paras [ line $ "Error in type constructor " ++ show nm ++ ":"

610+ paras [ line $ "Error in type constructor " ++ show nm ++ ":"

519− , go err

611+ , go err

520− ]

612+ ]

613+ go (ErrorInBindingGroup nms err) =

521− go (ErrorInBindingGroup nms err) = paras [ line $ "Error in binding group " ++ intercalate ", " (map show nms) ++ ":"

614+ paras [ line $ "Error in binding group " ++ intercalate ", " (map show nms) ++ ":"

522− , go err

615+ , go err

523− ]

616+ ]

617+ go (ErrorInDataBindingGroup err) =

524− go (ErrorInDataBindingGroup err) = paras [ line $ "Error in data binding group:"

618+ paras [ line $ "Error in data binding group:"

525− , go err

619+ , go err

526− ]

620+ ]

621+ go (ErrorInTypeSynonym name err) =

527− go (ErrorInTypeSynonym name err) = paras [ line $ "Error in type synonym " ++ show name ++ ":"

622+ paras [ line $ "Error in type synonym " ++ show name ++ ":"

528− , go err

623+ , go err

529− ]

624+ ]

625+ go (ErrorInValueDeclaration n err) =

530− go (ErrorInValueDeclaration n err) = paras [ line $ "Error in value declaration " ++ show n ++ ":"

626+ paras [ line $ "Error in value declaration " ++ show n ++ ":"

531− , go err

627+ , go err

532− ]

628+ ]

629+ go (ErrorInForeignImport nm err) =

533− go (ErrorInForeignImport nm err) = paras [ line $ "Error in foreign import " ++ show nm ++ ":"

630+ paras [ line $ "Error in foreign import " ++ show nm ++ ":"

534− , go err

631+ , go err

535− ]

632+ ]

633+ go (PositionedError srcSpan err) =

536− go (PositionedError srcSpan err) = paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"

634+ paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"

537− , indent $ go err

635+ , indent $ go err

538− ]

636+ ]

539− go (SimpleErrorWrapper sem) = goSimple sem

637+ go (SimpleErrorWrapper sem) = goSimple sem

540

638

541 line :: String -> Box.Box

639 line :: String -> Box.Box

542 line = Box.text

640 line = Box.text

@@ -570,10 +668,10 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag

570 prettyPrintDictionaryValue (SubclassDictionaryValue sup nm _) = paras [ line $ (show nm) ++ " via superclass"

668 prettyPrintDictionaryValue (SubclassDictionaryValue sup nm _) = paras [ line $ (show nm) ++ " via superclass"

571 , indent $ prettyPrintDictionaryValue sup

669 , indent $ prettyPrintDictionaryValue sup

572 ]

670 ]

573−

671+

574 -- |

672 -- |

575 -- Pretty print and export declaration

673 -- Pretty print and export declaration

576− --

674+ --

577 prettyPrintExport :: DeclarationRef -> String

675 prettyPrintExport :: DeclarationRef -> String

578 prettyPrintExport (TypeRef pn _) = show pn

676 prettyPrintExport (TypeRef pn _) = show pn

579 prettyPrintExport (ValueRef ident) = show ident

677 prettyPrintExport (ValueRef ident) = show ident

src/Language/PureScript/Linter.hs+8−8

@@ -39,35 +39,35 @@ lint (Module _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_ li

39 where

39 where

40 moduleNames :: S.Set Ident

40 moduleNames :: S.Set Ident

41 moduleNames = S.fromList (nub (mapMaybe getDeclIdent ds))

41 moduleNames = S.fromList (nub (mapMaybe getDeclIdent ds))

42−

42+

43 getDeclIdent :: Declaration -> Maybe Ident

43 getDeclIdent :: Declaration -> Maybe Ident

44 getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d

44 getDeclIdent (PositionedDeclaration _ _ d) = getDeclIdent d

45 getDeclIdent (ValueDeclaration ident _ _ _) = Just ident

45 getDeclIdent (ValueDeclaration ident _ _ _) = Just ident

46− getDeclIdent (ExternDeclaration _ ident _ _) = Just ident

46+ getDeclIdent (ExternDeclaration ident _) = Just ident

47 getDeclIdent (ExternInstanceDeclaration ident _ _ _) = Just ident

47 getDeclIdent (ExternInstanceDeclaration ident _ _ _) = Just ident

48 getDeclIdent (TypeInstanceDeclaration ident _ _ _ _) = Just ident

48 getDeclIdent (TypeInstanceDeclaration ident _ _ _ _) = Just ident

49 getDeclIdent (BindingGroupDeclaration _) = error "lint: binding groups should not be desugared yet."

49 getDeclIdent (BindingGroupDeclaration _) = error "lint: binding groups should not be desugared yet."

50 getDeclIdent _ = Nothing

50 getDeclIdent _ = Nothing

51

51

52 lintDeclaration :: Declaration -> m ()

52 lintDeclaration :: Declaration -> m ()

53− lintDeclaration d =

53+ lintDeclaration d =

54 let (f, _, _, _, _) = everythingWithContextOnValues moduleNames mempty mappend def stepE stepB def def

54 let (f, _, _, _, _) = everythingWithContextOnValues moduleNames mempty mappend def stepE stepB def def

55 in tell (f d)

55 in tell (f d)

56 where

56 where

57 def s _ = (s, mempty)

57 def s _ = (s, mempty)

58−

58+

59 stepE :: S.Set Ident -> Expr -> (S.Set Ident, MultipleErrors)

59 stepE :: S.Set Ident -> Expr -> (S.Set Ident, MultipleErrors)

60 stepE s (Abs (Left name) _) = bind s name

60 stepE s (Abs (Left name) _) = bind s name

61− stepE s (Let ds' _) =

61+ stepE s (Let ds' _) =

62 case mapAccumL bind s (nub (mapMaybe getDeclIdent ds')) of

62 case mapAccumL bind s (nub (mapMaybe getDeclIdent ds')) of

63 (s', es) -> (s', mconcat es)

63 (s', es) -> (s', mconcat es)

64 stepE s _ = (s, mempty)

64 stepE s _ = (s, mempty)

65−

65+

66 stepB :: S.Set Ident -> Binder -> (S.Set Ident, MultipleErrors)

66 stepB :: S.Set Ident -> Binder -> (S.Set Ident, MultipleErrors)

67 stepB s (VarBinder name) = bind s name

67 stepB s (VarBinder name) = bind s name

68 stepB s (NamedBinder name _) = bind s name

68 stepB s (NamedBinder name _) = bind s name

69 stepB s _ = (s, mempty)

69 stepB s _ = (s, mempty)

70−

70+

71 bind :: S.Set Ident -> Ident -> (S.Set Ident, MultipleErrors)

71 bind :: S.Set Ident -> Ident -> (S.Set Ident, MultipleErrors)

72 bind s name | name `S.member` s = (s, errorMessage (ShadowedName name))

72 bind s name | name `S.member` s = (s, errorMessage (ShadowedName name))

73− | otherwise = (S.insert name s, mempty)

73+ | otherwise = (S.insert name s, mempty)

src/Language/PureScript/Options.hs+3−7

@@ -44,14 +44,10 @@ deriving instance Show (ModeOptions mode)

44-- The data type of compiler options

44-- The data type of compiler options

45--

45--

46data Options mode = Options {

46data Options mode = Options {

47− -- |

48− -- Disable inclusion of the built in Prelude

49− --

50− optionsNoPrelude :: Bool

51 -- |

47 -- |

52 -- Disable tail-call elimination

48 -- Disable tail-call elimination

53 --

49 --

54− , optionsNoTco :: Bool

50+ optionsNoTco :: Bool

55 -- |

51 -- |

56 -- Disable inlining of calls to return and bind for the Eff monad

52 -- Disable inlining of calls to return and bind for the Eff monad

57 --

53 --

@@ -83,10 +79,10 @@ data Options mode = Options {

83-- Default compiler options

79-- Default compiler options

84--

80--

85defaultCompileOptions :: Options Compile

81defaultCompileOptions :: Options Compile

86−defaultCompileOptions = Options False False False Nothing False False False (CompileOptions "PS" [] [])

82+defaultCompileOptions = Options False False Nothing False False False (CompileOptions "PS" [] [])

87

83

88-- |

84-- |

89-- Default make options

85-- Default make options

90--

86--

91defaultMakeOptions :: Options Make

87defaultMakeOptions :: Options Make

92−defaultMakeOptions = Options False False False Nothing False False False MakeOptions

88+defaultMakeOptions = Options False False Nothing False False False MakeOptions

src/Language/PureScript/Parser.hs+1

@@ -33,3 +33,4 @@ import Language.PureScript.Parser.State as P

33import Language.PureScript.Parser.Kinds as P

33import Language.PureScript.Parser.Kinds as P

34import Language.PureScript.Parser.Lexer as P

34import Language.PureScript.Parser.Lexer as P

35import Language.PureScript.Parser.Declarations as P

35import Language.PureScript.Parser.Declarations as P

36+import Language.PureScript.Parser.JS as P

src/Language/PureScript/Parser/Declarations.hs+30−23

@@ -13,6 +13,8 @@

13--

13--

14-----------------------------------------------------------------------------

14-----------------------------------------------------------------------------

15

15

16+{-# LANGUAGE FlexibleContexts #-}

17+{-# LANGUAGE ScopedTypeVariables #-}

16{-# LANGUAGE TupleSections #-}

18{-# LANGUAGE TupleSections #-}

17

19

18module Language.PureScript.Parser.Declarations (

20module Language.PureScript.Parser.Declarations (

@@ -30,22 +32,22 @@ module Language.PureScript.Parser.Declarations (

30

32

31import Prelude hiding (lex)

33import Prelude hiding (lex)

32

34

33−import Data.Maybe (isJust, fromMaybe)

35+import Data.Maybe (fromMaybe)

34−import Data.Traversable (forM)

35

36

36import Control.Applicative

37import Control.Applicative

37import Control.Arrow ((+++))

38import Control.Arrow ((+++))

39+import Control.Monad.Error.Class (MonadError(..))

38

40

39−import Language.PureScript.Kinds

40import Language.PureScript.AST

41import Language.PureScript.AST

41import Language.PureScript.Comments

42import Language.PureScript.Comments

43+import Language.PureScript.Environment

44+import Language.PureScript.Errors

45+import Language.PureScript.Kinds

46+import Language.PureScript.Names

42import Language.PureScript.Parser.Common

47import Language.PureScript.Parser.Common

43−import Language.PureScript.Parser.Types

44import Language.PureScript.Parser.Kinds

48import Language.PureScript.Parser.Kinds

45import Language.PureScript.Parser.Lexer

49import Language.PureScript.Parser.Lexer

46−import Language.PureScript.Names

50+import Language.PureScript.Parser.Types

47−import Language.PureScript.CodeGen.JS.AST

48−import Language.PureScript.Environment

49

51

50import qualified Language.PureScript.Parser.Common as C

52import qualified Language.PureScript.Parser.Common as C

51import qualified Text.Parsec as P

53import qualified Text.Parsec as P

@@ -99,7 +101,7 @@ parseValueDeclaration = do

99 <*> (indented *> equals *> parseValueWithWhereClause)

101 <*> (indented *> equals *> parseValueWithWhereClause)

100 ))

102 ))

101 <|> Right <$> (indented *> equals *> parseValueWithWhereClause)

103 <|> Right <$> (indented *> equals *> parseValueWithWhereClause)

102− return $ ValueDeclaration name Value binders value

104+ return $ ValueDeclaration name Public binders value

103 where

105 where

104 parseValueWithWhereClause :: TokenParser Expr

106 parseValueWithWhereClause :: TokenParser Expr

105 parseValueWithWhereClause = do

107 parseValueWithWhereClause = do

@@ -118,17 +120,19 @@ parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "imp

118 <|> (do reserved "instance"

120 <|> (do reserved "instance"

119 name <- parseIdent <* indented <* doubleColon

121 name <- parseIdent <* indented <* doubleColon

120 deps <- P.option [] $ do

122 deps <- P.option [] $ do

121− deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

123+ deps' <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

122 indented

124 indented

123 rfatArrow

125 rfatArrow

124− return deps

126+ return deps'

125 className <- indented *> parseQualified properName

127 className <- indented *> parseQualified properName

126 tys <- P.many (indented *> noWildcards parseTypeAtom)

128 tys <- P.many (indented *> noWildcards parseTypeAtom)

127 return $ ExternInstanceDeclaration name deps className tys)

129 return $ ExternInstanceDeclaration name deps className tys)

128 <|> (do ident <- parseIdent

130 <|> (do ident <- parseIdent

129− js <- P.optionMaybe (JSRaw <$> stringLiteral)

131+ -- TODO: add a wiki page link with migration info

132+ -- TODO: remove this deprecation warning in 0.8

133+ _ <- P.optional $ stringLiteral *> featureWasRemoved "Inline foreign string literals are no longer supported."

130 ty <- indented *> doubleColon *> noWildcards parsePolyType

134 ty <- indented *> doubleColon *> noWildcards parsePolyType

131− return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty))

135+ return $ ExternDeclaration ident ty))

132

136

133parseAssociativity :: TokenParser Associativity

137parseAssociativity :: TokenParser Associativity

134parseAssociativity =

138parseAssociativity =

@@ -151,7 +155,7 @@ parseImportDeclaration = do

151 (mn, declType, asQ) <- parseImportDeclaration'

155 (mn, declType, asQ) <- parseImportDeclaration'

152 return $ ImportDeclaration mn declType asQ

156 return $ ImportDeclaration mn declType asQ

153

157

154−parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, (Maybe ModuleName))

158+parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, Maybe ModuleName)

155parseImportDeclaration' = do

159parseImportDeclaration' = do

156 reserved "import"

160 reserved "import"

157 indented

161 indented

@@ -177,7 +181,7 @@ parseImportDeclaration' = do

177 asQ <- moduleName

181 asQ <- moduleName

178 return (moduleName', declType, Just asQ)

182 return (moduleName', declType, Just asQ)

179 importDeclarationType expectedType = do

183 importDeclarationType expectedType = do

180− idents <- P.optionMaybe $ indented *> (parens $ commaSep parseDeclarationRef)

184+ idents <- P.optionMaybe $ indented *> parens (commaSep parseDeclarationRef)

181 return $ fromMaybe Implicit (expectedType <$> idents)

185 return $ fromMaybe Implicit (expectedType <$> idents)

182

186

183

187

@@ -213,14 +217,14 @@ parseTypeInstanceDeclaration = do

213 rfatArrow

217 rfatArrow

214 return deps

218 return deps

215 className <- indented *> parseQualified properName

219 className <- indented *> parseQualified properName

216− ty <- P.many (indented *> (noWildcards parseTypeAtom))

220+ ty <- P.many (indented *> noWildcards parseTypeAtom)

217 members <- P.option [] . P.try $ do

221 members <- P.option [] . P.try $ do

218 indented *> reserved "where"

222 indented *> reserved "where"

219 mark (P.many (same *> positioned parseValueDeclaration))

223 mark (P.many (same *> positioned parseValueDeclaration))

220 return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members

224 return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members

221

225

222positioned :: TokenParser Declaration -> TokenParser Declaration

226positioned :: TokenParser Declaration -> TokenParser Declaration

223−positioned d = withSourceSpan PositionedDeclaration d

227+positioned = withSourceSpan PositionedDeclaration

224

228

225-- |

229-- |

226-- Parse a single declaration

230-- Parse a single declaration

@@ -261,14 +265,18 @@ parseModule = do

261-- |

265-- |

262-- Parse a collection of modules

266-- Parse a collection of modules

263--

267--

268+parseModulesFromFiles :: forall m k. (MonadError MultipleErrors m, Functor m) =>

264−parseModulesFromFiles :: (k -> String) -> [(k, String)] -> Either P.ParseError [(k, Module)]

269+ (k -> String) -> [(k, String)] -> m [(k, Module)]

265−parseModulesFromFiles toFilePath input =

270+parseModulesFromFiles toFilePath input = do

266− fmap collect . forM input $ \(k, content) -> do

271+ modules <- parU input $ \(k, content) -> do

267 let filename = toFilePath k

272 let filename = toFilePath k

268− ts <- lex filename content

273+ ts <- wrapError $ lex filename content

269− ms <- runTokenParser filename parseModules ts

274+ ms <- wrapError $ runTokenParser filename parseModules ts

270 return (k, ms)

275 return (k, ms)

276+ return $ collect modules

271 where

277 where

278+ wrapError :: Either P.ParseError a -> m a

279+ wrapError = either (throwError . errorMessage . ErrorParsingModule) return

272 collect :: [(k, [v])] -> [(k, v)]

280 collect :: [(k, [v])] -> [(k, v)]

273 collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]

281 collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]

274

282

@@ -527,10 +535,9 @@ parseBinderNoParens = P.choice (map P.try

527 , parseObjectBinder

535 , parseObjectBinder

528 , parseArrayBinder

536 , parseArrayBinder

529 , parens parseBinder ]) P.<?> "binder"

537 , parens parseBinder ]) P.<?> "binder"

538+

530-- |

539-- |

531-- Parse a guard

540-- Parse a guard

532--

541--

533parseGuard :: TokenParser Guard

542parseGuard :: TokenParser Guard

534parseGuard = pipe *> C.indented *> parseValue

543parseGuard = pipe *> C.indented *> parseValue

535−

536−

src/Language/PureScript/Parser/JS.hsnew file+59

@@ -0,0 +1,59 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Foreign

4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors

5+-- License : MIT

6+--

7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+--

13+-----------------------------------------------------------------------------

14+

15+{-# LANGUAGE FlexibleContexts #-}

16+

17+module Language.PureScript.Parser.JS

18+ ( ForeignJS()

19+ , parseForeignModulesFromFiles

20+ ) where

21+

22+import Control.Applicative ((*>), (<*))

23+import Control.Monad (forM_, when, msum)

24+import Control.Monad.Error.Class (MonadError(..))

25+import Control.Monad.Writer.Class (MonadWriter(..))

26+import Data.Function (on)

27+import Data.List (sortBy, groupBy)

28+import Language.PureScript.Errors

29+import Language.PureScript.Names

30+import Language.PureScript.Parser.Common

31+import Language.PureScript.Parser.Lexer

32+import Prelude hiding (lex)

33+import qualified Data.Map as M

34+import qualified Text.Parsec as PS

35+

36+type ForeignJS = String

37+

38+parseForeignModulesFromFiles :: (Functor m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

39+ => [(FilePath, ForeignJS)]

40+ -> m (M.Map ModuleName (FilePath, ForeignJS))

41+parseForeignModulesFromFiles files = do

42+ foreigns <- parU files $ \(path, file) ->

43+ case findModuleName (lines file) of

44+ Just name -> return (name, (path, file))

45+ Nothing -> throwError (errorMessage $ ErrorParsingFFIModule path)

46+ let grouped = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) foreigns

47+ forM_ grouped $ \grp ->

48+ when (length grp > 1) $ do

49+ let mn = fst (head grp)

50+ paths = map (fst . snd) grp

51+ tell $ errorMessage $ MultipleFFIModules mn paths

52+ return $ M.fromList foreigns

53+

54+findModuleName :: [String] -> Maybe ModuleName

55+findModuleName = msum . map parseComment

56+ where

57+ parseComment :: String -> Maybe ModuleName

58+ parseComment s = either (const Nothing) Just $

59+ lex "" s >>= runTokenParser "" (symbol' "//" *> reserved "module" *> moduleName <* PS.eof)

src/Language/PureScript/Sugar/CaseDeclarations.hs+9−9

@@ -101,7 +101,7 @@ toDecls [ValueDeclaration ident nameKind bs (Right val)] | all isVarBinder bs =

101 isVarBinder (VarBinder _) = True

101 isVarBinder (VarBinder _) = True

102 isVarBinder (PositionedBinder _ _ b) = isVarBinder b

102 isVarBinder (PositionedBinder _ _ b) = isVarBinder b

103 isVarBinder _ = False

103 isVarBinder _ = False

104−

104+

105 fromVarBinder :: Binder -> m Ident

105 fromVarBinder :: Binder -> m Ident

106 fromVarBinder NullBinder = Ident <$> freshName

106 fromVarBinder NullBinder = Ident <$> freshName

107 fromVarBinder (VarBinder name) = return name

107 fromVarBinder (VarBinder name) = return name

@@ -129,17 +129,17 @@ makeCaseDeclaration :: forall m. (Functor m, Applicative m, MonadSupply m, Monad

129makeCaseDeclaration ident alternatives = do

129makeCaseDeclaration ident alternatives = do

130 let namedArgs = map findName . fst <$> alternatives

130 let namedArgs = map findName . fst <$> alternatives

131 argNames = map join $ foldl1 resolveNames namedArgs

131 argNames = map join $ foldl1 resolveNames namedArgs

132− args <- if allUnique (catMaybes argNames)

132+ args <- if allUnique (catMaybes argNames)

133− then mapM argName argNames

133+ then mapM argName argNames

134 else replicateM (length argNames) (Ident <$> freshName)

134 else replicateM (length argNames) (Ident <$> freshName)

135 let vars = map (Var . Qualified Nothing) args

135 let vars = map (Var . Qualified Nothing) args

136 binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]

136 binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]

137 value = foldr (Abs . Left) (Case vars binders) args

137 value = foldr (Abs . Left) (Case vars binders) args

138− return $ ValueDeclaration ident Value [] (Right value)

138+ return $ ValueDeclaration ident Public [] (Right value)

139 where

139 where

140 -- We will construct a table of potential names.

140 -- We will construct a table of potential names.

141 -- VarBinders will become Just (Just _) which is a potential name.

141 -- VarBinders will become Just (Just _) which is a potential name.

142− -- NullBinder will become Just Nothing, which indicates that we may

142+ -- NullBinder will become Just Nothing, which indicates that we may

143 -- have to generate a name.

143 -- have to generate a name.

144 -- Everything else becomes Nothing, which indicates that we definitely

144 -- Everything else becomes Nothing, which indicates that we definitely

145 -- have to generate a name.

145 -- have to generate a name.

@@ -162,15 +162,15 @@ makeCaseDeclaration ident alternatives = do

162

162

163 -- Combine two lists of potential names from two case alternatives

163 -- Combine two lists of potential names from two case alternatives

164 -- by zipping correspoding columns.

164 -- by zipping correspoding columns.

165− resolveNames :: [Maybe (Maybe Ident)] ->

165+ resolveNames :: [Maybe (Maybe Ident)] ->

166− [Maybe (Maybe Ident)] ->

166+ [Maybe (Maybe Ident)] ->

167 [Maybe (Maybe Ident)]

167 [Maybe (Maybe Ident)]

168 resolveNames = zipWith resolveName

168 resolveNames = zipWith resolveName

169

169

170 -- Resolve a pair of names. VarBinder beats NullBinder, and everything

170 -- Resolve a pair of names. VarBinder beats NullBinder, and everything

171 -- else results in Nothing.

171 -- else results in Nothing.

172− resolveName :: Maybe (Maybe Ident) ->

172+ resolveName :: Maybe (Maybe Ident) ->

173− Maybe (Maybe Ident) ->

173+ Maybe (Maybe Ident) ->

174 Maybe (Maybe Ident)

174 Maybe (Maybe Ident)

175 resolveName (Just (Just a)) (Just (Just b))

175 resolveName (Just (Just a)) (Just (Just b))

176 | a == b = Just (Just a)

176 | a == b = Just (Just a)

src/Language/PureScript/Sugar/Names.hs+3−3

@@ -226,8 +226,8 @@ renameInModule imports exports (Module coms mn decls exps) =

226 (,) (pos, bound) <$> (ExternInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn Nothing <*> mapM (updateTypesEverywhere pos) ts)

226 (,) (pos, bound) <$> (ExternInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn Nothing <*> mapM (updateTypesEverywhere pos) ts)

227 updateDecl (pos, bound) (TypeDeclaration name ty) =

227 updateDecl (pos, bound) (TypeDeclaration name ty) =

228 (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)

228 (,) (pos, bound) <$> (TypeDeclaration name <$> updateTypesEverywhere pos ty)

229− updateDecl (pos, bound) (ExternDeclaration fit name js ty) =

229+ updateDecl (pos, bound) (ExternDeclaration name ty) =

230− (,) (pos, name : bound) <$> (ExternDeclaration fit name js <$> updateTypesEverywhere pos ty)

230+ (,) (pos, name : bound) <$> (ExternDeclaration name <$> updateTypesEverywhere pos ty)

231 updateDecl s d = return (s, d)

231 updateDecl s d = return (s, d)

232

232

233 updateValue :: (Maybe SourceSpan, [Ident]) -> Expr -> m ((Maybe SourceSpan, [Ident]), Expr)

233 updateValue :: (Maybe SourceSpan, [Ident]) -> Expr -> m ((Maybe SourceSpan, [Ident]), Expr)

@@ -337,7 +337,7 @@ findExports = foldM addModule $ M.singleton (ModuleName [ProperName C.prim]) pri

337 addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []

337 addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []

338 addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []

338 addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []

339 addDecl mn env (ValueDeclaration name _ _ _) = addValue env mn name

339 addDecl mn env (ValueDeclaration name _ _ _) = addValue env mn name

340− addDecl mn env (ExternDeclaration _ name _ _) = addValue env mn name

340+ addDecl mn env (ExternDeclaration name _) = addValue env mn name

341 addDecl mn env (PositionedDeclaration pos _ d) = rethrowWithPosition pos $ addDecl mn env d

341 addDecl mn env (PositionedDeclaration pos _ d) = rethrowWithPosition pos $ addDecl mn env d

342 addDecl _ env _ = return env

342 addDecl _ env _ = return env

343

343

src/Language/PureScript/Sugar/TypeClasses.hs+3−3

@@ -59,7 +59,7 @@ desugarModule (Module coms name decls (Just exps)) = do

59 return $ Module coms name (concat declss) $ Just (exps ++ catMaybes newExpss)

59 return $ Module coms name (concat declss) $ Just (exps ++ catMaybes newExpss)

60 where

60 where

61 classesFirst :: Declaration -> Declaration -> Ordering

61 classesFirst :: Declaration -> Declaration -> Ordering

62− classesFirst d1 d2

62+ classesFirst d1 d2

63 | isTypeClassDeclaration d1 && not (isTypeClassDeclaration d2) = LT

63 | isTypeClassDeclaration d1 && not (isTypeClassDeclaration d2) = LT

64 | not (isTypeClassDeclaration d1) && isTypeClassDeclaration d2 = GT

64 | not (isTypeClassDeclaration d1) && isTypeClassDeclaration d2 = GT

65 | otherwise = EQ

65 | otherwise = EQ

@@ -219,7 +219,7 @@ typeClassDictionaryDeclaration name args implies members =

219typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Declaration -> Declaration

219typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [(String, Maybe Kind)] -> Declaration -> Declaration

220typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =

220typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =

221 let className = Qualified (Just mn) name

221 let className = Qualified (Just mn) name

222− in ValueDeclaration ident TypeClassAccessorImport [] $ Right $

222+ in ValueDeclaration ident Private [] $ Right $

223 TypedValue False (TypeClassDictionaryAccessor className ident) $

223 TypedValue False (TypeClassDictionaryAccessor className ident) $

224 moveQuantifiersToFront (quantify (ConstrainedType [(className, map (TypeVar . fst) args)] ty))

224 moveQuantifiersToFront (quantify (ConstrainedType [(className, map (TypeVar . fst) args)] ty))

225typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos com d) =

225typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos com d) =

@@ -264,7 +264,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

264 dictTy = foldl TypeApp (TypeConstructor className) tys

264 dictTy = foldl TypeApp (TypeConstructor className) tys

265 constrainedTy = quantify (if null deps then dictTy else ConstrainedType deps dictTy)

265 constrainedTy = quantify (if null deps then dictTy else ConstrainedType deps dictTy)

266 dict = TypeClassDictionaryConstructorApp className props

266 dict = TypeClassDictionaryConstructorApp className props

267− result = ValueDeclaration name TypeInstanceDictionaryValue [] (Right (TypedValue True dict constrainedTy))

267+ result = ValueDeclaration name Private [] (Right (TypedValue True dict constrainedTy))

268 return result

268 return result

269

269

270 where

270 where

src/Language/PureScript/TypeChecker.hs+2−2

@@ -207,14 +207,14 @@ typeCheckAll mainModuleName moduleName exps = go

207 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }

207 putEnv $ env { types = M.insert (Qualified (Just moduleName) name) (kind, ExternData) (types env) }

208 ds <- go rest

208 ds <- go rest

209 return $ d : ds

209 return $ d : ds

210− go (d@(ExternDeclaration importTy name _ ty) : rest) = do

210+ go (d@(ExternDeclaration name ty) : rest) = do

211 rethrow (onErrorMessages (ErrorInForeignImport name)) $ do

211 rethrow (onErrorMessages (ErrorInForeignImport name)) $ do

212 env <- getEnv

212 env <- getEnv

213 kind <- kindOf moduleName ty

213 kind <- kindOf moduleName ty

214 guardWith (errorMessage (ExpectedType kind)) $ kind == Star

214 guardWith (errorMessage (ExpectedType kind)) $ kind == Star

215 case M.lookup (moduleName, name) (names env) of

215 case M.lookup (moduleName, name) (names env) of

216 Just _ -> throwError . errorMessage $ RedefinedIdent name

216 Just _ -> throwError . errorMessage $ RedefinedIdent name

217− Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, Extern importTy, Defined) (names env) })

217+ Nothing -> putEnv (env { names = M.insert (moduleName, name) (ty, External, Defined) (names env) })

218 ds <- go rest

218 ds <- go rest

219 return $ d : ds

219 return $ d : ds

220 go (d@(FixityDeclaration _ name) : rest) = do

220 go (d@(FixityDeclaration _ name) : rest) = do

src/Language/PureScript/TypeChecker/Monad.hs+2−2

@@ -86,7 +86,7 @@ getTypeClassDictionaries = M.elems . typeClassDictionaries . checkEnv <$> get

86--

86--

87bindLocalVariables :: (Functor m, MonadState CheckState m) => ModuleName -> [(Ident, Type, NameVisibility)] -> m a -> m a

87bindLocalVariables :: (Functor m, MonadState CheckState m) => ModuleName -> [(Ident, Type, NameVisibility)] -> m a -> m a

88bindLocalVariables moduleName bindings =

88bindLocalVariables moduleName bindings =

89− bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> ((moduleName, name), (ty, LocalVariable, visibility)))

89+ bindNames (M.fromList $ flip map bindings $ \(name, ty, visibility) -> ((moduleName, name), (ty, Private, visibility)))

90

90

91-- |

91-- |

92-- Temporarily bind a collection of names to local type variables

92-- Temporarily bind a collection of names to local type variables

@@ -98,7 +98,7 @@ bindLocalTypeVariables moduleName bindings =

98-- |

98-- |

99-- Update the visibility of all names to Defined

99-- Update the visibility of all names to Defined

100--

100--

101−makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m ()

101+makeBindingGroupVisible :: (Functor m, MonadState CheckState m) => m ()

102makeBindingGroupVisible = modifyEnv $ \e -> e { names = M.map (\(ty, nk, _) -> (ty, nk, Defined)) (names e) }

102makeBindingGroupVisible = modifyEnv $ \e -> e { names = M.map (\(ty, nk, _) -> (ty, nk, Defined)) (names e) }

103

103

104-- | Update the visibility of all names to Defined in the scope of the provided action

104-- | Update the visibility of all names to Defined in the scope of the provided action

src/Language/PureScript/TypeChecker/Types.hs+2−2

@@ -127,7 +127,7 @@ typeDictionaryForBindingGroup moduleName vals = do

127 -- Make a map of names to the unification variables of untyped declarations

127 -- Make a map of names to the unification variables of untyped declarations

128 untypedDict = zip (map fst untyped) untypedNames

128 untypedDict = zip (map fst untyped) untypedNames

129 -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking

129 -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking

130− dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, LocalVariable, Undefined))) $ typedDict ++ untypedDict)

130+ dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, Private, Undefined))) $ typedDict ++ untypedDict)

131 return (untyped, typed, dict, untypedDict)

131 return (untyped, typed, dict, untypedDict)

132

132

133checkTypedBindingGroupElement :: ModuleName -> (Ident, (Expr, Type, Bool)) -> TypeData -> UnifyT Type Check (Ident, (Expr, Type))

133checkTypedBindingGroupElement :: ModuleName -> (Ident, (Expr, Type, Bool)) -> TypeData -> UnifyT Type Check (Ident, (Expr, Type))

@@ -325,7 +325,7 @@ inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do

325 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)

325 (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName (map (\(i, _, v) -> (i, v)) ds)

326 ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict

326 ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict

327 ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict

327 ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict

328− let ds' = [(ident, LocalVariable, val') | (ident, (val', _)) <- ds1' ++ ds2']

328+ let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']

329 bindNames dict $ do

329 bindNames dict $ do

330 makeBindingGroupVisible

330 makeBindingGroupVisible

331 inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j

331 inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j

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.Trans.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+628

@@ -0,0 +1,628 @@

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+ import Prelude

470+

471+ on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c

472+ on f g x y = g x `f` g y

473+

474+ foreign import data Fn0 :: * -> *

475+

476+ foreign import data Fn1 :: * -> * -> *

477+

478+ foreign import data Fn2 :: * -> * -> * -> *

479+

480+ foreign import data Fn3 :: * -> * -> * -> * -> *

481+

482+ foreign import data Fn4 :: * -> * -> * -> * -> * -> *

483+

484+ foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *

485+

486+ foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *

487+

488+ foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *

489+

490+ foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *

491+

492+ foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *

493+

494+ foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *

495+

496+ foreign import mkFn0 :: forall a. (Unit -> a) -> Fn0 a

497+

498+ foreign import mkFn1 :: forall a b. (a -> b) -> Fn1 a b

499+

500+ foreign import mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c

501+

502+ foreign import mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d

503+

504+ foreign import mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e

505+

506+ foreign import mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f

507+

508+ 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

509+

510+ 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

511+

512+ 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

513+

514+ 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

515+

516+ 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

517+

518+ foreign import runFn0 :: forall a. Fn0 a -> a

519+

520+ foreign import runFn1 :: forall a b. Fn1 a b -> a -> b

521+

522+ foreign import runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c

523+

524+ foreign import runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d

525+

526+ foreign import runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e

527+

528+ foreign import runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f

529+

530+ 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

531+

532+ 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

533+

534+ 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

535+

536+ 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

537+

538+ 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

539+

540+module Assert where

541+

542+ import Prelude

543+ import Control.Monad.Eff

544+

545+ foreign import data Assert :: !

546+

547+ foreign import error :: forall a. String -> a

548+

549+ foreign import assertPartial :: forall e a. (Unit -> a) -> Eff (assert :: Assert | e) Unit

550+

551+ assert :: forall e. Boolean -> Eff (assert :: Assert | e) Unit

552+ assert true = return unit

553+ assert false = error "Assertion failed!"

554+

555+module Prelude.Unsafe where

556+

557+ foreign import unsafeIndex :: forall a. Array a -> Number -> a

558+

559+module Control.Monad.Eff

560+ ( Eff()

561+ , Pure()

562+ , runPure

563+ , untilE, whileE

564+ ) where

565+

566+ import Prelude

567+

568+ foreign import data Eff :: # ! -> * -> *

569+

570+ foreign import returnE :: forall e a. a -> Eff e a

571+

572+ foreign import bindE :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

573+

574+ type Pure a = forall e. Eff e a

575+

576+ foreign import runPure :: forall a. Pure a -> a

577+

578+ instance functorEff :: Functor (Eff e) where

579+ (<$>) = liftA1

580+

581+ instance applyEff :: Apply (Eff e) where

582+ (<*>) = ap

583+

584+ instance applicativeEff :: Applicative (Eff e) where

585+ pure = returnE

586+

587+ instance bindEff :: Bind (Eff e) where

588+ (>>=) = bindE

589+

590+ instance monadEff :: Monad (Eff e)

591+

592+ foreign import untilE :: forall e. Eff e Boolean -> Eff e Unit

593+

594+ foreign import whileE :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit

595+

596+module Debug.Trace where

597+

598+ import Prelude

599+ import Control.Monad.Eff

600+

601+ foreign import data Trace :: !

602+

603+ foreign import trace :: forall r. String -> Eff (trace :: Trace | r) Unit

604+

605+ print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit

606+ print o = trace (show o)

607+

608+module Control.Monad.ST where

609+

610+ import Prelude

611+ import Control.Monad.Eff

612+

613+ foreign import data ST :: * -> !

614+

615+ foreign import data STRef :: * -> * -> *

616+

617+ foreign import newSTRef :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)

618+

619+ foreign import readSTRef :: forall a h r. STRef h a -> Eff (st :: ST h | r) a

620+

621+ foreign import modifySTRef :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a

622+

623+ foreign import writeSTRef :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

624+

625+ foreign import runST :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

626+

627+ pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a

628+ 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+};