purescript 0.5.4 → 0.5.4.1

raw patch · 147 files changed

+2238/−216 lines, 147 filesdep ~mtldep ~transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: mtl, transformers

API changes (from Hackage documentation)

Files

• examples/failing/ArrayType.purs +11/−0
• examples/failing/Arrays.purs +5/−0
• examples/failing/Do.purs +8/−0
• examples/failing/KindError.purs +3/−0
• examples/failing/Let.purs +3/−0
• examples/failing/MPTCs.purs +7/−0
• examples/failing/MutRec.purs +5/−0
• examples/failing/MutRec2.purs +3/−0
• examples/failing/NewtypeMultiArgs.purs +3/−0
• examples/failing/NewtypeMultiCtor.purs +3/−0
• examples/failing/NoOverlap.purs +11/−0
• examples/failing/NullaryAbs.purs +3/−0
• examples/failing/Object.purs +5/−0
• examples/failing/OverlappingVars.purs +12/−0
• examples/failing/Rank2Types.purs +7/−0
• examples/failing/Reserved.purs +4/−0
• examples/failing/SkolemEscape.purs +5/−0
• examples/failing/SkolemEscape2.purs +9/−0
• examples/failing/Superclasses1.purs +11/−0
• examples/failing/Superclasses2.purs +9/−0
• examples/failing/Superclasses3.purs +5/−0
• examples/failing/Superclasses4.purs +12/−0
• examples/failing/TypeClassInstances.purs +8/−0
• examples/failing/TypeClasses2.purs +8/−0
• examples/failing/TypeError.purs +5/−0
• examples/failing/TypeSynonyms.purs +5/−0
• examples/failing/TypeSynonyms2.purs +9/−0
• examples/failing/TypeSynonyms3.purs +9/−0
• examples/failing/UnifyInTypeInstanceLookup.purs +17/−0
• examples/failing/UnknownType.purs +4/−0
• examples/failing/UnknownValue.purs +25/−0
• examples/passing/Applicative.purs +16/−0
• examples/passing/ArrayType.purs +9/−0
• examples/passing/Arrays.purs +24/−0
• examples/passing/Auto.purs +13/−0
• examples/passing/AutoPrelude.purs +8/−0
• examples/passing/AutoPrelude2.purs +9/−0
• examples/passing/BindersInFunctions.purs +16/−0
• examples/passing/CheckSynonymBug.purs +14/−0
• examples/passing/CheckTypeClass.purs +16/−0
• examples/passing/Church.purs +18/−0
• examples/passing/Collatz.purs +18/−0
• examples/passing/Comparisons.purs +23/−0
• examples/passing/Conditional.purs +9/−0
• examples/passing/Console.purs +13/−0
• examples/passing/DataAndType.purs +7/−0
• examples/passing/DeepCase.purs +14/−0
• examples/passing/Do.purs +67/−0
• examples/passing/Dollar.purs +16/−0
• examples/passing/Eff.purs +19/−0
• examples/passing/EmptyDataDecls.purs +30/−0
• examples/passing/EmptyTypeClass.purs +12/−0
• examples/passing/EqOrd.purs +14/−0
• examples/passing/ExternData.purs +13/−0
• examples/passing/ExternRaw.purs +13/−0
• examples/passing/FFI.purs +11/−0
• examples/passing/Fib.purs +15/−0
• examples/passing/FinalTagless.purs +22/−0
• examples/passing/ForeignInstance.purs +16/−0
• examples/passing/FunctionScope.purs +17/−0
• examples/passing/Functions.purs +15/−0
• examples/passing/Functions2.purs +17/−0
• examples/passing/Guards.purs +14/−0
• examples/passing/HoistError.purs +17/−0
• examples/passing/ImportHiding.purs +18/−0
• examples/passing/InferRecFunWithConstrainedArgument.purs +8/−0
• examples/passing/JSReserved.purs +12/−0
• examples/passing/Let.purs +64/−0
• examples/passing/LetInInstance.purs +12/−0
• examples/passing/LiberalTypeSynonyms.purs +19/−0
• examples/passing/MPTCs.purs +20/−0
• examples/passing/Match.purs +7/−0
• examples/passing/Monad.purs +32/−0
• examples/passing/MonadState.purs +48/−0
• examples/passing/MultiArgFunctions.purs +26/−0
• examples/passing/MultipleConstructorArgs.purs +21/−0
• examples/passing/MutRec.purs +19/−0
• examples/passing/NamedPatterns.purs +7/−0
• examples/passing/Nested.purs +7/−0
• examples/passing/NestedTypeSynonyms.purs +11/−0
• examples/passing/Newtype.purs +22/−0
• examples/passing/NewtypeEff.purs +28/−0
• examples/passing/ObjectSynonym.purs +13/−0
• examples/passing/ObjectUpdate.purs +18/−0
• examples/passing/Objects.purs +30/−0
• examples/passing/OneConstructor.purs +7/−0
• examples/passing/Operators.purs +80/−0
• examples/passing/OptimizerBug.purs +9/−0
• examples/passing/PartialFunction.purs +17/−0
• examples/passing/Patterns.purs +28/−0
• examples/passing/Person.purs +16/−0
• examples/passing/Rank2Data.purs +29/−0
• examples/passing/Rank2Object.purs +10/−0
• examples/passing/Rank2TypeSynonym.purs +15/−0
• examples/passing/Rank2Types.purs +11/−0
• examples/passing/Recursion.purs +10/−0
• examples/passing/RuntimeScopeIssue.purs +19/−0
• examples/passing/STArray.purs +25/−0
• examples/passing/Sequence.purs +12/−0
• examples/passing/ShadowedRename.purs +19/−0
• examples/passing/ShadowedTCO.purs +16/−0
• examples/passing/ShadowedTCOLet.purs +7/−0
• examples/passing/SignedNumericLiterals.purs +15/−0
• examples/passing/Superclasses1.purs +18/−0
• examples/passing/Superclasses2.purs +23/−0
• examples/passing/Superclasses3.purs +41/−0
• examples/passing/TCOCase.purs +10/−0
• examples/passing/TailCall.purs +15/−0
• examples/passing/Tick.purs +5/−0
• examples/passing/TopLevelCase.purs +18/−0
• examples/passing/TypeClassMemberOrderChange.purs +11/−0
• examples/passing/TypeClasses.purs +69/−0
• examples/passing/TypeClassesInOrder.purs +11/−0
• examples/passing/TypeClassesWithOverlappingTypeVariables.purs +11/−0
• examples/passing/TypeDecl.purs +12/−0
• examples/passing/TypeSynonymInData.purs +9/−0
• examples/passing/TypeSynonyms.purs +25/−0
• examples/passing/TypedWhere.purs +13/−0
• examples/passing/Unit.purs +6/−0
• examples/passing/UnknownInTypeClassLookup.purs +12/−0
• examples/passing/Where.purs +49/−0
• examples/passing/iota.purs +9/−0
• examples/passing/s.purs +5/−0
• prelude/prelude.purs +1/−8
• psci/Commands.hs +4/−4
• psci/Main.hs +18/−17
• purescript.cabal +6/−3
• src/Language/PureScript.hs +1/−1
• src/Language/PureScript/CodeGen/JS.hs +7/−6
• src/Language/PureScript/Constants.hs +3/−0
• src/Language/PureScript/DeadCodeElimination.hs +1/−1
• src/Language/PureScript/Declarations.hs +58/−40
• src/Language/PureScript/Errors.hs +3/−3
• src/Language/PureScript/ModuleDependencies.hs +1/−1
• src/Language/PureScript/Optimizer/Inliner.hs +2/−2
• src/Language/PureScript/Optimizer/MagicDo.hs +1/−1
• src/Language/PureScript/Parser/Declarations.hs +33/−22
• src/Language/PureScript/Pretty/Values.hs +12/−12
• src/Language/PureScript/Renamer.hs +7/−3
• src/Language/PureScript/Sugar/BindingGroups.hs +3/−3
• src/Language/PureScript/Sugar/CaseDeclarations.hs +3/−3
• src/Language/PureScript/Sugar/DoNotation.hs +4/−4
• src/Language/PureScript/Sugar/Names.hs +67/−30
• src/Language/PureScript/Sugar/Operators.hs +8/−8
• src/Language/PureScript/Sugar/TypeClasses.hs +4/−4
• src/Language/PureScript/Sugar/TypeDeclarations.hs +1/−1
• src/Language/PureScript/TypeChecker/Types.hs +42/−39

@@ -0,0 +1,11 @@+module Main where++import Debug.Trace++bar :: Number -> Number -> Number+bar n m = n + m++foo = x `bar` y+  where+  x = 1+  y = []

@@ -0,0 +1,5 @@+module Main where++  import Prelude++  test = \arr -> arr !! (0 !! 0)

@@ -0,0 +1,8 @@+module Main where++test1 = do let x = 1++test2 y = do x <- y++test3 = do return 1+           return 2

@@ -0,0 +1,3 @@+module Main where++  data KindError f a = One f | Two (f a)

@@ -0,0 +1,3 @@+module Main where++test = let x = x in x

@@ -0,0 +1,7 @@+module Main where++class Foo a where+  f :: a -> a++instance fooStringString :: Foo String String where+  f a = a

@@ -0,0 +1,5 @@+module MutRec where++x = y++y = x

@@ -0,0 +1,3 @@+module Main where++x = x

@@ -0,0 +1,3 @@+module Main where++newtype Thing = Thing String Boolean

@@ -0,0 +1,3 @@+module Main where++newtype Thing = Thing String | Other

@@ -0,0 +1,11 @@+module Main where++data Foo = Foo++instance showFoo1 :: Show Foo where+  show _ = "Foo"++instance showFoo2 :: Show Foo where+  show _ = "Bar"++test = show Foo

@@ -0,0 +1,3 @@+module Main where++  func = \ -> "no"

@@ -0,0 +1,5 @@+module Main where++test o = o.foo++test1 = test {}

@@ -0,0 +1,12 @@+module Main where++class OverlappingVars a where+  f :: a -> a++data Foo a b = Foo a b++instance overlappingVarsFoo :: OverlappingVars (Foo a a) where+  f a = a++test = f (Foo "" 0)+

@@ -0,0 +1,7 @@+module Main where++  import Prelude++  foreign import test :: (forall a. a -> a) -> Number++  test1 = test (\n -> n + 1)

@@ -0,0 +1,4 @@+module Main where++(<) :: Number -> Number -> Number+(<) a b = !(a >= b)

@@ -0,0 +1,5 @@+module Main where++  foreign import foo :: (forall a. a -> a) -> Number++  test = \x -> foo x

@@ -0,0 +1,9 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.ST++test _ = do+  r <- runST (newSTRef 0)+  return 0 

@@ -0,0 +1,11 @@+module Main where++class Su a where+  su :: a -> a++class (Su a) <= Cl a where+  cl :: a -> a -> a++instance clNumber :: Cl Number where+  cl n m = n + m+

@@ -0,0 +1,9 @@+module CycleInSuperclasses where++class (Foo a) <= Bar a++class (Bar a) <= Foo a++instance barString :: Bar String++instance fooString :: Foo String

@@ -0,0 +1,5 @@+module UnknownSuperclassTypeVar where++class Foo a++class (Foo b) <= Bar a

@@ -0,0 +1,12 @@+module OverlappingInstances where++class Foo a++instance foo1 :: Foo Number++instance foo2 :: Foo Number++test :: forall a. (Foo a) => a -> a+test a = a++test1 = test 0

@@ -0,0 +1,8 @@+module Main where++class A a where+  a :: a -> String+  b :: a -> Number++instance aString :: A String where+  a s = s

@@ -0,0 +1,8 @@+module Main where++import Prelude ()++class Show a where+  show :: a -> String++test = show "testing"

@@ -0,0 +1,5 @@+module Main where++  import Prelude++  test = 1 ++ "A"

@@ -0,0 +1,5 @@+module Main where++type T1 = [T2]++type T2 = T1

@@ -0,0 +1,9 @@+module Main where++class Foo a where+  foo :: a -> String++type Bar = String++instance fooBar :: Foo Bar where+  foo s = s

@@ -0,0 +1,9 @@+module Main where++class Foo a where+  foo :: a -> String++type Bar = String++instance fooBar :: Foo Bar where+  foo s = s

@@ -0,0 +1,17 @@+module Main where++data Z = Z+data S n = S n++data T+data F++class EQ x y b+instance eqT :: EQ x x T+instance eqF :: EQ x y F++foreign import test :: forall a b. (EQ a b T) => a -> b -> a++foreign import anyNat :: forall a. a++test1 = test anyNat (S Z)

@@ -0,0 +1,4 @@+module Main where++test :: Number -> Something+test = {}

@@ -0,0 +1,25 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.ST+import Debug.Trace++test = runSTArray (do+  a <- newSTArray 2 0+  pokeSTArray a 0 1+  pokeSTArray a 1 2+  return a)++fromTo lo hi = runSTArray (do+  arr <- newSTArray (hi - lo + 1) 0+  (let+    go lo hi _ arr | lo > hi = return arr+    go lo hi i arr = do+      pokeSTArray arrr i lo+      go (lo + 1) hi (i + 1) arr+   in go lo hi 0 arr))++main = do+  let t1 = runPure (fromTo 10 20)+  trace "Done"

@@ -0,0 +1,16 @@+module Main where++import Prelude ()++class Applicative f where+  pure :: forall a. a -> f a+  (<*>) :: forall a b. f (a -> b) -> f a -> f b++data Maybe a = Nothing | Just a++instance applicativeMaybe :: Applicative Maybe where+  pure = Just+  (<*>) (Just f) (Just a) = Just (f a)+  (<*>) _ _ = Nothing++main = Debug.Trace.trace "Done"

@@ -0,0 +1,9 @@+module Main where++class Pointed p where+  point :: forall a. a -> p a++instance pointedArray :: Pointed [] where+  point a = [a]++main = Debug.Trace.trace "Done"

@@ -0,0 +1,24 @@+module Main where++import Prelude.Unsafe (unsafeIndex)++test1 arr = arr `unsafeIndex` 0 + arr `unsafeIndex` 1 + 1++test2 = \arr -> case arr of+  [x, y] -> x + y+  [x] -> x+  [] -> 0+  (x : y : _) -> x + y++data Tree = One Number | Some [Tree]++test3 = \tree sum -> case tree of+  One n -> n+  Some (n1 : n2 : rest) -> test3 n1 sum * 10 + test3 n2 sum * 5 + sum rest++test4 = \arr -> case arr of+  [] -> 0+  [_] -> 0+  x : y : xs -> x * y + test4 xs++main = Debug.Trace.trace "Done"

@@ -0,0 +1,13 @@+module Main where++  data Auto s i o = Auto { state :: s, step :: s -> i -> o }++  type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r++  exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o+  exists = \state step f -> f (Auto { state: state, step: step })++  run :: forall i o. SomeAuto i o -> i -> o+  run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,8 @@+module Main where++import Debug.Trace++f x = x * 10+g y = y - 10++main = trace $ show $ (f <<< g) 100

@@ -0,0 +1,9 @@+module Main where++import qualified Prelude as P+import Debug.Trace++f :: forall a. a -> a+f = P.id++main = P.($) trace ((f P.<<< f) "Done")

