d2d684c · rowtype-yoga/purescript-native

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

Fix some bugs, fix remaining passing examples, still need to fix prelude.

commitd2d684c818a47315e5595a5bda62be01d539703f authorPhil Freeman <paf31@cantab.net> dateSun 29 Dec 2013, 19:30 (13 years ago) parentd1d5cc2

8 files changed+42−37

compare with golang

unifiedsplit

examples/shelltest/Foreach.js+1−1 examples/shelltest/List.js+4−4 examples/shelltest/Maybe.js+3−3 examples/shelltest/runAll.test+1−1 libraries/prelude/prelude.purs+15−11 src/Language/PureScript/Operators.hs+7−7 src/Language/PureScript/TypeChecker/Synonyms.hs+8−8 src/Language/PureScript/TypeChecker/Types.hs+3−2

examples/shelltest/Foreach.js+1−1

@@ -1 +1 @@

1−console.log(sum([1,2,3,4,5]));

1+console.log(Foreach.sum([1,2,3,4,5]));

examples/shelltest/List.js+4−4

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

1−var l1 = Cons({ head: 1, tail: Nil });

2−var l2 = Cons({ head: 2, tail: Nil });

3−var l3 = Cons({ head: l1, tail: Cons({ head: l2, tail: Nil }) });

4−var flat = flatten(l3);

1+var l1 = List.Cons({ head: 1, tail: List.Nil });

2+var l2 = List.Cons({ head: 2, tail: List.Nil });

3+var l3 = List.Cons({ head: l1, tail: List.Cons({ head: l2, tail: List.Nil }) });

4+var flat = List.flatten(l3);

55var f1 = flat.value.head;

66var f2 = flat.value.tail.value.head

77console.log([f1, f2]);

examples/shelltest/Maybe.js+3−3

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

