diff options
| -rw-r--r-- | examples/failing/UnknownValue.purs | 25 | ||||
| -rw-r--r-- | examples/passing/CheckFunction.purs | 5 | ||||
| -rw-r--r-- | examples/passing/OperatorAssociativity.purs | 29 | ||||
| -rw-r--r-- | examples/passing/Operators.purs | 12 | ||||
| -rw-r--r-- | hierarchy/Main.hs | 11 | ||||
| -rw-r--r-- | prelude/prelude.purs | 1054 | ||||
| -rw-r--r-- | psc-docs/Main.hs | 11 | ||||
| -rw-r--r-- | psc-make/Main.hs | 19 | ||||
| -rw-r--r-- | psc/Main.hs | 19 | ||||
| -rw-r--r-- | psci/Main.hs | 15 | ||||
| -rw-r--r-- | purescript.cabal | 16 | ||||
| -rw-r--r-- | src/Language/PureScript/CoreFn/Desugar.hs | 5 | ||||
| -rw-r--r-- | src/Language/PureScript/Pretty/JS.hs | 27 | ||||
| -rw-r--r-- | src/Language/PureScript/Sugar/Operators.hs | 2 | ||||
| -rw-r--r-- | src/Language/PureScript/TypeChecker/Types.hs | 3 | ||||
| -rw-r--r-- | tests/Main.hs | 3 |
16 files changed, 708 insertions, 548 deletions
diff --git a/examples/failing/UnknownValue.purs b/examples/failing/UnknownValue.purs deleted file mode 100644 index c1f458c..0000000 --- a/examples/failing/UnknownValue.purs +++ /dev/null @@ -1,25 +0,0 @@ -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" diff --git a/examples/passing/CheckFunction.purs b/examples/passing/CheckFunction.purs new file mode 100644 index 0000000..6a091a9 --- /dev/null +++ b/examples/passing/CheckFunction.purs @@ -0,0 +1,5 @@ +module Main where + +test = ((\x -> x+1) >>> (\x -> x*2)) 4 + +main = Debug.Trace.trace "Done" diff --git a/examples/passing/OperatorAssociativity.purs b/examples/passing/OperatorAssociativity.purs index e0036c5..ad55243 100644 --- a/examples/passing/OperatorAssociativity.purs +++ b/examples/passing/OperatorAssociativity.purs @@ -1,15 +1,36 @@ module Main where import Control.Monad.Eff +import Debug.Trace + +foreign import data Assert :: ! + +foreign import assert + "function assert(x) { return function (desc) {\ + \ return function () {\ + \ if (!x) throw new Error('assertion (' + desc + ') failed');\ + \ return {};\ + \ };\ + \};};" :: forall e. Boolean -> String -> Eff (assert :: Assert | e) Unit bug :: Number -> Number -> Number bug a b = 0 - (a - b) -foreign import explode +foreign import explode "function explode() {\ \ throw new Error('Assertion failed!');\ \}":: forall eff a. Eff eff a -main = case bug 0 2 of - 2 -> Debug.Trace.trace "Done!" - _ -> explode +main = do + assert (bug 0 2 == 2) "bug 0 2 == 2" + assert (0 - (0 - 2) == 2) "0 - (0 - 2) == 2" + assert (0 - (0 + 2) == -2) "0 - (0 + 2) == -2" + + assert (6 / (3 * 2) == 1) "6 / (3 * 2) == 1" + assert ((6 / 3) * 2 == 4) "(6 / 3) * 2 == 4" + + assert (6 % (2 * 2) == 2) "6 % (2 * 2) == 2" + assert ((6 % 2) * 2 == 0) "(6 % 2) * 2 == 0" + + assert (4 % (9 / 3) == 1) "4 % (9 / 3) == 1" + assert ((4 % 9) / 2 == 2) "(4 % 9) / 2 == 2" diff --git a/examples/passing/Operators.purs b/examples/passing/Operators.purs index 3911c72..69ef6c3 100644 --- a/examples/passing/Operators.purs +++ b/examples/passing/Operators.purs @@ -64,6 +64,15 @@ module Main where test16 :: Number -> Number -> Number test16 x y = x .|. y .&. y + test17 :: Number + test17 = negate (-1) + + test18 :: Number + test18 = negate $ negate 1 + + test19 :: Number + test19 = negate $ negate (-1) + main = do let t1 = test1 1 2 (\x y -> x + y) let t2 = test2 @@ -81,4 +90,7 @@ module Main where let t14 = test14 1 2 let t15 = test15 1 2 let t16 = test16 1 2 + let t17 = test17 + let t18 = test18 + let t19 = test19 trace "Done" diff --git a/hierarchy/Main.hs b/hierarchy/Main.hs index bdb14a0..5393a84 100644 --- a/hierarchy/Main.hs +++ b/hierarchy/Main.hs @@ -25,13 +25,12 @@ import Options.Applicative import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>)) import System.Exit (exitFailure, exitSuccess) -import System.IO (stderr) +import System.IO (hPutStr, stderr) import Text.Parsec as Par (ParseError) import qualified Language.PureScript as P import qualified Paths_purescript as Paths -import qualified System.IO.UTF8 as U data HierarchyOptions = HierarchyOptions @@ -56,14 +55,14 @@ runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns) readInput :: FilePath -> IO (Either Par.ParseError [P.Module]) readInput filename = do - content <- U.readFile filename + content <- readFile filename return $ fmap (map snd) $ P.parseModulesFromFiles id [(filename, content)] compile :: HierarchyOptions -> IO () compile (HierarchyOptions input mOutput) = do modules <- readInput input case modules of - Left err -> U.hPutStr stderr (show err) >> exitFailure + Left err -> hPutStr stderr (show err) >> exitFailure Right ms -> do for_ ms $ \(P.Module moduleName decls _) -> let name = runModuleName moduleName @@ -76,8 +75,8 @@ compile (HierarchyOptions input mOutput) = do in unless (null supers) $ case mOutput of Just output -> do createDirectoryIfMissing True output - U.writeFile (output </> name) hier - Nothing -> U.putStrLn hier + writeFile (output </> name) hier + Nothing -> putStrLn hier exitSuccess superClasses :: P.Declaration -> [SuperMap] diff --git a/prelude/prelude.purs b/prelude/prelude.purs index c84dd8d..5005cd3 100644 --- a/prelude/prelude.purs +++ b/prelude/prelude.purs @@ -69,19 +69,23 @@ module Prelude (:) = cons foreign import cons - "function cons(e) {\ - \ return function(l) {\ - \ return [e].concat(l);\ - \ };\ - \}" :: forall a. a -> [a] -> [a] + """ + function cons(e) { + return function(l) { + return [e].concat(l); + }; + } + """ :: forall a. a -> [a] -> [a] class Show a where show :: a -> String foreign import showStringImpl - "function showStringImpl(s) {\ - \ return JSON.stringify(s);\ - \}" :: String -> String + """ + function showStringImpl(s) { + return JSON.stringify(s); + } + """ :: String -> String instance showUnit :: Show Unit where show (Unit {}) = "Unit {}" @@ -93,23 +97,28 @@ module Prelude show true = "true" show false = "false" - foreign import showNumberImpl "function showNumberImpl(n) {\ - \ return n.toString();\ - \}" :: Number -> String + foreign import showNumberImpl + """ + function showNumberImpl(n) { + return n.toString(); + } + """ :: Number -> String instance showNumber :: Show Number where show = showNumberImpl foreign import showArrayImpl - "function showArrayImpl(f) {\ - \ return function(xs) {\ - \ var ss = [];\ - \ for (var i = 0, l = xs.length; i < l; i++) {\ - \ ss[i] = f(xs[i]);\ - \ }\ - \ return '[' + ss.join(',') + ']';\ - \ };\ - \}" :: forall a. (a -> String) -> [a] -> String + """ + function showArrayImpl(f) { + return function(xs) { + var ss = []; + for (var i = 0, l = xs.length; i < l; i++) { + ss[i] = f(xs[i]); + } + return '[' + ss.join(',') + ']'; + }; + } + """ :: forall a. (a -> String) -> [a] -> String instance showArray :: (Show a) => Show [a] where show = showArrayImpl show @@ -187,39 +196,57 @@ module Prelude (%) :: a -> a -> a negate :: a -> a - foreign import numAdd "function numAdd(n1) {\ - \ return function(n2) {\ - \ return n1 + n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numSub "function numSub(n1) {\ - \ return function(n2) {\ - \ return n1 - n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numMul "function numMul(n1) {\ - \ return function(n2) {\ - \ return n1 * n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numDiv "function numDiv(n1) {\ - \ return function(n2) {\ - \ return n1 / n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numMod "function numMod(n1) {\ - \ return function(n2) {\ - \ return n1 % n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numNegate "function numNegate(n) {\ - \ return -n;\ - \}" :: Number -> Number + foreign import numAdd + """ + function numAdd(n1) { + return function(n2) { + return n1 + n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numSub + """ + function numSub(n1) { + return function(n2) { + return n1 - n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numMul + """ + function numMul(n1) { + return function(n2) { + return n1 * n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numDiv + """ + function numDiv(n1) { + return function(n2) { + return n1 / n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numMod + """ + function numMod(n1) { + return function(n2) { + return n1 % n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numNegate + """ + function numNegate(n) { + return -n; + } + """ :: Number -> Number instance numNumber :: Num Number where (+) = numAdd @@ -242,18 +269,22 @@ module Prelude (/=) :: a -> a -> Boolean foreign import refEq - "function refEq(r1) {\ - \ return function(r2) {\ - \ return r1 === r2;\ - \ };\ - \}" :: forall a. a -> a -> Boolean + """ + function refEq(r1) { + return function(r2) { + return r1 === r2; + }; + } + """ :: forall a. a -> a -> Boolean foreign import refIneq - "function refIneq(r1) {\ - \ return function(r2) {\ - \ return r1 !== r2;\ - \ };\ - \}" :: forall a. a -> a -> Boolean + """ + function refIneq(r1) { + return function(r2) { + return r1 !== r2; + }; + } + """ :: forall a. a -> a -> Boolean instance eqUnit :: Eq Unit where (==) (Unit {}) (Unit {}) = true @@ -272,17 +303,19 @@ module Prelude (/=) = refIneq foreign import eqArrayImpl - "function eqArrayImpl(f) {\ - \ return function(xs) {\ - \ return function(ys) {\ - \ if (xs.length !== ys.length) return false;\ - \ for (var i = 0; i < xs.length; i++) {\ - \ if (!f(xs[i])(ys[i])) return false;\ - \ }\ - \ return true;\ - \ };\ - \ };\ - \}" :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean + """ + function eqArrayImpl(f) { + return function(xs) { + return function(ys) { + if (xs.length !== ys.length) return false; + for (var i = 0; i < xs.length; i++) { + if (!f(xs[i])(ys[i])) return false; + } + return true; + }; + }; + } + """ :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean instance eqArray :: (Eq a) => Eq [a] where (==) xs ys = eqArrayImpl (==) xs ys @@ -334,17 +367,19 @@ module Prelude _ -> true foreign import unsafeCompareImpl - "function unsafeCompareImpl(lt) {\ - \ return function(eq) {\ - \ return function(gt) {\ - \ return function(x) {\ - \ return function(y) {\ - \ return x < y ? lt : x > y ? gt : eq;\ - \ };\ - \ };\ - \ };\ - \ };\ - \}" :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering + """ + function unsafeCompareImpl(lt) { + return function(eq) { + return function(gt) { + return function(x) { + return function(y) { + return x < y ? lt : x > y ? gt : eq; + }; + }; + }; + }; + } + """ :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering unsafeCompare :: forall a. a -> a -> Ordering unsafeCompare = unsafeCompareImpl LT EQ GT @@ -385,45 +420,66 @@ module Prelude zshr :: b -> Number -> b complement :: b -> b - foreign import numShl "function numShl(n1) {\ - \ return function(n2) {\ - \ return n1 << n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numShr "function numShr(n1) {\ - \ return function(n2) {\ - \ return n1 >> n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numZshr "function numZshr(n1) {\ - \ return function(n2) {\ - \ return n1 >>> n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numAnd "function numAnd(n1) {\ - \ return function(n2) {\ - \ return n1 & n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numOr "function numOr(n1) {\ - \ return function(n2) {\ - \ return n1 | n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numXor "function numXor(n1) {\ - \ return function(n2) {\ - \ return n1 ^ n2;\ - \ };\ - \}" :: Number -> Number -> Number - - foreign import numComplement "function numComplement(n) {\ - \ return ~n;\ - \}" :: Number -> Number + foreign import numShl + """ + function numShl(n1) { + return function(n2) { + return n1 << n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numShr + """ + function numShr(n1) { + return function(n2) { + return n1 >> n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numZshr + """ + function numZshr(n1) { + return function(n2) { + return n1 >>> n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numAnd + """ + function numAnd(n1) { + return function(n2) { + return n1 & n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numOr + """ + function numOr(n1) { + return function(n2) { + return n1 | n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numXor + """ + function numXor(n1) { + return function(n2) { + return n1 ^ n2; + }; + } + """ :: Number -> Number -> Number + + foreign import numComplement + """ + function numComplement(n) { + return ~n; + } + """ :: Number -> Number instance bitsNumber :: Bits Number where (.&.) = numAnd @@ -442,21 +498,30 @@ module Prelude (||) :: b -> b -> b not :: b -> b - foreign import boolAnd "function boolAnd(b1) {\ - \ return function(b2) {\ - \ return b1 && b2;\ - \ };\ - \}" :: Boolean -> Boolean -> Boolean - - foreign import boolOr "function boolOr(b1) {\ - \ return function(b2) {\ - \ return b1 || b2;\ - \ };\ - \}" :: Boolean -> Boolean -> Boolean - - foreign import boolNot "function boolNot(b) {\ - \ return !b;\ - \}" :: Boolean -> Boolean + foreign import boolAnd + """ + function boolAnd(b1) { + return function(b2) { + return b1 && b2; + }; + } + """ :: Boolean -> Boolean -> Boolean + + foreign import boolOr + """ + function boolOr(b1) { + return function(b2) { + return b1 || b2; + }; + } + """ :: Boolean -> Boolean -> Boolean + + foreign import boolNot + """ + function boolNot(b) { + return !b; + } + """ :: Boolean -> Boolean instance boolLikeBoolean :: BoolLike Boolean where (&&) = boolAnd @@ -469,11 +534,13 @@ module Prelude (<>) :: a -> a -> a foreign import concatString - "function concatString(s1) {\ - \ return function(s2) {\ - \ return s1 + s2;\ - \ };\ - \}" :: String -> String -> String + """ + function concatString(s1) { + return function(s2) { + return s1 + s2; + }; + } + """ :: String -> String -> String instance semigroupUnit :: Semigroup Unit where (<>) (Unit {}) (Unit {}) = Unit {} @@ -507,293 +574,334 @@ module Data.Function where foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * foreign import mkFn0 - "function mkFn0(fn) {\ - \ return function() {\ - \ return fn({});\ - \ };\ - \}" :: forall a. (Unit -> a) -> Fn0 a + """ + function mkFn0(fn) { + return function() { + return fn({}); + }; + } + """ :: forall a. (Unit -> a) -> Fn0 a foreign import mkFn1 - "function mkFn1(fn) {\ - \ return function(a) {\ - \ return fn(a);\ - \ };\ - \}" :: forall a b. (a -> b) -> Fn1 a b + """ + function mkFn1(fn) { + return function(a) { + return fn(a); + }; + } + """ :: forall a b. (a -> b) -> Fn1 a b foreign import mkFn2 - "function mkFn2(fn) {\ - \ return function(a, b) {\ - \ return fn(a)(b);\ - \ };\ - \}" :: forall a b c. (a -> b -> c) -> Fn2 a b c + """ + function mkFn2(fn) { + return function(a, b) { + return fn(a)(b); + }; + } + """ :: forall a b c. (a -> b -> c) -> Fn2 a b c foreign import mkFn3 - "function mkFn3(fn) {\ - \ return function(a, b, c) {\ - \ return fn(a)(b)(c);\ - \ };\ - \}" :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d + """ + function mkFn3(fn) { + return function(a, b, c) { + return fn(a)(b)(c); + }; + } + """ :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d foreign import mkFn4 - "function mkFn4(fn) {\ - \ return function(a, b, c, d) {\ - \ return fn(a)(b)(c)(d);\ - \ };\ - \}" :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e + """ + function mkFn4(fn) { + return function(a, b, c, d) { + return fn(a)(b)(c)(d); + }; + } + """ :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e foreign import mkFn5 - "function mkFn5(fn) {\ - \ return function(a, b, c, d, e) {\ - \ return fn(a)(b)(c)(d)(e);\ - \ };\ - \}" :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f + """ + function mkFn5(fn) { + return function(a, b, c, d, e) { + return fn(a)(b)(c)(d)(e); + }; + } + """ :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f foreign import mkFn6 - "function mkFn6(fn) {\ - \ return function(a, b, c, d, e, f) {\ - \ return fn(a)(b)(c)(d)(e)(f);\ - \ };\ - \}" :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g + """ + function mkFn6(fn) { + return function(a, b, c, d, e, f) { + return fn(a)(b)(c)(d)(e)(f); + }; + } + """ :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g foreign import mkFn7 - "function mkFn7(fn) {\ - \ return function(a, b, c, d, e, f, g) {\ - \ return fn(a)(b)(c)(d)(e)(f)(g);\ - \ };\ - \}" :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h + """ + function mkFn7(fn) { + return function(a, b, c, d, e, f, g) { + return fn(a)(b)(c)(d)(e)(f)(g); + }; + } + """ :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h foreign import mkFn8 - "function mkFn8(fn) {\ - \ return function(a, b, c, d, e, f, g, h) {\ - \ return fn(a)(b)(c)(d)(e)(f)(g)(h);\ - \ };\ - \}" :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i + """ + function mkFn8(fn) { + return function(a, b, c, d, e, f, g, h) { + return fn(a)(b)(c)(d)(e)(f)(g)(h); + }; + } + """ :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i foreign import mkFn9 - "function mkFn9(fn) {\ - \ return function(a, b, c, d, e, f, g, h, i) {\ - \ return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);\ - \ };\ - \}" :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j + """ + function mkFn9(fn) { + return function(a, b, c, d, e, f, g, h, i) { + return fn(a)(b)(c)(d)(e)(f)(g)(h)(i); + }; + } + """ :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j foreign import mkFn10 - "function mkFn10(fn) {\ - \ return function(a, b, c, d, e, f, g, h, i, j) {\ - \ return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);\ - \ };\ - \}" :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k + """ + function mkFn10(fn) { + return function(a, b, c, d, e, f, g, h, i, j) { + return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j); + }; + } + """ :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k foreign import runFn0 - "function runFn0(fn) {\ - \ return fn();\ - \}" :: forall a. Fn0 a -> a + """ + function runFn0(fn) { + return fn(); + } + """ :: forall a. Fn0 a -> a foreign import runFn1 - "function runFn1(fn) {\ - \ return function(a) {\ - \ return fn(a);\ - \ };\ - \}" :: forall a b. Fn1 a b -> a -> b + """ + function runFn1(fn) { + return function(a) { + return fn(a); + }; + } + """ :: forall a b. Fn1 a b -> a -> b foreign import runFn2 - "function runFn2(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return fn(a, b);\ - \ };\ - \ };\ - \}" :: forall a b c. Fn2 a b c -> a -> b -> c + """ + function runFn2(fn) { + return function(a) { + return function(b) { + return fn(a, b); + }; + }; + } + """ :: forall a b c. Fn2 a b c -> a -> b -> c foreign import runFn3 - "function runFn3(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return function(c) {\ - \ return fn(a, b, c);\ - \ };\ - \ };\ - \ };\ - \}" :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d + """ + function runFn3(fn) { + return function(a) { + return function(b) { + return function(c) { + return fn(a, b, c); + }; + }; + }; + } + """ :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d foreign import runFn4 - "function runFn4(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return function(c) {\ - \ return function(d) {\ - \ return fn(a, b, c, d);\ - \ };\ - \ };\ - \ };\ - \ };\ - \}" :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e + """ + function runFn4(fn) { + return function(a) { + return function(b) { + return function(c) { + return function(d) { + return fn(a, b, c, d); + }; + }; + }; + }; + } + """ :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e foreign import runFn5 - "function runFn5(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return function(c) {\ - \ return function(d) {\ - \ return function(e) {\ - \ return fn(a, b, c, d, e);\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \}" :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f + """ + function runFn5(fn) { + return function(a) { + return function(b) { + return function(c) { + return function(d) { + return function(e) { + return fn(a, b, c, d, e); + }; + }; + }; + }; + }; + } + """ :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f foreign import runFn6 - "function runFn6(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return function(c) {\ - \ return function(d) {\ - \ return function(e) {\ - \ return function(f) {\ - \ return fn(a, b, c, d, e, f);\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \}" :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g + """ + function runFn6(fn) { + return function(a) { + return function(b) { + return function(c) { + return function(d) { + return function(e) { + return function(f) { + return fn(a, b, c, d, e, f); + }; + }; + }; + }; + }; + }; + } + """ :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g foreign import runFn7 - "function runFn7(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return function(c) {\ - \ return function(d) {\ - \ return function(e) {\ - \ return function(f) {\ - \ return function(g) {\ - \ return fn(a, b, c, d, e, f, g);\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \}" :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h + """ + function runFn7(fn) { + return function(a) { + return function(b) { + return function(c) { + return function(d) { + return function(e) { + return function(f) { + return function(g) { + return fn(a, b, c, d, e, f, g); + }; + }; + }; + }; + }; + }; + }; + } + """ :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h foreign import runFn8 - "function runFn8(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return function(c) {\ - \ return function(d) {\ - \ return function(e) {\ - \ return function(f) {\ - \ return function(g) {\ - \ return function(h) {\ - \ return fn(a, b, c, d, e, f, g, h);\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \}" :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i + """ + function runFn8(fn) { + return function(a) { + return function(b) { + return function(c) { + return function(d) { + return function(e) { + return function(f) { + return function(g) { + return function(h) { + return fn(a, b, c, d, e, f, g, h); + }; + }; + }; + }; + }; + }; + }; + }; + } + """ :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i foreign import runFn9 - "function runFn9(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return function(c) {\ - \ return function(d) {\ - \ return function(e) {\ - \ return function(f) {\ - \ return function(g) {\ - \ return function(h) {\ - \ return function(i) {\ - \ return fn(a, b, c, d, e, f, g, h, i);\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \}" :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j + """ + function runFn9(fn) { + return function(a) { + return function(b) { + return function(c) { + return function(d) { + return function(e) { + return function(f) { + return function(g) { + return function(h) { + return function(i) { + return fn(a, b, c, d, e, f, g, h, i); + }; + }; + }; + }; + }; + }; + }; + }; + }; + } + """ :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j foreign import runFn10 - "function runFn10(fn) {\ - \ return function(a) {\ - \ return function(b) {\ - \ return function(c) {\ - \ return function(d) {\ - \ return function(e) {\ - \ return function(f) {\ - \ return function(g) {\ - \ return function(h) {\ - \ return function(i) {\ - \ return function(j) {\ - \ return fn(a, b, c, d, e, f, g, h, i, j);\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \ };\ - \}" :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k - -module Data.Eq where - - newtype Ref a = Ref a - - liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b - liftRef f (Ref x) (Ref y) = f x y - - instance eqRef :: Eq (Ref a) where - (==) = liftRef refEq - (/=) = liftRef refIneq - - instance functorRef :: Functor Ref where - (<$>) f (Ref x) = Ref (f x) + """ + function runFn10(fn) { + return function(a) { + return function(b) { + return function(c) { + return function(d) { + return function(e) { + return function(f) { + return function(g) { + return function(h) { + return function(i) { + return function(j) { + return fn(a, b, c, d, e, f, g, h, i, j); + }; + }; + }; + }; + }; + }; + }; + }; + }; + }; + } + """ :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k module Prelude.Unsafe where foreign import unsafeIndex - "function unsafeIndex(xs) {\ - \ return function(n) {\ - \ return xs[n];\ - \ };\ - \}" :: forall a. [a] -> Number -> a + """ + function unsafeIndex(xs) { + return function(n) { + return xs[n]; + }; + } + """ :: forall a. [a] -> Number -> a module Control.Monad.Eff where foreign import data Eff :: # ! -> * -> * - foreign import returnE "function returnE(a) {\ - \ return function() {\ - \ return a;\ - \ };\ - \}" :: forall e a. a -> Eff e a - - foreign import bindE "function bindE(a) {\ - \ return function(f) {\ - \ return function() {\ - \ return f(a())();\ - \ };\ - \ };\ - \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b + foreign import returnE + """ + function returnE(a) { + return function() { + return a; + }; + } + """ :: forall e a. a -> Eff e a + + foreign import bindE + """ + function bindE(a) { + return function(f) { + return function() { + return f(a())(); + }; + }; + } + """ :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b type Pure a = forall e. Eff e a - foreign import runPure "function runPure(f) {\ - \ return f();\ - \}" :: forall a. Pure a -> a + foreign import runPure + """ + function runPure(f) { + return f(); + } + """ :: forall a. Pure a -> a instance functorEff :: Functor (Eff e) where (<$>) = liftA1 @@ -809,55 +917,69 @@ module Control.Monad.Eff where instance monadEff :: Monad (Eff e) - foreign import untilE "function untilE(f) {\ - \ return function() {\ - \ while (!f());\ - \ return {};\ - \ };\ - \}" :: forall e. Eff e Boolean -> Eff e Unit - - foreign import whileE "function whileE(f) {\ - \ return function(a) {\ - \ return function() {\ - \ while (f()) {\ - \ a();\ - \ }\ - \ return {};\ - \ };\ - \ };\ - \}" :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit - - foreign import forE "function forE(lo) {\ - \ return function(hi) {\ - \ return function(f) {\ - \ return function() {\ - \ for (var i = lo; i < hi; i++) {\ - \ f(i)();\ - \ }\ - \ };\ - \ };\ - \ };\ - \}" :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit - - - foreign import foreachE "function foreachE(as) {\ - \ return function(f) {\ - \ return function() {\ - \ for (var i = 0; i < as.length; i++) {\ - \ f(as[i])();\ - \ }\ - \ };\ - \ };\ - \}" :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit + foreign import untilE + """ + function untilE(f) { + return function() { + while (!f()); + return {}; + }; + } + """ :: forall e. Eff e Boolean -> Eff e Unit + + foreign import whileE + """ + function whileE(f) { + return function(a) { + return function() { + while (f()) { + a(); + } + return {}; + }; + }; + } + """ :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit + + foreign import forE + """ + function forE(lo) { + return function(hi) { + return function(f) { + return function() { + for (var i = lo; i < hi; i++) { + f(i)(); + } + }; + }; + }; + } + """ :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit + + + foreign import foreachE + """ + function foreachE(as) { + return function(f) { + return function() { + for (var i = 0; i < as.length; i++) { + f(as[i])(); + } + }; + }; + } + """ :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit module Control.Monad.Eff.Unsafe where import Control.Monad.Eff foreign import unsafeInterleaveEff - "function unsafeInterleaveEff(f) {\ - \ return f;\ - \}" :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a + """ + function unsafeInterleaveEff(f) { + return f; + } + """ :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a module Debug.Trace where @@ -865,12 +987,15 @@ module Debug.Trace where foreign import data Trace :: ! - foreign import trace "function trace(s) {\ - \ return function() {\ - \ console.log(s);\ - \ return {};\ - \ };\ - \}" :: forall r. String -> Eff (trace :: Trace | r) Unit + foreign import trace + """ + function trace(s) { + return function() { + console.log(s); + return {}; + }; + } + """ :: forall r. String -> Eff (trace :: Trace | r) Unit print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit print o = trace (show o) @@ -883,37 +1008,52 @@ module Control.Monad.ST where foreign import data STRef :: * -> * -> * - foreign import newSTRef "function newSTRef(val) {\ - \ return function() {\ - \ return { value: val };\ - \ };\ - \}" :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a) - - foreign import readSTRef "function readSTRef(ref) {\ - \ return function() {\ - \ return ref.value;\ - \ };\ - \}" :: forall a h r. STRef h a -> Eff (st :: ST h | r) a - - foreign import modifySTRef "function modifySTRef(ref) {\ - \ return function(f) {\ - \ return function() {\ - \ return ref.value = f(ref.value);\ - \ };\ - \ };\ - \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a - - foreign import writeSTRef "function writeSTRef(ref) {\ - \ return function(a) {\ - \ return function() {\ - \ return ref.value = a;\ - \ };\ - \ };\ - \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a - - foreign import runST "function runST(f) {\ - \ return f;\ - \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a + foreign import newSTRef + """ + function newSTRef(val) { + return function() { + return { value: val }; + }; + } + """ :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a) + + foreign import readSTRef + """ + function readSTRef(ref) { + return function() { + return ref.value; + }; + } + """ :: forall a h r. STRef h a -> Eff (st :: ST h | r) a + + foreign import modifySTRef + """ + function modifySTRef(ref) { + return function(f) { + return function() { + return ref.value = f(ref.value); + }; + }; + } + """ :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a + + foreign import writeSTRef + """ + function writeSTRef(ref) { + return function(a) { + return function() { + return ref.value = a; + }; + }; + } + """ :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a + + foreign import runST + """ + function runST(f) { + return f; + } + """ :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a pureST st = runPure (runST st) diff --git a/psc-docs/Main.hs b/psc-docs/Main.hs index cf4d191..9cc11da 100644 --- a/psc-docs/Main.hs +++ b/psc-docs/Main.hs @@ -27,9 +27,8 @@ import Options.Applicative import qualified Language.PureScript as P import qualified Paths_purescript as Paths -import qualified System.IO.UTF8 as U import System.Exit (exitSuccess, exitFailure) -import System.IO (stderr) +import System.IO (hPutStr, stderr) data PSCDocsOptions = PSCDocsOptions @@ -43,14 +42,14 @@ docgen (PSCDocsOptions showHierarchy input) = do e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input) case e of Left err -> do - U.hPutStr stderr $ show err + hPutStr stderr $ show err exitFailure Right ms -> do - U.putStrLn . runDocs $ (renderModules showHierarchy) (map snd ms) + putStrLn . runDocs $ (renderModules showHierarchy) (map snd ms) exitSuccess parseFile :: FilePath -> IO (FilePath, String) -parseFile input = (,) input <$> U.readFile input +parseFile input = (,) input <$> readFile input type Docs = Writer [String] () @@ -215,7 +214,7 @@ isTypeInstanceDeclaration _ = False inputFile :: Parser FilePath inputFile = strArgument $ metavar "FILE" - <> help "The input .ps file(s)" + <> help "The input .purs file(s)" includeHeirarcy :: Parser Bool includeHeirarcy = switch $ diff --git a/psc-make/Main.hs b/psc-make/Main.hs index fabc599..efd2dc9 100644 --- a/psc-make/Main.hs +++ b/psc-make/Main.hs @@ -31,7 +31,6 @@ import System.IO.Error (tryIOError) import qualified Language.PureScript as P import qualified Paths_purescript as Paths -import qualified System.IO.UTF8 as U data PSCMakeOptions = PSCMakeOptions @@ -48,7 +47,7 @@ data InputOptions = InputOptions readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)] readInput InputOptions{..} = do - content <- forM ioInputFiles $ \inFile -> (Right inFile, ) <$> U.readFile inFile + content <- forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content) newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String) @@ -66,27 +65,27 @@ instance P.MonadMake Make where True -> Just <$> getModificationTime path False -> return Nothing readTextFile path = makeIO $ do - U.putStrLn $ "Reading " ++ path - U.readFile path + putStrLn $ "Reading " ++ path + readFile path writeTextFile path text = makeIO $ do mkdirp path - U.putStrLn $ "Writing " ++ path - U.writeFile path text + putStrLn $ "Writing " ++ path + writeFile path text liftError = either throwError return - progress = makeIO . U.putStrLn + progress = makeIO . putStrLn compile :: PSCMakeOptions -> IO () compile (PSCMakeOptions input outputDir opts usePrefix) = do modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input) case modules of Left err -> do - U.print err + print err exitFailure Right ms -> do e <- runMake $ P.make outputDir opts ms prefix case e of Left err -> do - U.putStrLn err + putStrLn err exitFailure Right _ -> do exitSuccess @@ -101,7 +100,7 @@ mkdirp = createDirectoryIfMissing True . takeDirectory inputFile :: Parser FilePath inputFile = strArgument $ metavar "FILE" - <> help "The input .ps file(s)" + <> help "The input .purs file(s)" outputDirectory :: Parser FilePath outputDirectory = strOption $ diff --git a/psc/Main.hs b/psc/Main.hs index cee1052..0171391 100644 --- a/psc/Main.hs +++ b/psc/Main.hs @@ -26,11 +26,10 @@ import Options.Applicative as Opts import System.Directory (createDirectoryIfMissing) import System.FilePath (takeDirectory) import System.Exit (exitSuccess, exitFailure) -import System.IO (stderr) +import System.IO (hPutStr, hPutStrLn, stderr) import qualified Language.PureScript as P import qualified Paths_purescript as Paths -import qualified System.IO.UTF8 as U data PSCOptions = PSCOptions @@ -51,7 +50,7 @@ data InputOptions = InputOptions readInput :: InputOptions -> IO [(Maybe FilePath, String)] readInput InputOptions{..} | ioUseStdIn = return . (Nothing ,) <$> getContents - | otherwise = do content <- forM ioInputFiles $ \inFile -> (Just inFile, ) <$> U.readFile inFile + | otherwise = do content <- forM ioInputFiles $ \inFile -> (Just inFile, ) <$> readFile inFile return (if ioNoPrelude then content else (Nothing, P.prelude) : content) compile :: PSCOptions -> IO () @@ -59,19 +58,19 @@ compile (PSCOptions input opts stdin output externs usePrefix) = do modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input) case modules of Left err -> do - U.hPutStr stderr $ show err + hPutStr stderr $ show err exitFailure Right ms -> do case P.compile opts (map snd ms) prefix of Left err -> do - U.hPutStrLn stderr err + hPutStrLn stderr err exitFailure Right (js, exts, _) -> do case output of - Just path -> mkdirp path >> U.writeFile path js - Nothing -> U.putStrLn js + Just path -> mkdirp path >> writeFile path js + Nothing -> putStrLn js case externs of - Just path -> mkdirp path >> U.writeFile path exts + Just path -> mkdirp path >> writeFile path exts Nothing -> return () exitSuccess where @@ -147,7 +146,7 @@ useStdIn = switch $ inputFile :: Parser FilePath inputFile = strArgument $ metavar "FILE" - <> help "The input .ps file(s)" + <> help "The input .purs file(s)" outputFile :: Parser (Maybe FilePath) outputFile = optional . strOption $ @@ -159,7 +158,7 @@ externsFile :: Parser (Maybe FilePath) externsFile = optional . strOption $ short 'e' <> long "externs" - <> help "The output .e.ps file" + <> help "The output .e.purs file" noPrefix :: Parser Bool noPrefix = switch $ diff --git a/psci/Main.hs b/psci/Main.hs index d09e504..49505bd 100644 --- a/psci/Main.hs +++ b/psci/Main.hs @@ -42,7 +42,6 @@ import System.Exit import System.FilePath (pathSeparator, takeDirectory, (</>), isPathSeparator) import System.IO.Error (tryIOError) import System.Process (readProcessWithExitCode) -import qualified System.IO.UTF8 as U (writeFile, putStrLn, print, readFile) import qualified Text.Parsec as Par (ParseError) @@ -129,7 +128,7 @@ getHistoryFilename = do -- loadModule :: FilePath -> IO (Either String [P.Module]) loadModule filename = do - content <- U.readFile filename + content <- readFile filename return $ either (Left . show) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)] -- | @@ -138,7 +137,7 @@ loadModule filename = do loadAllModules :: [FilePath] -> IO (Either Par.ParseError [(Either P.RebuildPolicy FilePath, P.Module)]) loadAllModules files = do filesAndContent <- forM files $ \filename -> do - content <- U.readFile filename + content <- readFile filename return (Right filename, content) return $ P.parseModulesFromFiles (either (const "") id) $ (Left P.RebuildNever, P.prelude) : filesAndContent @@ -329,12 +328,12 @@ instance P.MonadMake Make where if exists then Just <$> getModificationTime path else return Nothing - readTextFile path = makeIO $ U.readFile path + readTextFile path = makeIO $ readFile path writeTextFile path text = makeIO $ do mkdirp path - U.writeFile path text + writeFile path text liftError = either throwError return - progress s = unless (s == "Compiling $PSCI") $ makeIO . U.putStrLn $ s + progress s = unless (s == "Compiling $PSCI") $ makeIO . putStrLn $ s mkdirp :: FilePath -> IO () mkdirp = createDirectoryIfMissing True . takeDirectory @@ -579,9 +578,9 @@ loadUserConfig = do exists <- doesFileExist configFile if exists then do - ls <- lines <$> U.readFile configFile + ls <- lines <$> readFile configFile case mapM parseCommand ls of - Left err -> U.print err >> exitFailure + Left err -> print err >> exitFailure Right cs -> return $ Just cs else return Nothing diff --git a/purescript.cabal b/purescript.cabal index 9dc7d99..c531259 100644 --- a/purescript.cabal +++ b/purescript.cabal @@ -1,5 +1,5 @@ name: purescript -version: 0.6.3 +version: 0.6.4 cabal-version: >=1.8 build-type: Simple license: MIT @@ -32,7 +32,7 @@ library mtl >= 2.1.0 && < 2.3.0, parsec -any, transformers >= 0.3 && < 0.5, - utf8-string -any, + utf8-string >= 1 && < 2, pattern-arrows >= 0.0.2 && < 0.1, monad-unify >= 0.2.2 && < 0.3, file-embed >= 0.0.7 && < 0.0.8, @@ -119,7 +119,7 @@ library executable psc build-depends: base >=4 && <5, containers -any, directory -any, filepath -any, mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any, - transformers -any, utf8-string -any + transformers -any main-is: Main.hs buildable: True hs-source-dirs: psc @@ -129,7 +129,7 @@ executable psc executable psc-make build-depends: base >=4 && <5, containers -any, directory -any, filepath -any, mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any, - transformers -any, utf8-string -any + transformers -any main-is: Main.hs buildable: True hs-source-dirs: psc-make @@ -140,7 +140,7 @@ executable psci build-depends: base >=4 && <5, containers -any, directory -any, filepath -any, mtl -any, optparse-applicative >= 0.10.0, parsec -any, haskeline >= 0.7.0.0, purescript -any, transformers -any, - utf8-string -any, process -any + process -any main-is: Main.hs buildable: True @@ -150,7 +150,7 @@ executable psci ghc-options: -Wall -fno-warn-warnings-deprecations -O2 executable psc-docs - build-depends: base >=4 && <5, purescript -any, utf8-string -any, + build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0, process -any, mtl -any main-is: Main.hs buildable: True @@ -159,7 +159,7 @@ executable psc-docs ghc-options: -Wall -fno-warn-warnings-deprecations -O2 executable hierarchy - build-depends: base >=4 && <5, purescript -any, utf8-string -any, optparse-applicative >= 0.10.0, + build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0, process -any, mtl -any, parsec -any, filepath -any, directory -any main-is: Main.hs buildable: True @@ -170,7 +170,7 @@ executable hierarchy test-suite tests build-depends: base >=4 && <5, containers -any, directory -any, filepath -any, mtl -any, parsec -any, purescript -any, - transformers -any, utf8-string -any, process -any + transformers -any, process -any type: exitcode-stdio-1.0 main-is: Main.hs buildable: True diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs index 0748d18..35e6eec 100644 --- a/src/Language/PureScript/CoreFn/Desugar.hs +++ b/src/Language/PureScript/CoreFn/Desugar.hs @@ -49,6 +49,11 @@ moduleToCoreFn env (A.Module mn decls (Just exps)) = moduleToCoreFn _ (A.Module{}) = error "Module exports were not elaborated before moduleToCoreFn" +-- | +-- Find module names from qualified references to values. This is used to +-- ensure instances are imported from any module that is referenced by the +-- current module, not just from those that are imported explicitly (#667). +-- findQualModules :: [A.Declaration] -> [ModuleName] findQualModules decls = let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues (const []) (const []) (const []) diff --git a/src/Language/PureScript/Pretty/JS.hs b/src/Language/PureScript/Pretty/JS.hs index 4cd7a00..6cda6cb 100644 --- a/src/Language/PureScript/Pretty/JS.hs +++ b/src/Language/PureScript/Pretty/JS.hs @@ -209,15 +209,24 @@ instanceOf = mkPattern match match (JSInstanceOf val ty) = Just (val, ty) match _ = Nothing -unary :: UnaryOperator -> String -> Operator PrinterState JS String -unary op str = Wrap match (++) +unary' :: UnaryOperator -> (JS -> String) -> Operator PrinterState JS String +unary' op mkStr = Wrap match (++) where match :: Pattern PrinterState JS (String, JS) match = mkPattern match' where - match' (JSUnary op' val) | op' == op = Just (str, val) + match' (JSUnary op' val) | op' == op = Just (mkStr val, val) match' _ = Nothing +unary :: UnaryOperator -> String -> Operator PrinterState JS String +unary op str = unary' op (const str) + +negateOperator :: Operator PrinterState JS String +negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-") + where + isNegate (JSUnary Negate _) = True + isNegate _ = False + binary :: BinaryOperator -> String -> Operator PrinterState JS String binary op str = AssocL match (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2) where @@ -271,13 +280,13 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue , [ AssocR instanceOf $ \v1 v2 -> v1 ++ " instanceof " ++ v2 ] , [ unary Not "!" ] , [ unary BitwiseNot "~" ] - , [ unary Negate "-" ] + , [ negateOperator ] , [ unary Positive "+" ] - , [ binary Multiply "*" ] - , [ binary Divide "/" ] - , [ binary Modulus "%" ] - , [ binary Add "+" ] - , [ binary Subtract "-" ] + , [ binary Multiply "*" + , binary Divide "/" + , binary Modulus "%" ] + , [ binary Add "+" + , binary Subtract "-" ] , [ binary ShiftLeft "<<" ] , [ binary ShiftRight ">>" ] , [ binary ZeroFillShiftRight ">>>" ] diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs index 4582161..277c1dc 100644 --- a/src/Language/PureScript/Sugar/Operators.hs +++ b/src/Language/PureScript/Sugar/Operators.hs @@ -58,8 +58,6 @@ removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts where (f', _, _) = everywhereOnValues id go id - go (UnaryMinus (NumericLiteral (Left n))) = NumericLiteral (Left $ negate n) - go (UnaryMinus (NumericLiteral (Right n))) = NumericLiteral (Right $ negate n) go (UnaryMinus val) = App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident C.negate))) val go other = other diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs index b46bbc4..0c53c71 100644 --- a/src/Language/PureScript/TypeChecker/Types.hs +++ b/src/Language/PureScript/TypeChecker/Types.hs @@ -472,7 +472,8 @@ check' (ArrayLiteral vals) t@(TypeApp a ty) = do a =?= tyArray array <- ArrayLiteral <$> forM vals (`check` ty) return $ TypedValue True array t -check' (Abs (Left arg) ret) ty@(TypeApp (TypeApp t argTy) retTy) | t == tyFunction = do +check' (Abs (Left arg) ret) ty@(TypeApp (TypeApp t argTy) retTy) = do + t =?= tyFunction Just moduleName <- checkCurrentModule <$> get ret' <- makeBindingGroupVisible $ bindLocalVariables moduleName [(arg, argTy, Defined)] $ check ret retTy return $ TypedValue True (Abs (Left arg) ret') ty diff --git a/tests/Main.hs b/tests/Main.hs index 0fa63d5..d1b1397 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -28,11 +28,10 @@ import System.Process import System.FilePath (pathSeparator) import System.Directory (getCurrentDirectory, getTemporaryDirectory, getDirectoryContents, findExecutable) import Text.Parsec (ParseError) -import qualified System.IO.UTF8 as U readInput :: [FilePath] -> IO [(FilePath, String)] readInput inputFiles = forM inputFiles $ \inputFile -> do - text <- U.readFile inputFile + text <- readFile inputFile return (inputFile, text) loadPrelude :: Either String (String, String, P.Environment) |