@@ -0,0 +1,16 @@+module Main where++import Prelude++tail = \(_:xs) -> xs++foreign import error+  "function error(msg) {\+  \  throw msg;\+  \}" :: forall a. String -> a++main = +  let ts = tail [1, 2, 3] in+  if ts == [2, 3] +  then Debug.Trace.trace "Done"+  else error "Incorrect result from 'tails'."

@@ -0,0 +1,14 @@+module Main where++  import Prelude++  type Foo a = [a]  ++  foreign import length+    "function length(a) {\+    \  return a.length;\+    \}" :: forall a. [a] -> Number++  foo _ = length ([] :: Foo Number)++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,16 @@+module Main where++  data Bar a = Bar+  data Baz++  class Foo a where+    foo :: Bar a -> Baz++  foo_ :: forall a. (Foo a) => a -> Baz+  foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)++  mkBar :: forall a. a -> Bar a+  mkBar _ = Bar++  main = Debug.Trace.trace "Done"+

@@ -0,0 +1,18 @@+module Main where++  import Prelude ()++  type List a = forall r. r -> (a -> r -> r) -> r++  empty :: forall a. List a+  empty = \r f -> r++  cons :: forall a. a -> List a -> List a+  cons = \a l r f -> f a (l r f)++  append :: forall a. List a -> List a -> List a+  append = \l1 l2 r f -> l2 (l1 r f) f++  test = append (cons 1 empty) (cons 2 empty)++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,18 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.ST++collatz :: Number -> Number+collatz n = runPure (runST (do+  r <- newSTRef n+  count <- newSTRef 0+  untilE $ do+    modifySTRef count $ (+) 1+    m <- readSTRef r+    writeSTRef r $ if m % 2 == 0 then m / 2 else 3 * m + 1+    return $ m == 1+  readSTRef count))++main = Debug.Trace.print $ collatz 1000

@@ -0,0 +1,23 @@+module Main where++import Control.Monad.Eff+import Debug.Trace++foreign import data Assert :: !++foreign import assert+  "function assert(x) {\+  \  return function () {\+  \    if (!x) throw new Error('assertion failed');\+  \    return {};\+  \  };\+  \};" :: forall e. Boolean -> Eff (assert :: Assert | e) Unit++main = do+  assert (1 < 2)+  assert (2 == 2)+  assert (3 > 1)+  assert ("a" < "b")+  assert ("a" == "a")+  assert ("z" > "a")+  trace "Done!"

@@ -0,0 +1,9 @@+module Main where++  import Prelude ()++  fns = \f -> if f true then f else \x -> x ++  not = \x -> if x then false else true++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,13 @@+module Main where++import Prelude+import Control.Monad.Eff+import Debug.Trace++replicateM_ :: forall m a. (Monad m) => Number -> m a -> m {}+replicateM_ 0 _ = return {}+replicateM_ n act = do+  act+  replicateM_ (n - 1) act+    +main = replicateM_ 10 (trace "Hello World!")

@@ -0,0 +1,7 @@+module Main where++data A = A B++type B = A++main = Debug.Trace.trace "Done"

@@ -0,0 +1,14 @@+module Main where++import Debug.Trace+import Control.Monad.Eff+import Control.Monad.ST++f x y = +  let+    g = case y of +	  0 -> x+          x -> 1 + x * x+  in g + x + y++main = print $ f 1 10

@@ -0,0 +1,67 @@+module Main where++import Prelude++data Maybe a = Nothing | Just a++instance functorMaybe :: Functor Maybe where+  (<$>) f Nothing = Nothing+  (<$>) f (Just x) = Just (f x)++instance applyMaybe :: Apply Maybe where+  (<*>) (Just f) (Just x) = Just (f x)+  (<*>) _ _ = Nothing++instance applicativeMaybe :: Applicative Maybe where+  pure = Just++instance bindMaybe :: Bind Maybe where+  (>>=) Nothing _ = Nothing+  (>>=) (Just a) f = f a++instance monadMaybe :: Prelude.Monad Maybe++test1 = \_ -> do+  Just "abc"++test2 = \_ -> do+  (x : _) <- Just [1, 2, 3]+  (y : _) <- Just [4, 5, 6]+  Just (x + y)++test3 = \_ -> do+  Just 1+  Nothing :: Maybe Number+  Just 2++test4 mx my = do+  x <- mx+  y <- my+  Just (x + y + 1)++test5 mx my mz = do+  x <- mx+  y <- my+  let sum = x + y+  z <- mz+  Just (z + sum + 1)++test6 mx = \_ -> do+  let+    f :: forall a. Maybe a -> a+    f (Just x) = x+  Just (f mx)++test8 = \_ -> do+  Just (do+    Just 1)++test9 = \_ -> (+) <$> Just 1 <*> Just 2++test10 _ = do+  let+    f x = g x * 3+    g x = f x / 2+  Just (f 10)++main = Debug.Trace.trace "Done"

@@ -0,0 +1,16 @@+module Main where++import Prelude ()++($) :: forall a b. (a -> b) -> a -> b+($) f x = f x++infixr 1000 $++id x = x++test1 x = id $ id $ id $ id $ x++test2 x = id id $ id x+    +main = Debug.Trace.trace "Done"

@@ -0,0 +1,19 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.ST+import Debug.Trace++test1 = do+  trace "Line 1"+  trace "Line 2"++test2 = runPure (runST (do+          ref <- newSTRef 0+          modifySTRef ref $ \n -> n + 1+          readSTRef ref))++main = do+  test1+  Debug.Trace.print test2

@@ -0,0 +1,30 @@+module Main where++import Prelude++data Z+data S n++data ArrayBox n a = ArrayBox [a]++nil :: forall a. ArrayBox Z a+nil = ArrayBox []++foreign import concat+  "function concat(l1) {\+  \  return function (l2) {\+  \    return l1.concat(l2);\+  \  };\+  \}" :: forall a. [a] -> [a] -> [a]++cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a+cons' x (ArrayBox xs) = ArrayBox $ concat [x] xs++foreign import error+    "function error(msg) {\+    \  throw msg;\+    \}" :: forall a. String -> a++main = case cons' 1 $ cons' 2 $ cons' 3 nil of+         ArrayBox [1, 2, 3] -> Debug.Trace.trace "Done"+         _ -> error "Failed"

@@ -0,0 +1,12 @@+module Main where++import Prelude++class Partial++head :: forall a. (Partial) => [a] -> a+head (x:xs) = x++instance allowPartials :: Partial++main = Debug.Trace.trace $ head ["Done"]

@@ -0,0 +1,14 @@+module Main where++data Pair a b = Pair a b++instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where+  compare (Pair a1 b1) (Pair a2 b2) = case compare a1 a2 of+    EQ -> compare b1 b2+    r -> r++instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where+  (==) (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2+  (/=) (Pair a1 b1) (Pair a2 b2) = a1 /= a2 || b1 /= b2++main = Debug.Trace.print $ Pair 1 2 == Pair 1 2

@@ -0,0 +1,13 @@+module Main where++  foreign import data IO :: * -> *++  foreign import bind "function bind() {}" :: forall a b. IO a -> (a -> IO b) -> IO b++  foreign import showMessage "function showMessage() {}" :: String -> IO { }++  foreign import prompt "function prompt() {}" :: IO String++  test _ = prompt `bind` \s -> showMessage s++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,13 @@+module Main where++foreign import first "function first(xs) { return xs[0]; }" :: forall a. [a] -> a++foreign import loop "function loop() { while (true) {} }" :: forall a. a++foreign import concat "function concat(xs) { \+                      \  return function(ys) { \+                      \    return xs.concat(ys); \+                      \  };\+                      \}" :: forall a. [a] -> [a] -> [a]++main = Debug.Trace.trace "Done"

@@ -0,0 +1,11 @@+module Main where++foreign import foo +  "function foo(s) {\+  \  return s;\+  \}" :: String -> String++bar :: String -> String+bar _ = foo "test"++main = Debug.Trace.trace "Done"

@@ -0,0 +1,15 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.ST++main = runST (do+  n1 <- newSTRef 1+  n2 <- newSTRef 1+  whileE ((>) 1000 <$> readSTRef n1) $ do+    n1' <- readSTRef n1+    n2' <- readSTRef n2+    writeSTRef n2 $ n1' + n2'+    writeSTRef n1 n2'+    Debug.Trace.print n2')

@@ -0,0 +1,22 @@+module Main where++import Prelude++class E e where+  num :: Number -> e Number+  add :: e Number -> e Number -> e Number+  +type Expr a = forall e. (E e) => e a++data Id a = Id a++instance exprId :: E Id where+  num = Id+  add (Id n) (Id m) = Id (n + m)++runId (Id a) = a++three :: Expr Number+three = add (num 1) (num 2)++main = Debug.Trace.print $ runId three

@@ -0,0 +1,16 @@+module Main where++class Foo a where+  foo :: a -> String++foreign import instance fooArray :: (Foo a) => Foo [a]++foreign import instance fooNumber :: Foo Number++foreign import instance fooString :: Foo String++test1 _ = foo [1, 2, 3]++test2 _ = foo "Test"++main = Debug.Trace.trace "Done"

@@ -0,0 +1,17 @@+module Main where++  import Prelude++  mkValue :: Number -> Number+  mkValue id = id++  foreign import error +    "function error(msg) {\+    \  throw msg;\+    \}" :: forall a. String -> a++  main = do+    let value = mkValue 1+    if value == 1+      then Debug.Trace.trace "Done"+      else error "Not done"

@@ -0,0 +1,15 @@+module Main where++  import Prelude++  test1 = \_ -> 0++  test2 = \a b -> a + b + 1++  test3 = \a -> a++  test4 = \(%%) -> 1 %% 2++  test5 = \(+++) (***) -> 1 +++ 2 *** 3++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,17 @@+module Main where++  import Prelude++  test :: forall a b. a -> b -> a+  test = \const _ -> const++  foreign import error+    "function error(msg) {\+    \  throw msg;\+    \}" :: forall a. String -> a++  main = do+    let value = test "Done" {}+    if value == "Done"+      then Debug.Trace.trace "Done"+      else error "Not done"

@@ -0,0 +1,14 @@+module Main where++  import Prelude++  collatz = \x -> case x of+    y | y % 2 == 0 -> y / 2+    y -> y * 3 + 1++  -- Guards have access to current scope+  collatz2 = \x y -> case x of+    z | y > 0 -> z / 2+    z -> z * 3 + 1++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,17 @@+module Main where++import Control.Monad.Eff+import Debug.Trace++foreign import f+  "function f(x) {\+  \  return function () {\+  \    if (x !== 0) throw new Error('x is not 0');\+  \  }\+  \}" :: forall e. Number -> Eff e Number++main = do+  let x = 0+  f x+  let x = 1 + 1+  trace "Done"

@@ -0,0 +1,18 @@+module Main where++import Debug.Trace+import Prelude hiding (+  show, -- a value+  Show, -- a type class+  Unit(..)  -- a constructor+  )++show = 1++class Show a where+  noshow :: a -> a++data Unit = X | Y++main = do+  print show

@@ -0,0 +1,8 @@+module Main where++import Prelude++test 100 = 100+test n = test(1 + n)++main = Debug.Trace.print $ test 0

@@ -0,0 +1,12 @@+module Main where++  import Prelude++  yield = 0+  member = 1+  +  public = \return -> return+  +  this catch = catch++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,64 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.ST++test1 x = let +            y :: Number+            y = x + 1 +          in y++test2 x y = +  let x' = x + 1 in+  let y' = y + 1 in+  x' + y'++test3 = let f x y z = x + y + z in+        f 1 2 3++test4 = let f x [y, z] = x y z in +        f (+) [1, 2]++test5 = let +          f x | x > 0 = g (x / 2) + 1+          f x = 0+          g x = f (x - 1) + 1+        in f 10++test6 = runPure (runST (do+          r <- newSTRef 0+          (let+            go [] = readSTRef r+            go (n : ns) = do+              modifySTRef r ((+) n)+              go ns+           in go [1, 2, 3, 4, 5])+        ))++test7 = let+          f :: forall a. a -> a+          f x = x+        in if f true then f 1 else f 2++test8 :: Number -> Number+test8 x = let +            go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y+            go y = go $ (y + x / y) / 2+          in go x++test10 _ = +  let+    f x = g x * 3+    g x = f x / 2+  in f 10++main = do+  Debug.Trace.print (test1 1)+  Debug.Trace.print (test2 1 2)+  Debug.Trace.print test3+  Debug.Trace.print test4+  Debug.Trace.print test5+  Debug.Trace.print test6+  Debug.Trace.print test7+  Debug.Trace.print (test8 100)

@@ -0,0 +1,12 @@+module Main where++class Foo a where+  foo :: a -> String++instance fooString :: Foo String where+  foo = go+    where+    go :: String -> String+    go s = s++main = Debug.Trace.trace "Done"

@@ -0,0 +1,19 @@+module Main where++type Reader = (->) String++foo :: Reader String+foo s = s++type AndFoo r = (foo :: String | r)++getFoo :: forall r. Prim.Object (AndFoo r) -> String+getFoo o = o.foo++type F r = { | r } -> { | r }++f :: (forall r. F r) -> String+f g = case g { x: "Hello" } of+        { x = x } -> x++main = Debug.Trace.trace "Done"

@@ -0,0 +1,20 @@+module Main where++import Prelude++class NullaryTypeClass where+  greeting :: String++instance nullaryTypeClass :: NullaryTypeClass where+  greeting = "Hello, World!"++class Coerce a b where+  coerce :: a -> b++instance coerceRefl :: Coerce a a where+  coerce a = a++instance coerceShow :: (Prelude.Show a) => Coerce a String where+  coerce = show++main = Debug.Trace.trace "Done"

@@ -0,0 +1,7 @@+module Main where++  data Foo a = Foo++  foo = \f -> case f of Foo -> "foo"++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,32 @@+module Main where++  import Prelude ()++  type Monad m = { return :: forall a. a -> m a+		 , bind :: forall a b. m a -> (a -> m b) -> m b }++  data Id a = Id a++  id :: Monad Id+  id = { return : Id+       , bind : \ma f -> case ma of Id a -> f a }++  data Maybe a = Nothing | Just a++  maybe :: Monad Maybe+  maybe = { return : Just+	  , bind : \ma f -> case ma of+	      Nothing -> Nothing+	      Just a -> f a +	  }++  test :: forall m. Monad m -> m Number+  test = \m -> m.bind (m.return 1) (\n1 ->+		 m.bind (m.return "Test") (\n2 -> +		   m.return n1))++  test1 = test id++  test2 = test maybe++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,48 @@+module Main where++import Prelude++data Tuple a b = Tuple a b++class MonadState s m where+  get :: m s+  put :: s -> m {}++data State s a = State (s -> Tuple s a)++runState s (State f) = f s++instance functorState :: Functor (State s) where+  (<$>) = liftM1++instance applyState :: Apply (State s) where+  (<*>) = ap++instance applicativeState :: Applicative (State s) where+  pure a = State $ \s -> Tuple s a++instance bindState :: Bind (State s) where+  (>>=) f g = State $ \s -> case runState s f of+                              Tuple s1 a -> runState s1 (g a)++instance monadState :: Monad (State s)++instance monadStateState :: MonadState s (State s) where+  get = State (\s -> Tuple s s)+  put s = State (\_ -> Tuple s {})++modify :: forall m s. (Prelude.Monad m, MonadState s m) => (s -> s) -> m {}+modify f = do+  s <- get+  put (f s)++test :: Tuple String String+test = runState "" $ do+  modify $ (++) "World!"+  modify $ (++) "Hello, "+  get++main = do+  let t1 = test+  Debug.Trace.trace "Done"+

@@ -0,0 +1,26 @@+module Main where++import Data.Function+import Control.Monad.Eff+import Debug.Trace++f = mkFn2 $ \a b -> runFn2 g a b + runFn2 g b a++g = mkFn2 $ \a b -> case {} of+  _ | a <= 0 || b <= 0 -> b+  _ -> runFn2 f (a - 1) (b - 1)++main = do+  runFn0 (mkFn0 $ \_ -> trace $ show 0)+  runFn1 (mkFn1 $ \a -> trace $ show a) 1+  runFn2 (mkFn2 $ \a b -> trace $ show [a, b]) 1 2+  runFn3 (mkFn3 $ \a b c -> trace $ show [a, b, c]) 1 2 3+  runFn4 (mkFn4 $ \a b c d -> trace $ show [a, b, c, d]) 1 2 3 4+  runFn5 (mkFn5 $ \a b c d e -> trace $ show [a, b, c, d, e]) 1 2 3 4 5+  runFn6 (mkFn6 $ \a b c d e f -> trace $ show [a, b, c, d, e, f]) 1 2 3 4 5 6+  runFn7 (mkFn7 $ \a b c d e f g -> trace $ show [a, b, c, d, e, f, g]) 1 2 3 4 5 6 7+  runFn8 (mkFn8 $ \a b c d e f g h -> trace $ show [a, b, c, d, e, f, g, h]) 1 2 3 4 5 6 7 8+  runFn9 (mkFn9 $ \a b c d e f g h i -> trace $ show [a, b, c, d, e, f, g, h, i]) 1 2 3 4 5 6 7 8 9+  runFn10 (mkFn10 $ \a b c d e f g h i j-> trace $ show [a, b, c, d, e, f, g, h, i, j]) 1 2 3 4 5 6 7 8 9 10+  print $ runFn2 g 15 12+  trace "Done!"

@@ -0,0 +1,21 @@+module Main where++import Prelude+import Control.Monad.Eff++data P a b = P a b++runP :: forall a b r. (a -> b -> r) -> P a b -> r+runP f (P a b) = f a b++idP = runP P++testCase = \p -> case p of+  P (x:xs) (y:ys) -> x + y+  P _ _ -> 0++test1 = testCase (P [1, 2, 3] [4, 5, 6])++main = do+  Debug.Trace.trace (runP (\s n -> s ++ show n) (P "Test" 1))+  Debug.Trace.print test1

@@ -0,0 +1,19 @@+module Main where ++  import Prelude++  f 0 = 0+  f x = g x + 1++  g x = f (x / 2)++  data Even = Zero | Even Odd++  data Odd = Odd Even++  evenToNumber Zero = 0+  evenToNumber (Even n) = oddToNumber n + 1++  oddToNumber (Odd n) = evenToNumber n + 1++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,7 @@+module Main where++  foo = \x -> case x of +    y@{ foo = "Foo" } -> y+    y -> y++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,7 @@+module Main where++  data Extend r a = Extend { prev :: r a, next :: a }++  data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,11 @@+module Main where++  import Prelude++  type X = String+  type Y = X -> X++  fn :: Y+  fn a = a++  main = Debug.Trace.print (fn "Done")

@@ -0,0 +1,22 @@+module Main where++import Control.Monad.Eff+import Debug.Trace++newtype Thing = Thing String++instance showThing :: Show Thing where+  show (Thing x) = "Thing " ++ show x++newtype Box a = Box a++instance showBox :: (Show a) => Show (Box a) where+  show (Box x) = "Box " ++ show x+  +apply f x = f x+ +main = do+  print $ Thing "hello"+  print $ Box 42+  print $ apply Box 9000+  trace "Done"

@@ -0,0 +1,28 @@+module Main where++import Debug.Trace+import Control.Monad.Eff++newtype T a = T (Eff (trace :: Trace) a)++runT :: forall a. T a -> Eff (trace :: Trace) a+runT (T t) = t++instance functorT :: Functor T where+  (<$>) f (T t) = T (f <$> t)++instance applyT :: Apply T where+  (<*>) (T f) (T x) = T (f <*> x)++instance applicativeT :: Applicative T where+  pure t = T (pure t)++instance bindT :: Bind T where+  (>>=) (T t) f = T (t >>= \x -> runT (f x))++instance monadT :: Monad T++main = runT do+  T $ trace "Done"+  T $ trace "Done"+  T $ trace "Done"

@@ -0,0 +1,13 @@+module Main where++type Inner = Number++inner :: Inner+inner = 0++type Outer = { inner :: Inner }++outer :: Outer+outer = { inner: inner }++main = Debug.Trace.trace "Done"  

@@ -0,0 +1,18 @@+module Main where++  update1 = \o -> o { foo = "Foo" }++  update2 :: forall r. { foo :: String | r } -> { foo :: String | r }+  update2 = \o -> o { foo = "Foo" }++  replace = \o -> case o of+    { foo = "Foo" } -> o { foo = "Bar" }+    { foo = "Bar" } -> o { bar = "Baz" }+    o -> o++  polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }+  polyUpdate = \o -> o { foo = "Foo" }++  inferPolyUpdate = \o -> o { foo = "Foo" }++  main = Debug.Trace.trace ((update1 {foo: ""}).foo)