1−console.log(bind(Just("a"))(function(a) {

2− return bind(Just("b"))(function(b) {

3− return Just(a + b);

1+console.log(Maybe.bind(Maybe.Just("a"))(function(a) {

2+ return Maybe.bind(Maybe.Just("b"))(function(b) {

3+ return Maybe.Just(a + b);

44 });

55}));

examples/shelltest/runAll.test+1−1

@@ -2,7 +2,7 @@

22mkdir -p tests && ../../dist/build/psc/psc ../passing/Maybe.purs -o tests/Maybe.js && cat tests/Maybe.js Maybe.js | nodejs

33<<<

44>>>

5−{ ctor: 'Just', value: 'ab' }

5+{ ctor: 'Maybe.Just', value: 'ab' }

66>>>2

77>>>= 0

libraries/prelude/prelude.purs+15−11

@@ -15,7 +15,7 @@ module Prelude where

1515 (<|) :: forall a b c. (b -> c) -> (a -> b) -> a -> c

1616 (<|) = flip (|>)

1717

18− -- Maybe

18+module Maybe where

1919

2020 data Maybe a = Nothing | Just a

2121

@@ -24,12 +24,12 @@ module Prelude where

2424 maybe _ f (Just a) = f a

2525

2626 fromMaybe :: forall a. a -> Maybe a -> a

27− fromMaybe a = maybe a id

27+ fromMaybe a = maybe a Prelude.id

2828

2929 bindMaybe :: forall a b. Maybe a -> (a -> Maybe b) -> Maybe b

3030 bindMaybe m f = maybe Nothing f m

3131

32− -- Either

32+module Either where

3333

3434 data Either a b = Left a | Right b

3535

@@ -40,7 +40,9 @@ module Prelude where

4040 bindEither :: forall e a b. Either e a -> (a -> Either e b) -> Either e b

4141 bindEither = either (\e _ -> Left e) (\a f -> f a)

4242

43− -- Arrays

43+module Arrays where

44+

45+ import Maybe

4446

4547 head :: forall a. [a] -> a

4648 head (x : _) = x

@@ -96,7 +98,7 @@ module Prelude where

9698 foreign import splice :: forall a. Number -> Number -> [a] -> [a] -> [a]

9799

98100 cons :: forall a. a -> [a] -> [a]

99− cons = \a -> concat([a])

101+ cons a = concat [a]

100102

101103 concatMap :: forall a b. [a] -> (a -> [b]) -> [b]

102104 concatMap as f = {

@@ -146,7 +148,9 @@ module Prelude where

146148 return true;

147149 }

148150

149− -- Pairs

151+module Tuple where

152+

153+ import Arrays

150154

151155 type Tuple a b = { fst :: a, snd :: b }

152156

@@ -157,7 +161,7 @@ module Prelude where

157161 uncurry f t = f t.fst t.snd

158162

159163 tuple :: forall a b. a -> b -> Tuple a b

160− tuple = curry id

164+ tuple = curry Prelude.id

161165

162166 zip :: forall a b. [a] -> [b] -> [Tuple a b]

163167 zip = zipWith tuple

@@ -167,7 +171,7 @@ module Prelude where

167171 { fst = as, snd = bs } -> tuple (cons t.fst as) (cons t.snd bs)

168172 unzip [] = tuple [] []

169173

170− -- Strings

174+module String where

171175

172176 foreign import member "length" lengthS :: String -> Number

173177

@@ -195,7 +199,7 @@ module Prelude where

195199

196200 foreign import trim :: String -> String

197201

198− -- Regex

202+module Regex where

199203

200204 foreign import data Regex :: *

201205

@@ -209,7 +213,7 @@ module Prelude where

209213

210214 foreign import search :: Regex -> String -> Number

211215

212− -- Globals

216+module Global where

213217

214218 foreign import nan :: Number

215219

@@ -239,7 +243,7 @@ module Prelude where

239243

240244 foreign import decodeURI :: String -> String

241245

242− -- Math

246+module Math where

243247

244248 type Math =

245249 { abs :: Number -> Number

src/Language/PureScript/Operators.hs+7−7

@@ -37,7 +37,7 @@ rebracket :: [Module] -> Either String [Module]

3737rebracket ms = forM ms $ \(Module name ds) -> do

3838 m <- collectFixities (ModuleName name) ds

3939 let opTable = customOperatorTable m

40− ds' <- G.everywhereM' (G.mkM (matchOperators opTable)) ds

40+ ds' <- G.everywhereM' (G.mkM (matchOperators (ModuleName name) opTable)) ds

4141 return $ Module name $ G.everywhere (G.mkT removeParens) ds'

4242

4343removeParens :: Value -> Value

@@ -56,8 +56,8 @@ customOperatorTable fixities =

5656

5757type Chain = [Either Value (Qualified Ident)]

5858

59−matchOperators :: [[(Qualified Ident, Value -> Value -> Value, Associativity)]] -> Value -> Either String Value

60−matchOperators ops val = G.everywhereM' (G.mkM parseChains) val

59+matchOperators :: ModuleName -> [[(Qualified Ident, Value -> Value -> Value, Associativity)]] -> Value -> Either String Value

60+matchOperators moduleName ops val = G.everywhereM' (G.mkM parseChains) val

6161 where

6262 parseChains :: Value -> Either String Value

6363 parseChains b@(BinaryNoParens _ _ _) = bracketChain (extendChain b)

@@ -67,7 +67,7 @@ matchOperators ops val = G.everywhereM' (G.mkM parseChains) val

6767 extendChain other = [Left other]

6868 bracketChain :: Chain -> Either String Value

6969 bracketChain = either (Left . show) Right . P.parse (P.buildExpressionParser opTable parseValue <* P.eof) "operator expression"

70− opTable = map (map (\(name, f, a) -> P.Infix (P.try (matchOp name) >> return f) (toAssoc a))) ops

70+ opTable = map (map (\(name, f, a) -> P.Infix (P.try (matchOp moduleName name) >> return f) (toAssoc a))) ops

7171 ++ [[P.Infix (P.try (parseOp >>= \ident -> return (\t1 t2 -> App (App (Var ident) [t1]) [t2]))) P.AssocLeft]]

7272

7373toAssoc :: Associativity -> P.Assoc

@@ -80,10 +80,10 @@ parseValue = P.token show (const (P.initialPos "")) (either Just (const Nothing)

8080parseOp :: P.Parsec Chain () (Qualified Ident)

8181parseOp = P.token show (const (P.initialPos "")) (either (const Nothing) Just) P.<?> "operator"

8282

83−matchOp :: Qualified Ident -> P.Parsec Chain () ()

84−matchOp op = do

83+matchOp :: ModuleName -> Qualified Ident -> P.Parsec Chain () ()

84+matchOp moduleName op = do

8585 ident <- parseOp

86− guard (ident == op)

86+ guard (qualify moduleName ident == qualify moduleName op)

8787

8888collectFixities :: ModuleName -> [Declaration] -> Either String (M.Map (Qualified Ident) Fixity)

8989collectFixities = go M.empty

src/Language/PureScript/TypeChecker/Synonyms.hs+8−8

@@ -27,22 +27,22 @@ import Data.Generics.Extras

2727import Control.Monad.Writer

2828import Control.Monad.Error

2929

30−buildTypeSubstitution :: Qualified ProperName -> Int -> Type -> Either String (Maybe Type)

31−buildTypeSubstitution name n = go n []

30+buildTypeSubstitution :: ModuleName -> Qualified ProperName -> Int -> Type -> Either String (Maybe Type)

31+buildTypeSubstitution moduleName name n = go n []

3232 where

3333 go :: Int -> [Type] -> Type -> Either String (Maybe Type)

34− go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)

34+ go 0 args (TypeConstructor ctor) | qualify moduleName name == qualify moduleName ctor = return (Just $ SaturatedTypeSynonym ctor args)

3535 go m _ (TypeConstructor ctor) | m > 0 && name == ctor = throwError $ "Partially applied type synonym " ++ show name

3636 go m args (TypeApp f arg) = go (m - 1) (arg:args) f

3737 go _ _ _ = return Nothing

3838

39−saturateTypeSynonym :: (Data d) => Qualified ProperName -> Int -> d -> Either String d

40−saturateTypeSynonym name n = everywhereM' (mkM replace)

39+saturateTypeSynonym :: (Data d) => ModuleName -> Qualified ProperName -> Int -> d -> Either String d

40+saturateTypeSynonym moduleName name n = everywhereM' (mkM replace)

4141 where

42− replace t = fmap (fromMaybe t) $ buildTypeSubstitution name n t

42+ replace t = fmap (fromMaybe t) $ buildTypeSubstitution moduleName name n t

4343

44−saturateAllTypeSynonyms :: (Data d) => [(Qualified ProperName, Int)] -> d -> Either String d

45−saturateAllTypeSynonyms syns d = foldM (\result (name, n) -> saturateTypeSynonym name n result) d syns

44+saturateAllTypeSynonyms :: (Data d) => ModuleName -> [(Qualified ProperName, Int)] -> d -> Either String d

45+saturateAllTypeSynonyms moduleName syns d = foldM (\result (name, n) -> saturateTypeSynonym moduleName name n result) d syns

4646

4747

4848

src/Language/PureScript/TypeChecker/Types.hs+3−2

@@ -238,11 +238,12 @@ replaceVarWithUnknown ident ty = do

238238 ru <- fresh

239239 return $ replaceRowVars ident ru . replaceTypeVars ident tu $ ty

240240

241−replaceAllTypeSynonyms :: (Functor m, MonadState CheckState m, MonadError String m) => (D.Data d) => d -> m d

241+replaceAllTypeSynonyms :: (Functor m, MonadState CheckState m, MonadReader SubstContext m, MonadError String m) => (D.Data d) => d -> m d

242242replaceAllTypeSynonyms d = do

243243 env <- getEnv

244+ moduleName <- substCurrentModule <$> ask

244245 let syns = map (\((path, name), (args, _)) -> (Qualified (Just path) name, length args)) . M.toList $ typeSynonyms env

245− either throwError return $ saturateAllTypeSynonyms syns d

246+ either throwError return $ saturateAllTypeSynonyms moduleName syns d

246247

247248desaturateAllTypeSynonyms :: (D.Data d) => d -> d

248249desaturateAllTypeSynonyms = everywhere (mkT replaceSaturatedTypeSynonym)