@@ -0,0 +1,30 @@+module Main where++  import Prelude++  test = \x -> x.foo + x.bar + 1++  append = \o -> { foo: o.foo, bar: 1 }++  apTest = append({foo : "Foo", baz: "Baz"})++  f = (\a -> a.b.c) { b: { c: 1, d: "Hello" }, e: "World" }++  g = (\a -> a.f { x: 1, y: "y" }) { f: \o -> o.x + 1 }++  typed :: { foo :: Number }+  typed = { foo: 0 }++  test2 = \x -> x."!@#"++  test3 = typed."foo"++  test4 = test2 weirdObj+    where+    weirdObj :: { "!@#" :: Number }+    weirdObj = { "!@#": 1 }++  test5 = case { "***": 1 } of+    { "***" = n } -> n+    +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,7 @@+module Main where++data One a = One a++one (One a) = a++main = Debug.Trace.trace "Done"

@@ -0,0 +1,80 @@+module Main where++  import Control.Monad.Eff+  import Debug.Trace+  +  (?!) :: forall a. a -> a -> a+  (?!) x _ = x++  bar :: String -> String -> String+  bar = \s1 s2 -> s1 ++ s2++  test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n+  test1 x y z = x * y + z x y++  test2 = (\x -> x.foo false) { foo : \_ -> 1 }++  test3 = (\x y -> x)(1 + 2 * (1 + 2)) (true && (false || false))++  k = \x -> \y -> x++  test4 = 1 `k` 2++  infixl 5 %%++  (%%) :: Number -> Number -> Number+  (%%) x y = x * y + y++  test5 = 1 %% 2 %% 3++  test6 = ((\x -> x) `k` 2) 3++  (<+>) :: String -> String -> String +  (<+>) = \s1 s2 -> s1 ++ s2++  test7 = "Hello" <+> "World!"++  (@@) :: forall a b. (a -> b) -> a -> b+  (@@) = \f x -> f x++  foo :: String -> String+  foo = \s -> s+ +  test8 = foo @@ "Hello World"++  test9 = Main.foo @@ "Hello World"++  test10 = "Hello" `Main.bar` "World"++  (...) :: forall a. [a] -> [a] -> [a]+  (...) = \as -> \bs -> as++  test11 = [1, 2, 3] ... [4, 5, 6]++  test12 (<%>) a b = a <%> b+  +  test13 = \(<%>) a b -> a <%> b++  test14 :: Number -> Number -> Boolean+  test14 a b = a < b++  test15 :: Number -> Number -> Boolean+  test15 a b = const false $ a `test14` b++  main = do+    let t1 = test1 1 2 (\x y -> x + y)+    let t2 = test2+    let t3 = test3+    let t4 = test4+    let t5 = test5+    let t6 = test6+    let t7 = test7+    let t8 = test8+    let t9 = test9+    let t10 = test10+    let t11 = test11+    let t12 = test12 k 1 2+    let t13 = test13 k 1 2+    let t14 = test14 1 2+    let t15 = test15 1 2+    trace "Done"

@@ -0,0 +1,9 @@+module Main where++import Prelude++x a = 1 + y a++y a = x a+    +main = Debug.Trace.trace "Done"

@@ -0,0 +1,17 @@+module Main where++foreign import testError+  "function testError(f) {\+  \  try {\+  \    return f();\+  \  } catch (e) {\+  \    if (e instanceof Error) return 'success';\+  \    throw new Error('Pattern match failure is not Error');\+  \  }\+  \}" :: (Unit -> Number) -> String++fn :: Number -> Number+fn 0 = 0+fn 1 = 2++main = Debug.Trace.trace (show $ testError $ \_ -> fn 2)

@@ -0,0 +1,28 @@+module Main where++  import Prelude++  test = \x -> case x of +    { str = "Foo", bool = true } -> true+    { str = "Bar", bool = b } -> b+    _ -> false++  f = \o -> case o of+    { foo = "Foo" } -> o.bar+    _ -> 0++  g = \o -> case o of+    { arr = [x : xs], take = "car" } -> x+    { arr = [_, x : xs], take = "cadr" } -> x+    _ -> 0+++  h = \o -> case o of +    a@[_,_,_] -> a+    _ -> []++  isDesc :: [Number] -> Boolean+  isDesc [x, y] | x > y = true+  isDesc _ = false+    +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,16 @@+module Main where++  import Prelude ((++))++  data Person = Person { name :: String, age :: Number }++  foreign import itoa +    "function itoa(n) {\+    \  return n.toString();\+    \}" :: Number -> String+	  +  showPerson :: Person -> String+  showPerson = \p -> case p of+    Person o -> o.name ++ ", aged " ++ itoa(o.age)+    +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,29 @@+module Main where++  import Prelude++  data Id = Id forall a. a -> a++  runId = \id a -> case id of+    Id f -> f a++  data Nat = Nat forall r. r -> (r -> r) -> r++  runNat = \nat -> case nat of+    Nat f -> f 0 (\n -> n + 1)++  zero = Nat (\zero _ -> zero)++  succ = \n -> case n of+    Nat f -> Nat (\zero succ -> succ (f zero succ))++  add = \n m -> case n of+    Nat f -> case m of+      Nat g -> Nat (\zero succ -> g (f zero succ) succ)++  one = succ zero+  two = succ zero+  four = add two two+  fourNumber = runNat four+   +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,10 @@+module Main where++import Debug.Trace++data Foo = Foo { id :: forall a. a -> a }++foo :: Foo -> Number+foo (Foo { id = f }) = f 0++main = trace "Done"

@@ -0,0 +1,15 @@+module Main where++import Control.Monad.Eff++type Foo a = forall f. (Monad f) => f a+ +foo :: forall a. a -> Foo a+foo x = pure x+ +bar :: Foo Number+bar = foo 3++main = do+  x <- bar+  Debug.Trace.print x

@@ -0,0 +1,11 @@+module Main where++  import Prelude++  test1 :: (forall a. (a -> a)) -> Number+  test1 = \f -> f 0++  forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b+  forever = \bind action -> bind action $ \_ -> forever bind action+    +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,10 @@+module Main where++  import Prelude++  fib = \n -> case n of+    0 -> 1+    1 -> 1+    n -> fib (n - 1) + fib (n - 2)+   +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,19 @@+module Main where++import Prelude++class A a where+  a :: a -> Boolean++class B a where+  b :: a -> Boolean++instance aNumber :: A Number where+  a 0 = true+  a n = b (n - 1)++instance bNumber :: B Number where+  b 0 = false+  b n = a (n - 1)++main = Debug.Trace.print $ a 10

@@ -0,0 +1,25 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.ST+import Debug.Trace++test = runSTArray (do+  a <- newSTArray 2 0+  pokeSTArray a 0 1+  pokeSTArray a 1 2+  return a)++fromTo lo hi = runSTArray (do+  arr <- newSTArray (hi - lo + 1) 0+  (let+    go lo hi _ arr | lo > hi = return arr+    go lo hi i arr = do+      pokeSTArray arr i lo+      go (lo + 1) hi (i + 1) arr+   in go lo hi 0 arr))++main = do+  let t1 = runPure (fromTo 10 20)+  trace "Done"

@@ -0,0 +1,12 @@+module Main where++import Control.Monad.Eff++class Sequence t where+  sequence :: forall m a. (Monad m) => t (m a) -> m (t a)+  +instance sequenceArray :: Sequence [] where+  sequence [] = pure []+  sequence (x:xs) = (:) <$> x <*> sequence xs ++main = sequence $ [Debug.Trace.trace "Done"]

@@ -0,0 +1,19 @@+module Main where++import Control.Monad.Eff+import Debug.Trace++foreign import f+  "function f(x) {\+  \  return function () {\+  \    if (x !== 2) throw new Error('x is not 2');\+  \  }\+  \}" :: forall e. Number -> Eff e Number++foo foo = let foo_1 = \_ -> foo+              foo_2 = foo_1 unit + 1+          in foo_2++main = do+  f (foo 1)+  trace "Done"

@@ -0,0 +1,16 @@+module Main where++runNat f = f 0 (\n -> n + 1)++zero z _ = z++succ f zero succ = succ (f zero succ)++add f g zero succ = g (f zero succ) succ++one = succ zero+two = succ one+four = add two two+fourNumber = runNat four++main = Debug.Trace.trace $ show fourNumber

@@ -0,0 +1,7 @@+module Main where++f x y z = +  let f 1 2 3 = 1 +  in f x z y+  +main = Debug.Trace.trace $ show $ f 1 3 2

@@ -0,0 +1,15 @@+module Main where++  p = 0.5+  q = 1+  x = -1+  y = -0.5+  z = 0.5+  w = 1+ +  f :: Number -> Number+  f x = -x++  test1 = 2 - 1+  +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,18 @@+module Main where++class Su a where+  su :: a -> a++class (Su a) <= Cl a where+  cl :: a -> a -> a++instance suNumber :: Su Number where+  su n = n + 1++instance clNumber :: Cl Number where+  cl n m = n + m++test :: forall a. (Cl a) => a -> a+test a = su (cl a a)++main = Debug.Trace.print $ test 10

@@ -0,0 +1,23 @@+module Main where++import Prelude.Unsafe (unsafeIndex)++class Su a where+  su :: a -> a++class (Su [a]) <= Cl a where+  cl :: a -> a -> a++instance suNumber :: Su Number where+  su n = n + 1++instance suArray :: (Su a) => Su [a] where+  su (x : _) = [su x]++instance clNumber :: Cl Number where+  cl n m = n + m++test :: forall a. (Cl a) => a -> [a]+test x = su [cl x x]++main = Debug.Trace.print $ test 10 `unsafeIndex` 0

@@ -0,0 +1,41 @@+module Main where++import Debug.Trace++import Control.Monad.Eff++class (Monad m) <= MonadWriter w m where+  tell :: w -> m Unit++testFunctor :: forall m. (Monad m) => m Number -> m Number+testFunctor n = (+) 1 <$> n++test :: forall w m. (Monad m, MonadWriter w m) => w -> m Unit+test w = do+  tell w+  tell w+  tell w++data MTrace a = MTrace (Eff (trace :: Trace) a)++runMTrace :: forall a. MTrace a -> Eff (trace :: Trace) a+runMTrace (MTrace a) = a++instance functorMTrace :: Functor MTrace where+  (<$>) = liftM1++instance applyMTrace :: Apply MTrace where+  (<*>) = ap++instance applicativeMTrace :: Applicative MTrace where+  pure = MTrace <<< return++instance bindMTrace :: Bind MTrace where+  (>>=) m f = MTrace (runMTrace m >>= (runMTrace <<< f))++instance monadMTrace :: Monad MTrace ++instance writerMTrace :: MonadWriter String MTrace where+  tell s = MTrace (trace s)++main = runMTrace $ test "Done"

@@ -0,0 +1,10 @@+module Main where++data Data = One | More Data++main = Debug.Trace.trace (from (to 10000 One))+  where+  to 0 a = a+  to n a = to (n - 1) (More a)+  from One = "Done"+  from (More d) = from d

@@ -0,0 +1,15 @@+module Main where++import Prelude++test :: Number -> [Number] -> Number+test n [] = n+test n (x:xs) = test (n + x) xs++loop :: forall a. Number -> a+loop x = loop (x + 1)++notATailCall = \x -> +  (\notATailCall -> notATailCall x) (\x -> x)+    +main = Debug.Trace.print (test 0 [1, 2, 3])

@@ -0,0 +1,5 @@+module Main where++test' x = x++main = Debug.Trace.trace "Done"

@@ -0,0 +1,18 @@+module Main where++  import Prelude++  gcd :: Number -> Number -> Number+  gcd 0 x = x+  gcd x 0 = x+  gcd x y | x > y = gcd (x % y) y+  gcd x y = gcd (y % x) x++  guardsTest (x:xs) | x > 0 = guardsTest xs+  guardsTest xs = xs++  data A = A++  parseTest A 0 = 0+    +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,11 @@+module Main where++class Test a where+  fn :: a -> a -> a+  val :: a+  +instance testBoolean :: Test Boolean where+  val = true+  fn x y = y++main = Debug.Trace.trace (show (fn true val))

@@ -0,0 +1,69 @@+module Main where++import Prelude++test1 = \_ -> show "testing"++f :: forall a. (Prelude.Show a) => a -> String+f x = show x++test2 = \_ -> f "testing"++test7 :: forall a. (Prelude.Show a) => a -> String+test7 = show++test8 = \_ -> show $ "testing"++data Data a = Data a++instance showData :: (Prelude.Show a) => Prelude.Show (Data a) where+  show (Data a) = "Data (" ++ show a ++ ")"++test3 = \_ -> show (Data "testing")++instance functorData :: Functor Data where+  (<$>) = liftM1++instance applyData :: Apply Data where+  (<*>) = ap++instance applicativeData :: Applicative Data where+  pure = Data++instance bindData :: Bind Data where+  (>>=) (Data a) f = f a++instance monadData :: Monad Data++data Maybe a = Nothing | Just a++instance functorMaybe :: Functor Maybe where+  (<$>) = liftM1++instance applyMaybe :: Apply Maybe where+  (<*>) = ap++instance applicativeMaybe :: Applicative Maybe where+  pure = Just++instance bindMaybe :: Bind Maybe where+  (>>=) Nothing _ = Nothing+  (>>=) (Just a) f = f a++instance monadMaybe :: Monad Maybe++test4 :: forall a m. (Monad m) => a -> m Number+test4 = \_ -> return 1++test5 = \_ -> Just 1 >>= \n -> return (n + 1)++ask r = r++runReader r f = f r++test9 _ = runReader 0 $ do+  n <- ask+  return $ n + 1++main = Debug.Trace.trace (test7 "Done")+

@@ -0,0 +1,11 @@+module Main where++import Prelude++class Foo a where+  foo :: a -> String++instance fooString :: Foo String where+  foo s = s++main = Debug.Trace.trace $ foo "Done"

@@ -0,0 +1,11 @@+module Main where++  import Prelude++  data Either a b = Left a | Right b++  instance functorEither :: Prelude.Functor (Either a) where+    (<$>) _ (Left x) = Left x+    (<$>) f (Right y) = Right (f y)++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,12 @@+module Main where++  import Prelude++  k :: String -> Number -> String+  k x y = x++  iterate :: forall a. Number -> (a -> a) -> a -> a+  iterate 0 f a = a+  iterate n f a = iterate (n - 1) f (f a)+    +  main = Debug.Trace.trace "Done"

@@ -0,0 +1,9 @@+module Main where++type A a = [a]++data Foo a = Foo (A a) | Bar++foo (Foo []) = Bar++main = Debug.Trace.trace "Done"

@@ -0,0 +1,25 @@+module Main where++  type Lens a b = +    { get :: a -> b+    , set :: a -> b -> a+    }++  composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c+  composeLenses = \l1 -> \l2 ->+    { get: \a -> l2.get (l1.get a)+    , set: \a c -> l1.set a (l2.set (l1.get a) c)+    }++  type Pair a b = { fst :: a, snd :: b }++  fst :: forall a b. Lens (Pair a b) a+  fst = +    { get: \p -> p.fst+    , set: \p a -> { fst: a, snd: p.snd }+    }++  test1 :: forall a b c. Lens (Pair (Pair a b) c) a+  test1 = composeLenses fst fst++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,13 @@+module Main where++data E a b = L a | R b++lefts :: forall a b. [E a b] -> [a]+lefts = go []+  where+  go :: forall a b. [a] -> [E a b] -> [a]+  go ls [] = ls+  go ls (L a : rest) = go (a : ls) rest+  go ls (_ : rest) = go ls rest++main = Debug.Trace.trace "Done"

@@ -0,0 +1,6 @@+module Main where++import Prelude+import Debug.Trace++main = print (const unit $ "Hello world")

@@ -0,0 +1,12 @@+module Main where++class EQ a b++instance eqAA :: EQ a a++test :: forall a b. (EQ a b) => a -> b -> String+test _ _ = "Done"++runTest a = test a a++main = Debug.Trace.trace $ runTest 0

@@ -0,0 +1,49 @@+module Main where++import Prelude+import Control.Monad.Eff+import Control.Monad.ST++test1 x = y+  where+  y :: Number+  y = x + 1 ++test2 x y = x' + y'+  where+  x' = x + 1+  y' = y + 1+  ++test3 = f 1 2 3+  where f x y z = x + y + z+        ++test4 = f (+) [1, 2]+  where f x [y, z] = x y z+        ++test5 = g 10+  where +  f x | x > 0 = g (x / 2) + 1+  f x = 0+  g x = f (x - 1) + 1++test6 = if f true then f 1 else f 2+  where f :: forall a. a -> a+        f x = x++test7 :: Number -> Number+test7 x = go x+  where +  go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y+  go y = go $ (y + x / y) / 2++main = do+  Debug.Trace.print (test1 1)+  Debug.Trace.print (test2 1 2)+  Debug.Trace.print test3+  Debug.Trace.print test4+  Debug.Trace.print test5+  Debug.Trace.print test6+  Debug.Trace.print (test7 100)

@@ -0,0 +1,9 @@+module Main where++  s = \x -> \y -> \z -> x z (y z)++  k = \x -> \y -> x++  iota = \x -> x s k++  main = Debug.Trace.trace "Done"

@@ -0,0 +1,5 @@+module Main where++  s = \x y z -> x z (y z)+    +  main = Debug.Trace.trace "Done"

@@ -10,7 +10,6 @@   , Functor, (<$>), void   , Apply, (<*>)   , Applicative, pure, liftA1-  , Alternative, empty, (<|>)   , Bind, (>>=)   , Monad, return, liftM1, ap   , Num, (+), (-), (*), (/), (%)@@ -130,12 +129,6 @@   liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b   liftA1 f a = pure f <*> a -  infixl 3 <|>--  class Alternative f where-    empty :: forall a. f a-    (<|>) :: forall a. f a -> f a -> f a-   infixl 1 >>=    class (Apply m) <= Bind m where@@ -344,7 +337,7 @@     \    };\     \  };\     \}" :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering-    +   unsafeCompare :: forall a. a -> a -> Ordering   unsafeCompare = unsafeCompareImpl LT EQ GT 

@@ -24,7 +24,7 @@   -- |   -- A purescript expression   ---  = Expression Value+  = Expression Expr   -- |   -- Show the help command   --@@ -48,14 +48,14 @@   -- |   -- Binds a value to a name   ---  | Let (Value -> Value)+  | Let (Expr -> Expr)   -- |   -- Find the type of an expression   ---  | TypeOf Value+  | TypeOf Expr   -- |   -- Find the kind of an expression-  -- +  --   | KindOf Type  -- |

@@ -66,7 +66,7 @@   { psciImportedFilenames   :: [FilePath]   , psciImportedModuleNames :: [P.ModuleName]   , psciLoadedModules       :: [(FilePath, P.Module)]-  , psciLetBindings         :: [P.Value -> P.Value]+  , psciLetBindings         :: [P.Expr -> P.Expr]   }  -- State helpers@@ -92,7 +92,7 @@ -- | -- Updates the state to have more let bindings. ---updateLets :: (P.Value -> P.Value) -> PSCiState -> PSCiState+updateLets :: (P.Expr -> P.Expr) -> PSCiState -> PSCiState updateLets name st = st { psciLetBindings = name : psciLetBindings st }  -- File helpers@@ -234,7 +234,7 @@     mkdirp path     U.writeFile path text   liftError = either throwError return-  progress s = unless (s == "Compiling Main") $ makeIO . U.putStrLn $ s+  progress s = unless (s == "Compiling $PSCI") $ makeIO . U.putStrLn $ s  mkdirp :: FilePath -> IO () mkdirp = createDirectoryIfMissing True . takeDirectory@@ -242,11 +242,11 @@ -- | -- Makes a volatile module to execute the current expression. ---createTemporaryModule :: Bool -> PSCiState -> P.Value -> P.Module+createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetBindings = lets} value =   let-    moduleName = P.ModuleName [P.ProperName "Main"]-    importDecl m = P.ImportDeclaration m Nothing Nothing+    moduleName = P.ModuleName [P.ProperName "$PSCI"]+    importDecl m = P.ImportDeclaration m P.Unqualified Nothing     traceModule = P.ModuleName [P.ProperName "Debug", P.ProperName "Trace"]     trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))     itValue = foldl (\x f -> f x) value lets@@ -263,8 +263,8 @@ createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module createTemporaryModuleForKind PSCiState{psciImportedModuleNames = imports} typ =   let-    moduleName = P.ModuleName [P.ProperName "Main"]-    importDecl m = P.ImportDeclaration m Nothing Nothing+    moduleName = P.ModuleName [P.ProperName "$PSCI"]+    importDecl m = P.ImportDeclaration m P.Unqualified Nothing     itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ   in     P.Module moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing@@ -278,15 +278,15 @@ -- | -- Takes a value declaration and evaluates it with the current state. ---handleDeclaration :: P.Value -> PSCI ()+handleDeclaration :: P.Expr -> PSCI () handleDeclaration value = do   st <- PSCI $ lift get   let m = createTemporaryModule True st value-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)])   case e of     Left err -> PSCI $ outputStrLn err     Right _ -> do-      psciIO $ writeFile indexFile $ "require('Main').main();"+      psciIO $ writeFile indexFile $ "require('$PSCI').main();"       process <- psciIO findNodeProcess       result  <- psciIO $ traverse (\node -> readProcessWithExitCode node [indexFile] "") process       case result of@@ -297,15 +297,15 @@ -- | -- Takes a value and prints its type ---handleTypeOf :: P.Value -> PSCI ()+handleTypeOf :: P.Expr -> PSCI () handleTypeOf value = do   st <- PSCI $ lift get   let m = createTemporaryModule False st value-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)])   case e of     Left err -> PSCI $ outputStrLn err     Right env' ->-      case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of+      case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of         Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty         Nothing -> PSCI $ outputStrLn "Could not find type" @@ -316,8 +316,8 @@ handleKindOf typ = do   st <- PSCI $ lift get   let m = createTemporaryModuleForKind st typ-      mName = P.ModuleName [P.ProperName "Main"]-  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("Main.purs", m)])+      mName = P.ModuleName [P.ProperName "$PSCI"]+  e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)])   case e of     Left err -> PSCI $ outputStrLn err     Right env' ->@@ -325,7 +325,7 @@         Just (_, typ') -> do           let chk = P.CheckState env' 0 0 (Just mName)               k   = L.runStateT (P.unCheck (P.kindOf mName typ')) chk-          case k of +          case k of             Left errStack   -> PSCI . outputStrLn . P.prettyPrintErrorStack False $ errStack             Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind         Nothing -> PSCI $ outputStrLn "Could not find kind"@@ -340,6 +340,7 @@   firstLine <- getInputLine "> "   case firstLine of     Nothing -> return (Right Nothing)+    Just "" -> return (Right Nothing)     Just s@ (':' : _) -> return . either Left (Right . Just) $ parseCommand s -- The start of a command     Just s -> either Left (Right . Just) . parseCommand <$> go [s]   where

@@ -1,5 +1,5 @@ name: purescript-version: 0.5.4+version: 0.5.4.1 cabal-version: >=1.8 build-type: Custom license: MIT@@ -17,14 +17,17 @@ data-files: prelude/prelude.purs data-dir: "" +extra-source-files: examples/passing/*.purs+                  , examples/failing/*.purs+ source-repository head     type: git     location: https://github.com/purescript/purescript.git  library     build-depends: base >=4 && <5, cmdtheline == 0.2.*, containers -any, unordered-containers -any,-                   directory >= 1.2, filepath -any, mtl >= 2.1.0 && < 2.2.0, parsec -any,-                   transformers >= 0.3 && < 0.4, utf8-string -any,+                   directory >= 1.2, filepath -any, mtl >= 2.1.0 && < 2.3.0, parsec -any,+                   transformers >= 0.3 && < 0.5, utf8-string -any,                    pattern-arrows >= 0.0.2 && < 0.1,                    monad-unify >= 0.2.2 && < 0.3,                    xdg-basedir -any, time -any

@@ -250,7 +250,7 @@ addDefaultImport :: ModuleName -> Module -> Module addDefaultImport toImport m@(Module mn decls exps)  =   if isExistingImport `any` decls || mn == toImport then m-  else Module mn (ImportDeclaration toImport Nothing Nothing : decls) exps+  else Module mn (ImportDeclaration toImport Unqualified Nothing : decls) exps   where   isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True   isExistingImport (PositionedDeclaration _ d) = isExistingImport d

@@ -56,7 +56,7 @@   let jsImports = map (importToJs mt opts) . delete (ModuleName [ProperName C.prim]) . (\\ [name]) . nub $ concatMap imports decls   jsDecls <- mapM (\decl -> declToJs opts name decl env) decls   let optimized = concat $ map (map $ optimize opts) $ catMaybes jsDecls-  let isModuleEmpty = null optimized+  let isModuleEmpty = null exps   let moduleBody = JSStringLiteral "use strict" : jsImports ++ optimized   let moduleExports = JSObjectLiteral $ concatMap exportToJs exps   return $ case mt of@@ -83,7 +83,7 @@   let (f, _, _, _, _) = everythingOnValues (++) (const []) collectV collectB (const []) (const [])   in f other   where-  collectV :: Value -> [ModuleName]+  collectV :: Expr -> [ModuleName]   collectV (Var (Qualified (Just mn) _)) = [mn]   collectV (Constructor (Qualified (Just mn) _)) = [mn]   collectV (TypeClassDictionaryConstructorApp (Qualified (Just mn) _) _) = [mn]@@ -190,7 +190,7 @@ -- | -- Generate code in the simplified Javascript intermediate representation for a value or expression. ---valueToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Environment -> Value -> SupplyT m JS+valueToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Environment -> Expr -> SupplyT m JS valueToJs _ _ _ (NumericLiteral n) = return $ JSNumericLiteral n valueToJs _ _ _ (StringLiteral s) = return $ JSStringLiteral s valueToJs _ _ _ (BooleanLiteral b) = return $ JSBooleanLiteral b@@ -221,7 +221,7 @@       return $ JSUnary JSNew $ JSApp (qualifiedToJS m (Ident . runProperName) name) args'     _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs opts m e f   where-  unApp :: Value -> [Value] -> (Value, [Value])+  unApp :: Expr -> [Expr] -> (Expr, [Expr])   unApp (App val arg) args = unApp val (arg : args)   unApp (PositionedValue _ val) args = unApp val args   unApp (TypedValue _ val _) args = unApp val args@@ -317,11 +317,12 @@ bindersToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Environment -> [CaseAlternative] -> [JS] -> SupplyT m JS bindersToJs opts m e binders vals = do   valNames <- replicateM (length vals) freshName+  let assignments = zipWith JSVariableIntroduction valNames (map Just vals)   jss <- forM binders $ \(CaseAlternative bs grd result) -> do     ret <- valueToJs opts m e result     go valNames [JSReturn ret] bs grd-  return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") $ [(JSStringLiteral "Failed pattern match")]])))-                 vals+  return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") $ [JSStringLiteral "Failed pattern match"]])))+                 []   where     go :: (Functor m, Applicative m, Monad m) => [String] -> [JS] -> [Binder] -> Maybe Guard -> SupplyT m [JS]     go _ done [] Nothing = return done

@@ -201,6 +201,9 @@ __superclass_ :: String __superclass_ = "__superclass_" +__unused :: String+__unused = "__unused"+ -- Modules  prim :: String

@@ -79,7 +79,7 @@   let (f, _, _, _, _) = everythingOnValues (++) (const []) values (const []) (const []) (const [])   in nub . f   where-  values :: Value -> [Key]+  values :: Expr -> [Key]   values (Var ident) = let (mn, name) = qualify moduleName ident in [(mn, Left name)]   values (Constructor (Qualified (Just mn) name)) = [(mn, Right name)]   values (Constructor (Qualified Nothing _)) = error "Found unqualified data constructor"

@@ -114,6 +114,24 @@   _ == _ = False  -- |+-- The data type which specifies type of import declaration+--+data ImportDeclarationType+  -- |+  -- Unqualified import+  --+  = Unqualified+  -- |+  -- Qualified import with a list of references to import+  --+  | Qualifying [DeclarationRef]+  -- |+  -- Import with hiding clause with a list of references to hide+  --+  | Hiding [DeclarationRef]+  deriving (Show, D.Data, D.Typeable)++-- | -- The data type of declarations -- data Declaration@@ -136,11 +154,11 @@   -- |   -- A value declaration (name, top-level binders, optional guard, value)   ---  | ValueDeclaration Ident NameKind [Binder] (Maybe Guard) Value+  | ValueDeclaration Ident NameKind [Binder] (Maybe Guard) Expr   -- |   -- A minimal mutually recursive set of value declarations   ---  | BindingGroupDeclaration [(Ident, NameKind, Value)]+  | BindingGroupDeclaration [(Ident, NameKind, Expr)]   -- |   -- A foreign import declaration (type, name, optional inline Javascript, type)   --@@ -158,10 +176,10 @@   --   | FixityDeclaration Fixity String   -- |-  -- A module import (module name, optional set of identifiers to import, optional "qualified as"-  -- name)+  -- A module import (module name, optional set of identifiers to import,+  -- optional set of identifiers to hide, optional "qualified as" name)   ---  | ImportDeclaration ModuleName (Maybe [DeclarationRef]) (Maybe ModuleName)+  | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)   -- |   -- A type class declaration (name, argument, implies, member declarations)   --@@ -246,12 +264,12 @@ -- | -- A guard is just a boolean-valued expression that appears alongside a set of binders ---type Guard = Value+type Guard = Expr  -- |--- Data type for values+-- Data type for expressions and terms ---data Value+data Expr   -- |   -- A numeric literal   --@@ -267,41 +285,41 @@   -- |   -- A prefix -, will be desugared   ---  | UnaryMinus Value+  | UnaryMinus Expr   -- |   -- Binary operator application. During the rebracketing phase of desugaring, this data constructor   -- will be removed.   ---  | BinaryNoParens (Qualified Ident) Value Value+  | BinaryNoParens (Qualified Ident) Expr Expr   -- |   -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor   -- will be removed.   ---  | Parens Value+  | Parens Expr   -- |   -- An array literal   ---  | ArrayLiteral [Value]+  | ArrayLiteral [Expr]   -- |   -- An object literal   ---  | ObjectLiteral [(String, Value)]+  | ObjectLiteral [(String, Expr)]   -- |   -- An record property accessor expression   ---  | Accessor String Value+  | Accessor String Expr   -- |   -- Partial record update   ---  | ObjectUpdate Value [(String, Value)]+  | ObjectUpdate Expr [(String, Expr)]   -- |   -- Function introduction   ---  | Abs (Either Ident Binder) Value+  | Abs (Either Ident Binder) Expr   -- |   -- Function application   ---  | App Value Value+  | App Expr Expr   -- |   -- Variable   --@@ -309,7 +327,7 @@   -- |   -- Conditional (if-then-else expression)   ---  | IfThenElse Value Value Value+  | IfThenElse Expr Expr Expr   -- |   -- A data constructor   --@@ -318,15 +336,15 @@   -- A case expression. During the case expansion phase of desugaring, top-level binders will get   -- desugared into case expressions, hence the need for guards and multiple binders per branch here.   ---  | Case [Value] [CaseAlternative]+  | Case [Expr] [CaseAlternative]   -- |   -- A value with a type annotation   ---  | TypedValue Bool Value Type+  | TypedValue Bool Expr Type   -- |   -- A let binding   ---  | Let [Declaration] Value+  | Let [Declaration] Expr   -- |   -- A do-notation block   --@@ -335,7 +353,7 @@   -- An application of a typeclass dictionary constructor. The value should be   -- an ObjectLiteral.   ---  | TypeClassDictionaryConstructorApp (Qualified ProperName) Value+  | TypeClassDictionaryConstructorApp (Qualified ProperName) Expr   -- |   -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these   -- placeholders will be replaced with actual expressions representing type classes dictionaries which@@ -351,7 +369,7 @@   -- |   -- A value with source position information   ---  | PositionedValue SourcePos Value deriving (Show, D.Data, D.Typeable)+  | PositionedValue SourcePos Expr deriving (Show, D.Data, D.Typeable)  -- | -- An alternative in a case statement@@ -368,7 +386,7 @@     -- |     -- The result expression     ---  , caseAlternativeResult :: Value+  , caseAlternativeResult :: Expr   } deriving (Show, D.Data, D.Typeable)  -- |@@ -385,11 +403,11 @@   -- |   -- A monadic value without a binder   ---  = DoNotationValue Value+  = DoNotationValue Expr   -- |   -- A monadic value with a binder   ---  | DoNotationBind Binder Value+  | DoNotationBind Binder Expr   -- |   -- A let statement, i.e. a pure value with a binder   --@@ -468,9 +486,9 @@ --  everywhereOnValues :: (Declaration -> Declaration) ->-                      (Value -> Value) ->+                      (Expr -> Expr) ->                       (Binder -> Binder) ->-                      (Declaration -> Declaration, Value -> Value, Binder -> Binder)+                      (Declaration -> Declaration, Expr -> Expr, Binder -> Binder) everywhereOnValues f g h = (f', g', h')   where   f' :: Declaration -> Declaration@@ -482,7 +500,7 @@   f' (PositionedDeclaration pos d) = f (PositionedDeclaration pos (f' d))   f' other = f other -  g' :: Value -> Value+  g' :: Expr -> Expr   g' (UnaryMinus v) = g (UnaryMinus (g' v))   g' (BinaryNoParens op v1 v2) = g (BinaryNoParens op (g' v1) (g' v2))   g' (Parens v) = g (Parens (g' v))@@ -526,9 +544,9 @@  everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>   (Declaration -> m Declaration) ->-  (Value -> m Value) ->+  (Expr -> m Expr) ->   (Binder -> m Binder) ->-  (Declaration -> m Declaration, Value -> m Value, Binder -> m Binder)+  (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder) everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)   where   f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f' <=< f) ds@@ -576,9 +594,9 @@  everywhereOnValuesM :: (Functor m, Applicative m, Monad m) =>   (Declaration -> m Declaration) ->-  (Value -> m Value) ->+  (Expr -> m Expr) ->   (Binder -> m Binder) ->-  (Declaration -> m Declaration, Value -> m Value, Binder -> m Binder)+  (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder) everywhereOnValuesM f g h = (f' <=< f, g' <=< g, h' <=< h)   where   f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> mapM f' ds) >>= f@@ -626,11 +644,11 @@  everythingOnValues :: (r -> r -> r) ->                       (Declaration -> r) ->-                      (Value -> r) ->+                      (Expr -> r) ->                       (Binder -> r) ->                       (CaseAlternative -> r) ->                       (DoNotationElement -> r) ->-                      (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)+                      (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r) everythingOnValues (<>) f g h i j = (f', g', h', i', j')   where   f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (map f' ds)@@ -682,12 +700,12 @@   r ->   (r -> r -> r) ->   (s -> Declaration       -> (s, r)) ->-  (s -> Value             -> (s, r)) ->+  (s -> Expr             -> (s, r)) ->   (s -> Binder            -> (s, r)) ->   (s -> CaseAlternative   -> (s, r)) ->   (s -> DoNotationElement -> (s, r)) ->   ( Declaration       -> r-  , Value             -> r+  , Expr             -> r   , Binder            -> r   , CaseAlternative   -> r   , DoNotationElement -> r)@@ -749,12 +767,12 @@ everywhereWithContextOnValuesM :: (Functor m, Applicative m, Monad m) =>   s ->   (s -> Declaration       -> m (s, Declaration)) ->-  (s -> Value             -> m (s, Value)) ->+  (s -> Expr             -> m (s, Expr)) ->   (s -> Binder            -> m (s, Binder)) ->   (s -> CaseAlternative   -> m (s, CaseAlternative)) ->   (s -> DoNotationElement -> m (s, DoNotationElement)) ->   ( Declaration       -> m Declaration-  , Value             -> m Value+  , Expr             -> m Expr   , Binder            -> m Binder   , CaseAlternative   -> m CaseAlternative   , DoNotationElement -> m DoNotationElement)@@ -811,7 +829,7 @@   j' s (DoNotationLet ds) = DoNotationLet <$> mapM (f'' s) ds   j' s (PositionedDoNotationElement pos e1) = PositionedDoNotationElement pos <$> j'' s e1 -accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Value -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)+accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r) accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)   where   forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)

@@ -30,9 +30,9 @@ -- data ErrorSource   -- |-  -- An error which originated at a Value+  -- An error which originated at a Expr   ---  = ValueError Value+  = ExprError Expr   -- |   -- An error which originated at a Type   --@@ -89,7 +89,7 @@  showError :: CompileError -> String showError (CompileError msg Nothing _) = msg-showError (CompileError msg (Just (ValueError val)) _) = "Error in value " ++ prettyPrintValue val ++ ":\n" ++ msg+showError (CompileError msg (Just (ExprError val)) _) = "Error in expression " ++ prettyPrintValue val ++ ":\n" ++ msg showError (CompileError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ ":\n" ++ msg  mkErrorStack :: String -> Maybe ErrorSource -> ErrorStack

@@ -52,7 +52,7 @@   forDecls (ImportDeclaration mn _ _) = [mn]   forDecls _ = [] -  forValues :: Value -> [ModuleName]+  forValues :: Expr -> [ModuleName]   forValues (Var (Qualified (Just mn) _)) = [mn]   forValues (BinaryNoParens (Qualified (Just mn) _) _ _) = [mn]   forValues (Constructor (Qualified (Just mn) _)) = [mn]

@@ -49,8 +49,8 @@       not (any (`isRebound` block) (map JSVar idents)) &&       not (any (`isRebound` block) args)       = JSBlock (map (replaceIdents (zip idents args)) body)-  convert (JSFunction Nothing ["_"] (JSBlock [JSReturn (JSApp fn@JSVar{} [JSObjectLiteral []])]))-      = fn+  convert (JSFunction Nothing [arg] (JSBlock [JSReturn (JSApp fn@JSVar{} [JSObjectLiteral []])]))+    | arg == C.__unused = fn   convert js = js  unThunk :: JS -> JS

@@ -60,7 +60,7 @@   -- Desugar pure   convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val   -- Desugar >>-  convert (JSApp (JSApp bind [m]) [JSFunction Nothing ["_"] (JSBlock js)]) | isBind bind && isJSReturn (last js) =+  convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind && isJSReturn (last js) && arg == C.__unused =     let JSReturn ret = last js in     JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : init js ++ [JSReturn (JSApp ret [])] )   -- Desugar >>=

@@ -123,17 +123,28 @@   where   stdImport = do     moduleName' <- moduleName-    idents <- P.optionMaybe $ indented *> (parens $ commaSep parseDeclarationRef)-    return $ ImportDeclaration moduleName' idents Nothing+    stdImportHiding moduleName' <|> stdImportQualifying moduleName'+    where+    stdImportHiding mn = do+      reserved "hiding"+      declType <- importDeclarationType Hiding+      return $ ImportDeclaration mn declType Nothing+    stdImportQualifying mn = do+      declType <- importDeclarationType Qualifying+      return $ ImportDeclaration mn declType Nothing   qualImport = do     reserved "qualified"     indented     moduleName' <- moduleName-    idents <- P.optionMaybe $ indented *> (parens $ commaSep parseDeclarationRef)+    declType <- importDeclarationType Qualifying     reserved "as"     asQ <- moduleName-    return $ ImportDeclaration moduleName' idents (Just asQ)+    return $ ImportDeclaration moduleName' declType (Just asQ)+  importDeclarationType expectedType = do+    idents <- P.optionMaybe $ indented *> (parens $ commaSep parseDeclarationRef)+    return $ fromMaybe Unqualified (expectedType <$> idents) + parseDeclarationRef :: P.Parsec String ParseState DeclarationRef parseDeclarationRef = PositionedDeclarationRef <$> sourcePos <*>   (ValueRef <$> parseIdent@@ -219,26 +230,26 @@ booleanLiteral :: P.Parsec String ParseState Bool booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False) -parseNumericLiteral :: P.Parsec String ParseState Value+parseNumericLiteral :: P.Parsec String ParseState Expr parseNumericLiteral = NumericLiteral <$> C.integerOrFloat -parseStringLiteral :: P.Parsec String ParseState Value+parseStringLiteral :: P.Parsec String ParseState Expr parseStringLiteral = StringLiteral <$> C.stringLiteral -parseBooleanLiteral :: P.Parsec String ParseState Value+parseBooleanLiteral :: P.Parsec String ParseState Expr parseBooleanLiteral = BooleanLiteral <$> booleanLiteral -parseArrayLiteral :: P.Parsec String ParseState Value+parseArrayLiteral :: P.Parsec String ParseState Expr parseArrayLiteral = ArrayLiteral <$> C.squares (C.commaSep parseValue) -parseObjectLiteral :: P.Parsec String ParseState Value+parseObjectLiteral :: P.Parsec String ParseState Expr parseObjectLiteral = ObjectLiteral <$> C.braces (C.commaSep parseIdentifierAndValue) -parseIdentifierAndValue :: P.Parsec String ParseState (String, Value)+parseIdentifierAndValue :: P.Parsec String ParseState (String, Expr) parseIdentifierAndValue = (,) <$> (C.indented *> (C.identifier <|> C.stringLiteral) <* C.indented <* C.colon)                               <*> (C.indented *> parseValue) -parseAbs :: P.Parsec String ParseState Value+parseAbs :: P.Parsec String ParseState Expr parseAbs = do   C.reservedOp "\\"   args <- P.many1 (C.indented *> (Abs <$> (Left <$> P.try C.parseIdent <|> Right <$> parseBinderNoParens)))@@ -246,16 +257,16 @@   value <- parseValue   return $ toFunction args value   where-  toFunction :: [Value -> Value] -> Value -> Value+  toFunction :: [Expr -> Expr] -> Expr -> Expr   toFunction args value = foldr ($) value args -parseVar :: P.Parsec String ParseState Value+parseVar :: P.Parsec String ParseState Expr parseVar = Var <$> C.parseQualified C.parseIdent -parseConstructor :: P.Parsec String ParseState Value+parseConstructor :: P.Parsec String ParseState Expr parseConstructor = Constructor <$> C.parseQualified C.properName -parseCase :: P.Parsec String ParseState Value+parseCase :: P.Parsec String ParseState Expr parseCase = Case <$> P.between (P.try (C.reserved "case")) (C.indented *> C.reserved "of") (return <$> parseValue)                  <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative))) @@ -265,12 +276,12 @@                                        <*> (C.indented *> C.reservedOp "->" *> parseValue)                                        P.<?> "case alternative" -parseIfThenElse :: P.Parsec String ParseState Value+parseIfThenElse :: P.Parsec String ParseState Expr parseIfThenElse = IfThenElse <$> (P.try (C.reserved "if") *> C.indented *> parseValue)                              <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue)                              <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue) -parseLet :: P.Parsec String ParseState Value+parseLet :: P.Parsec String ParseState Expr parseLet = do   C.reserved "let"   C.indented@@ -280,7 +291,7 @@   result <- parseValue   return $ Let ds result -parseValueAtom :: P.Parsec String ParseState Value+parseValueAtom :: P.Parsec String ParseState Expr parseValueAtom = P.choice             [ P.try parseNumericLiteral             , P.try parseStringLiteral@@ -296,18 +307,18 @@             , parseLet             , Parens <$> C.parens parseValue ] -parsePropertyUpdate :: P.Parsec String ParseState (String, Value)+parsePropertyUpdate :: P.Parsec String ParseState (String, Expr) parsePropertyUpdate = do   name <- C.lexeme (C.identifier <|> C.stringLiteral)   _ <- C.lexeme $ C.indented *> P.char '='   value <- C.indented *> parseValue   return (name, value) -parseAccessor :: Value -> P.Parsec String ParseState Value+parseAccessor :: Expr -> P.Parsec String ParseState Expr parseAccessor (Constructor _) = P.unexpected "constructor" parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> (C.identifier <|> C.stringLiteral)) <*> pure obj -parseDo :: P.Parsec String ParseState Value+parseDo :: P.Parsec String ParseState Expr parseDo = do   C.reserved "do"   C.indented@@ -328,7 +339,7 @@ -- | -- Parse a value ---parseValue :: P.Parsec String ParseState Value+parseValue :: P.Parsec String ParseState Expr parseValue = PositionedValue <$> sourcePos <*>   (P.buildExpressionParser operators    . C.buildPostfixParser postfixTable2

@@ -30,10 +30,10 @@ import Language.PureScript.Pretty.Common import Language.PureScript.Pretty.Types (prettyPrintType) -literals :: Pattern PrinterState Value String+literals :: Pattern PrinterState Expr String literals = mkPattern' match   where-  match :: Value -> StateT PrinterState Maybe String+  match :: Expr -> StateT PrinterState Maybe String   match (NumericLiteral n) = return $ either show show n   match (StringLiteral s) = return $ show s   match (BooleanLiteral True) = return "true"@@ -118,31 +118,31 @@     ] prettyPrintDoNotationElement (PositionedDoNotationElement _ el) = prettyPrintDoNotationElement el -ifThenElse :: Pattern PrinterState Value ((Value, Value), Value)+ifThenElse :: Pattern PrinterState Expr ((Expr, Expr), Expr) ifThenElse = mkPattern match   where   match (IfThenElse cond th el) = Just ((th, el), cond)   match _ = Nothing -accessor :: Pattern PrinterState Value (String, Value)+accessor :: Pattern PrinterState Expr (String, Expr) accessor = mkPattern match   where   match (Accessor prop val) = Just (prop, val)   match _ = Nothing -objectUpdate :: Pattern PrinterState Value ([String], Value)+objectUpdate :: Pattern PrinterState Expr ([String], Expr) objectUpdate = mkPattern match   where   match (ObjectUpdate o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ prettyPrintValue val, o)   match _ = Nothing -app :: Pattern PrinterState Value (String, Value)+app :: Pattern PrinterState Expr (String, Expr) app = mkPattern match   where   match (App val arg) = Just (prettyPrintValue arg, val)   match _ = Nothing -lam :: Pattern PrinterState Value (String, Value)+lam :: Pattern PrinterState Expr (String, Expr) lam = mkPattern match   where   match (Abs (Left arg) val) = Just (show arg, val)@@ -151,15 +151,15 @@ -- | -- Generate a pretty-printed string representing an expression ---prettyPrintValue :: Value -> String+prettyPrintValue :: Expr -> String prettyPrintValue = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyPrintValue' -prettyPrintValue' :: Value -> StateT PrinterState Maybe String+prettyPrintValue' :: Expr -> StateT PrinterState Maybe String prettyPrintValue' = runKleisli $ runPattern matchValue   where-  matchValue :: Pattern PrinterState Value String+  matchValue :: Pattern PrinterState Expr String   matchValue = buildPrettyPrinter operators (literals <+> fmap parens matchValue)-  operators :: OperatorTable PrinterState Value String+  operators :: OperatorTable PrinterState Expr String   operators =     OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]                   , [ Wrap objectUpdate $ \ps val -> val ++ "{ " ++ intercalate ", " ps ++ " }" ]@@ -224,7 +224,7 @@     , prettyPrintBinder' binder     ] -prettyPrintObjectProperty :: (String, Value) -> StateT PrinterState Maybe String+prettyPrintObjectProperty :: (String, Expr) -> StateT PrinterState Maybe String prettyPrintObjectProperty (key, value) = fmap concat $ sequence     [ return $ prettyPrintObjectKey key ++ ": "     , prettyPrintValue' value

@@ -28,6 +28,8 @@ import Language.PureScript.Names import Language.PureScript.Traversals +import qualified Language.PureScript.Constants as C+ -- | -- The state object used in this module --@@ -69,6 +71,7 @@ -- unique name is generated and stored. -- updateScope :: Ident -> Rename Ident+updateScope i@(Ident name) | name == C.__unused = return i updateScope name = do   scope <- get   let name' = case name `S.member` rsUsedNames scope of@@ -87,6 +90,7 @@ -- Finds the new name to use for an ident. -- lookupIdent :: Ident -> Rename Ident+lookupIdent i@(Ident name) | name == C.__unused = return i lookupIdent name = do   name' <- gets $ M.lookup name . rsBoundNames   case name' of@@ -132,11 +136,11 @@   ds' <- mapM updateNames ds   BindingGroupDeclaration <$> mapM updateValues ds'   where-  updateNames :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)+  updateNames :: (Ident, NameKind, Expr) -> Rename (Ident, NameKind, Expr)   updateNames (name, nameKind, val) = do     name' <- if isTopLevel then return name else updateScope name     return (name', nameKind, val)-  updateValues :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)+  updateValues :: (Ident, NameKind, Expr) -> Rename (Ident, NameKind, Expr)   updateValues (name, nameKind, val) =     (,,) name nameKind <$> renameInValue val renameInDecl _ (TypeInstanceDeclaration name cs className args ds) =@@ -148,7 +152,7 @@ -- | -- Renames within a value. ---renameInValue :: Value -> Rename Value+renameInValue :: Expr -> Rename Expr renameInValue (UnaryMinus v) =   UnaryMinus <$> renameInValue v renameInValue (ArrayLiteral vs) =

@@ -85,7 +85,7 @@   go (PositionedDeclaration pos d) = map (PositionedDeclaration pos) $ go d   go other = [other] -collapseBindingGroupsForValue :: Value -> Value+collapseBindingGroupsForValue :: Expr -> Expr collapseBindingGroupsForValue (Let ds val) = Let (collapseBindingGroups ds) val collapseBindingGroupsForValue other = other @@ -94,7 +94,7 @@   let (f, _, _, _, _) = everythingOnValues (++) (const []) usedNames (const []) (const []) (const [])   in nub . f   where-  usedNames :: Value -> [Ident]+  usedNames :: Expr -> [Ident]   usedNames (Var (Qualified Nothing name)) = [name]   usedNames (Var (Qualified (Just moduleName') name)) | moduleName == moduleName' = [name]   usedNames _ = []@@ -142,7 +142,7 @@ isTypeSynonym (PositionedDeclaration _ d) = isTypeSynonym d isTypeSynonym _ = Nothing -fromValueDecl :: Declaration -> (Ident, NameKind, Value)+fromValueDecl :: Declaration -> (Ident, NameKind, Expr) fromValueDecl (ValueDeclaration ident nameKind [] Nothing val) = (ident, nameKind, val) fromValueDecl ValueDeclaration{} = error "Binders should have been desugared" fromValueDecl (PositionedDeclaration _ d) = fromValueDecl d

@@ -45,7 +45,7 @@   where   (f, _, _) = everywhereOnValuesM return replace return -  replace :: Value -> SupplyT (Either ErrorStack) Value+  replace :: Expr -> SupplyT (Either ErrorStack) Expr   replace (Abs (Right binder) val) = do     ident <- Ident <$> freshName     return $ Abs (Left ident) $ Case [Var (Qualified Nothing ident)] [CaseAlternative [binder] Nothing val]@@ -98,12 +98,12 @@ isVarBinder (VarBinder _) = True isVarBinder _ = False -toTuple :: Declaration -> ([Binder], (Maybe Guard, Value))+toTuple :: Declaration -> ([Binder], (Maybe Guard, Expr)) toTuple (ValueDeclaration _ _ bs g val) = (bs, (g, val)) toTuple (PositionedDeclaration _ d) = toTuple d toTuple _ = error "Not a value declaration" -makeCaseDeclaration :: Ident -> [([Binder], (Maybe Guard, Value))] -> SupplyT (Either ErrorStack) Declaration+makeCaseDeclaration :: Ident -> [([Binder], (Maybe Guard, Expr))] -> SupplyT (Either ErrorStack) Declaration makeCaseDeclaration ident alternatives = do   let argPattern = length . fst . head $ alternatives   args <- map Ident <$> replicateM argPattern freshName

@@ -44,20 +44,20 @@   prelude :: ModuleName   prelude = ModuleName [ProperName C.prelude] -  bind :: Value+  bind :: Expr   bind = Var (Qualified (Just prelude) (Op (C.>>=))) -  replace :: Value -> SupplyT (Either ErrorStack) Value+  replace :: Expr -> SupplyT (Either ErrorStack) Expr   replace (Do els) = go els   replace (PositionedValue pos v) = PositionedValue pos <$> rethrowWithPosition pos (replace v)   replace other = return other -  go :: [DoNotationElement] -> SupplyT (Either ErrorStack) Value+  go :: [DoNotationElement] -> SupplyT (Either ErrorStack) Expr   go [] = error "The impossible happened in desugarDo"   go [DoNotationValue val] = return val   go (DoNotationValue val : rest) = do     rest' <- go rest-    return $ App (App bind val) (Abs (Left (Ident "_")) rest')+    return $ App (App bind val) (Abs (Left (Ident C.__unused)) rest')   go [DoNotationBind _ _] = lift $ Left $ mkErrorStack "Bind statement cannot be the last statement in a do block" Nothing   go (DoNotationBind NullBinder val : rest) = go (DoNotationValue val : rest)   go (DoNotationBind (VarBinder ident) val : rest) = do

@@ -198,7 +198,7 @@     (,) (pos, name : bound) <$> (ExternDeclaration fit name js <$> updateTypesEverywhere pos ty)   updateDecl s d = return (s, d) -  updateValue :: (Maybe SourcePos, [Ident]) -> Value -> Either ErrorStack ((Maybe SourcePos, [Ident]), Value)+  updateValue :: (Maybe SourcePos, [Ident]) -> Expr -> Either ErrorStack ((Maybe SourcePos, [Ident]), Expr)   updateValue (_, bound) v@(PositionedValue pos' _) = return ((Just pos', bound), v)   updateValue (pos, bound) (Abs (Left arg) val') = return ((pos, arg : bound), Abs (Left arg) val')   updateValue (pos, bound) (Let ds val') =@@ -253,15 +253,19 @@                             -> Qualified a                             -> Maybe SourcePos                             -> Either ErrorStack (Qualified a)-  update t getI checkE qname@(Qualified mn' name) pos = case (M.lookup qname (getI imports), mn') of+  update t getI checkE qname@(Qualified mn' name) pos = positioned $ case (M.lookup qname imports', mn') of     (Just qname', _) -> return qname'     (Nothing, Just mn'') -> do+      when (isExplicitQualModule mn'') $ throwError $ mkErrorStack ("Unknown " ++ t ++ " '" ++ show qname ++ "'") Nothing       modExports <- getExports mn''       if checkE modExports name         then return qname-        else positioned $ throwError $ mkErrorStack ("Unknown " ++ t ++ " '" ++ show qname ++ "'") Nothing-    _ -> positioned $ throwError $ mkErrorStack ("Unknown " ++ t ++ " '" ++ show name ++ "'") Nothing+        else throwError $ mkErrorStack ("Unknown " ++ t ++ " '" ++ show qname ++ "'") Nothing+    _ -> throwError $ mkErrorStack ("Unknown " ++ t ++ " '" ++ show name ++ "'") Nothing     where+    isExplicitQualModule :: ModuleName -> Bool+    isExplicitQualModule = flip elem $ mapMaybe (\(Qualified q _) -> q) (M.keys imports')+    imports' = getI imports     positioned err = case pos of       Nothing -> err       Just pos' -> rethrowWithPosition pos' err@@ -360,18 +364,13 @@   filterValues _ result _ = return result  -- |--- Type representing a set of declarations being explicitly imported from a module----type ExplicitImports = [DeclarationRef]---- | -- Finds the imports within a module, mapping the imported module name to an optional set of -- explicitly imported declarations. ---findImports :: [Declaration] -> M.Map ModuleName (Maybe SourcePos, Maybe ExplicitImports, Maybe ModuleName)+findImports :: [Declaration] -> M.Map ModuleName (Maybe SourcePos, ImportDeclarationType, Maybe ModuleName) findImports = foldl (findImports' Nothing) M.empty   where-  findImports' pos result (ImportDeclaration mn expl qual) = M.insert mn (pos, expl, qual) result+  findImports' pos result (ImportDeclaration mn typ qual) = M.insert mn (pos, typ, qual) result   findImports' _ result (PositionedDeclaration pos d) = findImports' (Just pos) result d   findImports' _ result _ = result @@ -386,13 +385,13 @@   -- A Map from module name to the source position for the import, the list of imports from that   -- module (where Nothing indicates everything is to be imported), and optionally a qualified name   -- for the module-  scope :: M.Map ModuleName (Maybe SourcePos, Maybe ExplicitImports, Maybe ModuleName)-  scope = M.insert currentModule (Nothing, Nothing, Nothing) (findImports decls)+  scope :: M.Map ModuleName (Maybe SourcePos, ImportDeclarationType, Maybe ModuleName)+  scope = M.insert currentModule (Nothing, Unqualified, Nothing) (findImports decls) -  resolveImport' :: ImportEnvironment -> (ModuleName, (Maybe SourcePos, Maybe ExplicitImports, Maybe ModuleName)) -> Either ErrorStack ImportEnvironment-  resolveImport' imp (mn, (pos, explImports, impQual)) = do+  resolveImport' :: ImportEnvironment -> (ModuleName, (Maybe SourcePos, ImportDeclarationType, Maybe ModuleName)) -> Either ErrorStack ImportEnvironment+  resolveImport' imp (mn, (pos, typ, impQual)) = do     modExports <- positioned $ maybe (throwError $ mkErrorStack ("Cannot import unknown module '" ++ show mn ++ "'") Nothing) return $ mn `M.lookup` env-    positioned $ resolveImport currentModule mn modExports imp impQual explImports+    positioned $ resolveImport currentModule mn modExports imp impQual typ     where     positioned err = case pos of       Nothing -> err@@ -401,37 +400,77 @@ -- | -- Extends the local environment for a module by resolving an import of another module. ---resolveImport :: ModuleName -> ModuleName -> Exports -> ImportEnvironment -> Maybe ModuleName -> Maybe ExplicitImports-> Either ErrorStack ImportEnvironment-resolveImport currentModule importModule exps imps impQual = maybe importAll (foldM importExplicit imps)+resolveImport :: ModuleName -> ModuleName -> Exports -> ImportEnvironment -> Maybe ModuleName -> ImportDeclarationType -> Either ErrorStack ImportEnvironment+resolveImport currentModule importModule exps imps impQual =+  resolveByType   where -  -- Import everything from a module-  importAll :: Either ErrorStack ImportEnvironment-  importAll = do-    imp' <- foldM (\m (name, dctors) -> importExplicit m (TypeRef name (Just dctors))) imps (exportedTypes exps)-    imp'' <- foldM (\m name -> importExplicit m (ValueRef name)) imp' (exportedValues exps)-    foldM (\m name -> importExplicit m (TypeClassRef name)) imp'' (exportedTypeClasses exps)+  resolveByType :: ImportDeclarationType -> Either ErrorStack ImportEnvironment+  resolveByType Unqualified = importAll importExplicit+  resolveByType (Qualifying explImports) = (checkedRefs >=> foldM importExplicit imps) explImports+  resolveByType (Hiding hiddenImports) = do+    hiddenImports' <- checkedRefs hiddenImports+    importAll (importNonHidden hiddenImports') +  importNonHidden :: [DeclarationRef] -> ImportEnvironment -> DeclarationRef -> Either ErrorStack ImportEnvironment+  importNonHidden hidden m ref =+    if isHidden hidden ref+    then return m+    else importExplicit m ref++  isHidden :: [DeclarationRef] -> DeclarationRef -> Bool+  isHidden hidden ref@(TypeRef _ _) =+    let+      checkTypeRef _ True _ = True+      checkTypeRef (TypeRef _ Nothing) acc (TypeRef _ (Just _)) = acc+      checkTypeRef (TypeRef name (Just dctor)) _ (TypeRef name' (Just dctor')) = name == name' && dctor == dctor'+      checkTypeRef (TypeRef name _) _ (TypeRef name' Nothing) = name == name'+      checkTypeRef (PositionedDeclarationRef _ r) acc hiddenRef = checkTypeRef r acc hiddenRef+      checkTypeRef _ acc _ = acc+    in foldl (checkTypeRef ref) False hidden+  isHidden hidden ref = ref `elem` hidden++  -- Import all symbols+  importAll :: (ImportEnvironment -> DeclarationRef -> Either ErrorStack ImportEnvironment) -> Either ErrorStack ImportEnvironment+  importAll importer = do+    imp' <- foldM (\m (name, dctors) -> importer m (TypeRef name (Just dctors))) imps (exportedTypes exps)+    imp'' <- foldM (\m name -> importer m (ValueRef name)) imp' (exportedValues exps)+    foldM (\m name -> importer m (TypeClassRef name)) imp'' (exportedTypeClasses exps)+   -- Import something explicitly   importExplicit :: ImportEnvironment -> DeclarationRef -> Either ErrorStack ImportEnvironment   importExplicit imp (PositionedDeclarationRef pos r) = rethrowWithPosition pos $ importExplicit imp r   importExplicit imp (ValueRef name) = do-    _ <- checkImportExists "value" values name     values' <- updateImports (importedValues imp) name     return $ imp { importedValues = values' }   importExplicit imp (TypeRef name dctors) = do-    _ <- checkImportExists "type" availableTypes name     types' <- updateImports (importedTypes imp) name     let allDctors = allExportedDataConstructors name     dctors' <- maybe (return allDctors) (mapM $ checkDctorExists allDctors) dctors     dctors'' <- foldM updateImports (importedDataConstructors imp) dctors'     return $ imp { importedTypes = types', importedDataConstructors = dctors'' }   importExplicit imp (TypeClassRef name) = do-    _ <- checkImportExists "type class" classes name     typeClasses' <- updateImports (importedTypeClasses imp) name     return $ imp { importedTypeClasses = typeClasses' }   importExplicit _ _ = error "Invalid argument to importExplicit" +  -- Check if DeclarationRef points to an existent symbol+  checkedRefs :: [DeclarationRef] -> Either ErrorStack [DeclarationRef]+  checkedRefs = mapM check+    where+    check (PositionedDeclarationRef pos r) =+      rethrowWithPosition pos $ check r+    check ref@(ValueRef name) =+      checkImportExists "value" values name >> return ref+    check ref@(TypeRef name dctors) = do+      _ <- checkImportExists "type" availableTypes name+      let allDctors = allExportedDataConstructors name+      _ <- maybe (return allDctors) (mapM $ checkDctorExists allDctors) dctors+      return ref+    check ref@(TypeClassRef name) =+      checkImportExists "type class" classes name >> return ref+    check _ = error "Invalid argument to checkRefIsValid"+   -- Find all exported data constructors for a given type   allExportedDataConstructors :: ProperName -> [ProperName]   allExportedDataConstructors name = fromMaybe [] $ name `lookup` exportedTypes exps@@ -444,7 +483,7 @@     Just x@(Qualified (Just mn) _) -> throwError $ mkErrorStack err Nothing       where       err = if mn == currentModule || importModule == currentModule-            then "Definition '" ++ show name ++ "' conflicts with import '" ++ show (Qualified (Just importModule) name) ++ "'"+            then "Definition '" ++ show name ++ "' conflicts with import '" ++ show (Qualified (Just mn) name) ++ "'"             else "Conflicting imports for '" ++ show name ++ "': '" ++ show x ++ "', '" ++ show (Qualified (Just importModule) name) ++ "'"    -- The available values, types, and classes in the module being imported@@ -463,5 +502,3 @@       if item `elem` exports       then return item       else throwError $ mkErrorStack ("Cannot import unknown " ++ t ++  " '" ++ show item ++ "' from '" ++ show importModule ++ "'") Nothing--

@@ -63,7 +63,7 @@   go (UnaryMinus val) = App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident C.negate))) val   go other = other -rebracketModule :: [[(Qualified Ident, Value -> Value -> Value, Associativity)]] -> Module -> Either ErrorStack Module+rebracketModule :: [[(Qualified Ident, Expr -> Expr -> Expr, Associativity)]] -> Module -> Either ErrorStack Module rebracketModule opTable (Module mn ds exts) =   let (f, _, _) = everywhereOnValuesTopDownM return (matchOperators opTable) return   in Module mn <$> (map removeParens <$> mapM f ds) <*> pure exts@@ -95,7 +95,7 @@         throwError $ mkErrorStack ("Redefined fixity for " ++ show name) Nothing   go (_ : rest) = go rest -customOperatorTable :: [(Qualified Ident, Fixity)] -> [[(Qualified Ident, Value -> Value -> Value, Associativity)]]+customOperatorTable :: [(Qualified Ident, Fixity)] -> [[(Qualified Ident, Expr -> Expr -> Expr, Associativity)]] customOperatorTable fixities =   let     applyUserOp ident t1 = App (App (Var ident) t1)@@ -105,18 +105,18 @@   in     map (map (\(name, f, _, a) -> (name, f, a))) groups -type Chain = [Either Value (Qualified Ident)]+type Chain = [Either Expr (Qualified Ident)] -matchOperators :: [[(Qualified Ident, Value -> Value -> Value, Associativity)]] -> Value -> Either ErrorStack Value+matchOperators :: [[(Qualified Ident, Expr -> Expr -> Expr, Associativity)]] -> Expr -> Either ErrorStack Expr matchOperators ops = parseChains   where-  parseChains :: Value -> Either ErrorStack Value+  parseChains :: Expr -> Either ErrorStack Expr   parseChains b@BinaryNoParens{} = bracketChain (extendChain b)   parseChains other = return other-  extendChain :: Value -> Chain+  extendChain :: Expr -> Chain   extendChain (BinaryNoParens name l r) = Left l : Right name : extendChain r   extendChain other = [Left other]-  bracketChain :: Chain -> Either ErrorStack Value+  bracketChain :: Chain -> Either ErrorStack Expr   bracketChain = either (Left . (`mkErrorStack` Nothing) . show) Right . P.parse (P.buildExpressionParser opTable parseValue <* P.eof) "operator expression"   opTable = [P.Infix (P.try (parseTicks >>= \ident -> return (\t1 t2 -> App (App (Var ident) t1) t2))) P.AssocLeft]             : map (map (\(name, f, a) -> P.Infix (P.try (matchOp name) >> return f) (toAssoc a))) ops@@ -130,7 +130,7 @@ token :: (P.Stream s Identity t, Show t) => (t -> Maybe a) -> P.Parsec s u a token = P.token show (const (P.initialPos "")) -parseValue :: P.Parsec Chain () Value+parseValue :: P.Parsec Chain () Expr parseValue = token (either Just (const Nothing)) P.<?> "expression"  parseOp :: P.Parsec Chain () (Qualified Ident)

@@ -239,7 +239,7 @@       -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no       -- dependencies, we introduce an unnamed function parameter.       let superclasses =-            [ (fieldName, Abs (Left (Ident "_")) (SuperClassDictionary superclass tyArgs))+            [ (fieldName, Abs (Left (Ident C.__unused)) (SuperClassDictionary superclass tyArgs))             | (index, (superclass, suTyArgs)) <- zip [0..] implies             , let tyArgs = map (replaceAllTypeVars (zip args tys)) suTyArgs             , let fieldName = mkSuperclassDictionaryName superclass index@@ -249,7 +249,7 @@           dictTy = foldl TypeApp (TypeConstructor className) tys           constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)           dict = TypeClassDictionaryConstructorApp className memberNames'-          dict' = if null deps then Abs (Left (Ident "_")) dict else dict+          dict' = if null deps then Abs (Left (Ident C.__unused)) dict else dict           result = ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict' constrainedTy)       return result @@ -261,7 +261,7 @@   declName (TypeDeclaration ident _) = Just ident   declName _ = Nothing -  memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Value)+  memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Expr)   memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do     _ <- lift . lift . maybe (Left $ mkErrorStack ("Type class does not define member '" ++ show ident ++ "'") Nothing) Right $ lookup ident tys'     let memberValue = typeInstanceDictionaryEntryValue d@@ -271,7 +271,7 @@     return (ident, PositionedValue pos val)   memberToNameAndValue _ _ = error "Invalid declaration in type instance definition" -  typeInstanceDictionaryEntryValue :: Declaration -> Value+  typeInstanceDictionaryEntryValue :: Declaration -> Expr   typeInstanceDictionaryEntryValue (ValueDeclaration _ _ [] _ val) = val   typeInstanceDictionaryEntryValue (PositionedDeclaration pos d) = PositionedValue pos (typeInstanceDictionaryEntryValue d)   typeInstanceDictionaryEntryValue _ = error "Invalid declaration in type instance definition"

@@ -49,7 +49,7 @@   (_, nameKind, val) <- fromValueDeclaration d   desugarTypeDeclarations (ValueDeclaration name nameKind [] Nothing (TypedValue True val ty) : rest)   where-  fromValueDeclaration :: Declaration -> Either ErrorStack (Ident, NameKind, Value)+  fromValueDeclaration :: Declaration -> Either ErrorStack (Ident, NameKind, Expr)   fromValueDeclaration (ValueDeclaration name' nameKind [] Nothing val) | name == name' = return (name', nameKind, val)   fromValueDeclaration (PositionedDeclaration pos d') = do     (ident, nameKind, val) <- rethrowWithPosition pos $ fromValueDeclaration d'

@@ -168,7 +168,7 @@ -- Infer the types of multiple mutually-recursive values, and return elaborated values including -- type class dictionaries and type annotations. ---typesOf :: Maybe ModuleName -> ModuleName -> [(Ident, Value)] -> Check [(Ident, (Value, Type))]+typesOf :: Maybe ModuleName -> ModuleName -> [(Ident, Expr)] -> Check [(Ident, (Expr, Type))] typesOf mainModuleName moduleName vals = do   tys <- fmap tidyUp . liftUnify $ do     (es, dict, untypedDict) <- typeDictionaryForBindingGroup moduleName vals@@ -194,7 +194,7 @@   -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values   tidyUp (ts, sub) = map (\(i, (val, ty)) -> (i, (overTypes (sub $?) val, sub $? ty))) ts -typeDictionaryForBindingGroup :: ModuleName -> [(Ident, Value)] -> UnifyT Type Check ([(Ident, (Value, Maybe (Type, Bool)))], M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility), [(Ident, Type)])+typeDictionaryForBindingGroup :: ModuleName -> [(Ident, Expr)] -> UnifyT Type Check ([(Ident, (Expr, Maybe (Type, Bool)))], M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility), [(Ident, Type)]) typeDictionaryForBindingGroup moduleName vals = do   let     -- Map each declaration to a name/value pair, with an optional type, if the declaration is typed@@ -215,7 +215,7 @@     dict = M.fromList (map (\(ident, ty) -> ((moduleName, ident), (ty, LocalVariable, Undefined))) $ typedDict ++ untypedDict)   return (es, dict, untypedDict) -typeForBindingGroupElement :: ModuleName -> (Ident, (Value, Maybe (Type, Bool))) -> M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility) -> [(Ident, Type)] -> UnifyT Type Check (Ident, (Value, Type))+typeForBindingGroupElement :: ModuleName -> (Ident, (Expr, Maybe (Type, Bool))) -> M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility) -> [(Ident, Type)] -> UnifyT Type Check (Ident, (Expr, Type)) typeForBindingGroupElement moduleName el dict untypedDict =   -- If the declaration is a function, it has access to other values in the binding group.   -- If not, the generated code might fail at runtime since those values might be undefined.@@ -241,17 +241,17 @@ -- | -- Check if a value contains a type annotation ---isTyped :: (Ident, Value) -> (Ident, (Value, Maybe (Type, Bool)))+isTyped :: (Ident, Expr) -> (Ident, (Expr, Maybe (Type, Bool))) isTyped (name, TypedValue checkType value ty) = (name, (value, Just (ty, checkType))) isTyped (name, value) = (name, (value, Nothing))  -- | -- Map a function over type annotations appearing inside a value ---overTypes :: (Type -> Type) -> Value -> Value+overTypes :: (Type -> Type) -> Expr -> Expr overTypes f = let (_, f', _) = everywhereOnValues id g id in f'   where-  g :: Value -> Value+  g :: Expr -> Expr   g (TypedValue checkTy val t) = TypedValue checkTy val (f t)   g (TypeClassDictionary b (nm, tys) sco) = TypeClassDictionary b (nm, map f tys) sco   g other = other@@ -259,7 +259,7 @@ -- | -- Replace type class dictionary placeholders with inferred type class dictionaries ---replaceTypeClassDictionaries :: ModuleName -> Value -> Check Value+replaceTypeClassDictionaries :: ModuleName -> Expr -> Check Expr replaceTypeClassDictionaries mn =   let (_, f, _) = everywhereOnValuesTopDownM return go return   in f@@ -296,7 +296,7 @@ -- Check that the current set of type class dictionaries entail the specified type class goal, and, if so, -- return a type class dictionary reference. ---entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> (Qualified ProperName, [Type]) -> Bool -> Check Value+entails :: Environment -> ModuleName -> [TypeClassDictionaryInScope] -> (Qualified ProperName, [Type]) -> Bool -> Check Expr entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filter filterModule context))   where     sortedNubBy :: (Ord k) => (v -> k) -> [v] -> [v]@@ -354,8 +354,8 @@ 	  mkDictionary fnName Nothing = LocalDictionaryValue fnName 	  mkDictionary fnName (Just []) = GlobalDictionaryValue fnName 	  mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts-	  -- Turn a DictionaryValue into a Value-	  dictionaryValueToValue :: DictionaryValue -> Value+	  -- Turn a DictionaryValue into a Expr+	  dictionaryValueToValue :: DictionaryValue -> Expr 	  dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName 	  dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral []) 	  dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)@@ -434,7 +434,7 @@ -- | -- Ensure skolem variables do not escape their scope ---skolemEscapeCheck :: Value -> Check ()+skolemEscapeCheck :: Expr -> Check () skolemEscapeCheck (TypedValue False _ _) = return () skolemEscapeCheck root@TypedValue{} =   -- Every skolem variable is created when a ForAll type is skolemized.@@ -446,11 +446,11 @@   let (_, f, _, _, _) = everythingWithContextOnValues [] [] (++) def go def def def   in case f root of        [] -> return ()-       ((binding, val) : _) -> throwError $ mkErrorStack ("Rigid/skolem type variable " ++ maybe "" (("bound by " ++) . prettyPrintValue) binding ++ " has escaped.") (Just (ValueError val))+       ((binding, val) : _) -> throwError $ mkErrorStack ("Rigid/skolem type variable " ++ maybe "" (("bound by " ++) . prettyPrintValue) binding ++ " has escaped.") (Just (ExprError val))   where   def s _ = (s, []) -  go :: [(SkolemScope, Value)] -> Value -> ([(SkolemScope, Value)], [(Maybe Value, Value)])+  go :: [(SkolemScope, Expr)] -> Expr -> ([(SkolemScope, Expr)], [(Maybe Expr, Expr)])   go scos val@(TypedValue _ _ (ForAll _ _ (Just sco))) = ((sco, val) : scos, [])   go scos val@(TypedValue _ _ ty) = case collectSkolems ty \\ map fst scos of                                       (sco : _) -> (scos, [(findBindingScope sco, val)])@@ -462,14 +462,14 @@       collect (Skolem _ _ scope) = [scope]       collect _ = []   go scos _ = (scos, [])-  findBindingScope :: SkolemScope -> Maybe Value+  findBindingScope :: SkolemScope -> Maybe Expr   findBindingScope sco =     let (_, f, _, _, _) = everythingOnValues mappend (const mempty) go' (const mempty) (const mempty) (const mempty)     in getFirst $ f root     where     go' val@(TypedValue _ _ (ForAll _ _ (Just sco'))) | sco == sco' = First (Just val)     go' _ = mempty-skolemEscapeCheck val = throwError $ mkErrorStack "Untyped value passed to skolemEscapeCheck" (Just (ValueError val))+skolemEscapeCheck val = throwError $ mkErrorStack "Untyped value passed to skolemEscapeCheck" (Just (ExprError val))  -- | -- Ensure a row contains no duplicate labels@@ -503,7 +503,7 @@ -- This is necessary during type checking to avoid unifying a polymorphic type with a -- unification variable. ---instantiatePolyTypeWithUnknowns :: Value -> Type -> UnifyT Type Check (Value, Type)+instantiatePolyTypeWithUnknowns :: Expr -> Type -> UnifyT Type Check (Expr, Type) instantiatePolyTypeWithUnknowns val (ForAll ident ty _) = do   ty' <- replaceVarWithUnknown ident ty   instantiatePolyTypeWithUnknowns val ty'@@ -571,19 +571,19 @@ -- | -- Ensure a set of property names and value does not contain duplicate labels ---ensureNoDuplicateProperties :: (Error e, MonadError e m) => [(String, Value)] -> m ()+ensureNoDuplicateProperties :: (Error e, MonadError e m) => [(String, Expr)] -> m () ensureNoDuplicateProperties ps = guardWith (strMsg "Duplicate property names") $ length (nub . map fst $ ps) == length ps  -- | -- Infer a type for a value, rethrowing any error to provide a more useful error message ---infer :: Value -> UnifyT Type Check Value-infer val = rethrow (mkErrorStack "Error inferring type of value" (Just (ValueError val)) <>) $ infer' val+infer :: Expr -> UnifyT Type Check Expr+infer val = rethrow (mkErrorStack "Error inferring type of value" (Just (ExprError val)) <>) $ infer' val  -- | -- Infer a type for a value ---infer' :: Value -> UnifyT Type Check Value+infer' :: Expr -> UnifyT Type Check Expr infer' v@(NumericLiteral _) = return $ TypedValue True v tyNumber infer' v@(StringLiteral _) = return $ TypedValue True v tyString infer' v@(BooleanLiteral _) = return $ TypedValue True v tyBoolean@@ -670,7 +670,7 @@ infer' (PositionedValue pos val) = rethrowWithPosition pos $ infer' val infer' _ = error "Invalid argument to infer" -inferLetBinding :: [Declaration] -> [Declaration] -> Value -> (Value -> UnifyT Type Check Value) -> UnifyT Type Check ([Declaration], Value)+inferLetBinding :: [Declaration] -> [Declaration] -> Expr -> (Expr -> UnifyT Type Check Expr) -> UnifyT Type Check ([Declaration], Expr) inferLetBinding seen [] ret j = (,) seen <$> makeBindingGroupVisible (j ret) inferLetBinding seen (ValueDeclaration ident nameKind [] Nothing tv@(TypedValue checkType val ty) : rest) ret j = do   Just moduleName <- checkCurrentModule <$> get@@ -810,7 +810,7 @@ -- SuperClassDictionary placeholder. These type variables are somewhat unique since they are the -- only example of scoped type variables. ---skolemizeTypesInValue :: String -> Int -> SkolemScope -> Value -> Value+skolemizeTypesInValue :: String -> Int -> SkolemScope -> Expr -> Expr skolemizeTypesInValue ident sko scope = let (_, f, _) = everywhereOnValues id go id in f   where   go (SuperClassDictionary c ts) = SuperClassDictionary c (map (skolemize ident sko scope) ts)@@ -828,8 +828,8 @@ -- | -- Check the type of a value, rethrowing errors to provide a better error message ---check :: Value -> Type -> UnifyT Type Check Value-check val ty = rethrow (mkErrorStack errorMessage (Just (ValueError val)) <>) $ check' val ty+check :: Expr -> Type -> UnifyT Type Check Expr+check val ty = rethrow (mkErrorStack errorMessage (Just (ExprError val)) <>) $ check' val ty   where   errorMessage =     "Error checking type of term " ++@@ -840,7 +840,7 @@ -- | -- Check the type of a value ---check' :: Value -> Type -> UnifyT Type Check Value+check' :: Expr -> Type -> UnifyT Type Check Expr check' val (ForAll ident ty _) = do   scope <- newSkolemScope   sko <- newSkolemConstant@@ -911,12 +911,13 @@   kind <- liftCheck $ kindOf moduleName ty1   guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star   ty1' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1-  val' <- subsumes (Just val) ty1' ty2+  ty2' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty2+  val' <- subsumes (Just val) ty1' ty2'   case val' of     Nothing -> throwError . strMsg $ "Unable to check type subsumption"     Just val'' -> do-      val''' <- if checkType then check val'' ty1' else return val''-      return $ TypedValue checkType (TypedValue True val''' ty1) ty2+      val''' <- if checkType then check val'' ty2' else return val''+      return $ TypedValue checkType (TypedValue True val''' ty1') ty2' check' (Case vals binders) ret = do   vals' <- mapM infer vals   let ts = map (\(TypedValue _ _ t) -> t) vals'@@ -963,7 +964,7 @@   check val ty' check' (PositionedValue pos val) ty =   rethrowWithPosition pos $ check val ty-check' val ty = throwError $ mkErrorStack ("Value does not have type " ++ prettyPrintType ty) (Just (ValueError val))+check' val ty = throwError $ mkErrorStack ("Expr does not have type " ++ prettyPrintType ty) (Just (ExprError val))  containsTypeSynonyms :: Type -> Bool containsTypeSynonyms = everythingOnTypes (||) go where@@ -975,15 +976,15 @@ -- -- The @lax@ parameter controls whether or not every record member has to be provided. For object updates, this is not the case. ---checkProperties :: [(String, Value)] -> Type -> Bool -> UnifyT Type Check [(String, Value)]+checkProperties :: [(String, Expr)] -> Type -> Bool -> UnifyT Type Check [(String, Expr)] checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where   go [] [] REmpty = return []   go [] [] u@(TUnknown _) = do u =?= REmpty                                return []   go [] [] (Skolem _ _ _) | lax = return []   go [] ((p, _): _) _ | lax = return []-                      | otherwise = throwError $ mkErrorStack ("Object does not have property " ++ p) (Just (ValueError (ObjectLiteral ps)))-  go ((p,_):_) [] REmpty = throwError $ mkErrorStack ("Property " ++ p ++ " is not present in closed object type " ++ prettyPrintRow row) (Just (ValueError (ObjectLiteral ps)))+                      | otherwise = throwError $ mkErrorStack ("Object does not have property " ++ p) (Just (ExprError (ObjectLiteral ps)))+  go ((p,_):_) [] REmpty = throwError $ mkErrorStack ("Property " ++ p ++ " is not present in closed object type " ++ prettyPrintRow row) (Just (ExprError (ObjectLiteral ps)))   go ((p,v):ps') [] u@(TUnknown _) = do     v'@(TypedValue _ _ ty) <- infer v     rest <- fresh@@ -1002,13 +1003,13 @@         v' <- check v ty         ps'' <- go ps' (delete (p, ty) ts) r         return $ (p, v') : ps''-  go _ _ _ = throwError $ mkErrorStack ("Object does not have type " ++ prettyPrintType (TypeApp tyObject row)) (Just (ValueError (ObjectLiteral ps)))+  go _ _ _ = throwError $ mkErrorStack ("Object does not have type " ++ prettyPrintType (TypeApp tyObject row)) (Just (ExprError (ObjectLiteral ps)))  -- | -- Check the type of a function application, rethrowing errors to provide a better error message ---checkFunctionApplication :: Value -> Type -> Value -> Maybe Type -> UnifyT Type Check (Type, Value)-checkFunctionApplication fn fnTy arg ret = rethrow (mkErrorStack errorMessage (Just (ValueError fn)) <>) $ do+checkFunctionApplication :: Expr -> Type -> Expr -> Maybe Type -> UnifyT Type Check (Type, Expr)+checkFunctionApplication fn fnTy arg ret = rethrow (mkErrorStack errorMessage (Just (ExprError fn)) <>) $ do   subst <- unifyCurrentSubstitution <$> UnifyT get   checkFunctionApplication' fn (subst $? fnTy) arg (($?) subst <$> ret)   where@@ -1019,7 +1020,7 @@ -- | -- Check the type of a function application ---checkFunctionApplication' :: Value -> Type -> Value -> Maybe Type -> UnifyT Type Check (Type, Value)+checkFunctionApplication' :: Expr -> Type -> Expr -> Maybe Type -> UnifyT Type Check (Type, Expr) checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg ret = do   tyFunction' =?= tyFunction   arg' <- check arg argTy@@ -1046,6 +1047,8 @@ checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do   dicts <- getTypeClassDictionaries   checkFunctionApplication' (foldl App fn (map (flip (TypeClassDictionary True) dicts) constraints)) fnTy arg ret+checkFunctionApplication' fn fnTy dict@(TypeClassDictionary _ _ _) _ =+  return (fnTy, App fn dict) checkFunctionApplication' _ fnTy arg _ = throwError . strMsg $ "Cannot apply a function of type "   ++ prettyPrintType fnTy   ++ " to argument " ++ prettyPrintValue arg@@ -1053,8 +1056,8 @@ -- | -- Check whether one type subsumes another, rethrowing errors to provide a better error message ---subsumes :: Maybe Value -> Type -> Type -> UnifyT Type Check (Maybe Value)-subsumes val ty1 ty2 = rethrow (mkErrorStack errorMessage (ValueError <$> val) <>) $ subsumes' val ty1 ty2+subsumes :: Maybe Expr -> Type -> Type -> UnifyT Type Check (Maybe Expr)+subsumes val ty1 ty2 = rethrow (mkErrorStack errorMessage (ExprError <$> val) <>) $ subsumes' val ty1 ty2   where   errorMessage = "Error checking that type "     ++ prettyPrintType ty1@@ -1064,7 +1067,7 @@ -- | -- Check whether one type subsumes another ---subsumes' :: Maybe Value -> Type -> Type -> UnifyT Type Check (Maybe Value)+subsumes' :: Maybe Expr -> Type -> Type -> UnifyT Type Check (Maybe Expr) subsumes' val (ForAll ident ty1 _) ty2 = do   replaced <- replaceVarWithUnknown ident ty1   subsumes val replaced ty2