7551a6e · rowtype-yoga/purescript-native

examples/passing/Arrays.purs+8−2

compare with golang

unifiedsplit

@@ -4,11 +4,17 @@ test2 = \arr -> case arr of

4 [x, y] -> x + y

5 [x] -> x

6 [] -> 0

7− [x, y : _] -> x + y

7+ (x : y : _) -> x + y

8

9data Tree = One Number | Some [Tree]

10

11test3 = \(tree, sum) -> case tree of

12 One n -> n

13− Some [n1, n2 : rest] -> test3(n1, sum) * 10 + test3(n2, sum) * 5 + sum(rest)

13+ Some (n1 : n2 : rest) -> test3(n1, sum) * 10 + test3(n2, sum) * 5 + sum(rest)

14+

15+test4 = \arr -> case arr of

16+ [] -> 0

17+ [_] -> 0

18+ x : y : xs -> x * y + test4 xs

19+

14

20

libraries/prelude/prelude.purs+7−7

@@ -44,27 +44,27 @@ bindEither = either (\e -> \_ -> Left e) (\a -> \f -> f a)

44

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

46head = \xs -> case xs of

47− [x:_] -> x

47+ x : _ -> x

48

49headSafe :: forall a. [a] -> Maybe a

50headSafe = \xs -> case xs of

51− [x:_] -> Just x

51+ x : _ -> Just x

52 _ -> Nothing

53

54tail :: forall a. [a] -> [a]

55tail = \xs -> case xs of

56− [_:xs] -> xs

56+ _ : xs -> xs

57

58tailSafe :: forall a. [a] -> Maybe [a]

59tailSafe = \xs -> case xs of

60− [_:xs] -> Just xs

60+ _ : xs -> Just xs

61 _ -> Nothing

62

63foreign import map :: forall a b. (a -> b) -> [a] -> [b]

64

65foldr :: forall a b. (a -> b -> a) -> a -> [b] -> a

66foldr = \f -> \a -> \bs -> case bs of

67− [b:bs] -> f (foldr f a bs) b

67+ b : bs -> f (foldr f a bs) b

68 [] -> a

69

70foldl :: forall a b. (a -> b -> b) -> b -> [a] -> b

@@ -130,7 +130,7 @@ range = \lo -> \hi -> {

130

131zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]

132zipWith = \f -> \as -> \bs -> case { as: as, bs: bs } of

133− { as = [a:as1], bs = [b:bs1] } -> cons (f a b) (zipWith f as1 bs1)

133+ { as = a : as1, bs = b : bs1 } -> cons (f a b) (zipWith f as1 bs1)

134 _ -> []

135

136any :: forall a. (a -> Boolean) -> [a] -> Boolean

@@ -171,7 +171,7 @@ zip = zipWith tuple

171

172unzip :: forall a b. [Tuple a b] -> Tuple [a] [b]

173unzip = \ts -> case ts of

174− [t:ts1] -> case unzip ts1 of

174+ t : ts1 -> case unzip ts1 of

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

176 [] -> tuple [] []

177

purescript.cabal+1−1

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

1name: purescript

2−version: 0.1.18

2+version: 0.1.19

3cabal-version: >=1.8

4build-type: Simple

5license: MIT

src/Language/PureScript/CodeGen/JS.hs+17−13

@@ -128,23 +128,27 @@ binderToJs m e varName done (ObjectBinder bs) = go done bs

128 done'' <- go done' bs'

129 js <- binderToJs m e propVar done'' binder

130 return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)

131−binderToJs m e varName done (ArrayBinder bs rest) = do

131+binderToJs m e varName done (ArrayBinder bs) = do

132− js <- go done rest 0 bs

132+ js <- go done 0 bs

133− return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]

133+ return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]

134 where

135− cmp :: BinaryOperator

136− cmp = maybe EqualTo (const GreaterThanOrEqualTo) rest

137− go :: [JS] -> Maybe Binder -> Integer -> [Binder] -> Gen [JS]

135+ go :: [JS] -> Integer -> [Binder] -> Gen [JS]

138− go done' Nothing _ [] = return done'

136+ go done' _ [] = return done'

139− go done' (Just binder) index [] = do

140− restVar <- fresh

141− js <- binderToJs m e restVar done' binder

142− return (JSVariableIntroduction (Ident restVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left index)])) : js)

143− go done' rest' index (binder:bs') = do

137+ go done' index (binder:bs') = do

144 elVar <- fresh

138 elVar <- fresh

145− done'' <- go done' rest' (index + 1) bs'

139+ done'' <- go done' (index + 1) bs'

146 js <- binderToJs m e elVar done'' binder

140 js <- binderToJs m e elVar done'' binder

147 return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)

141 return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)

142+binderToJs m e varName done (ConsBinder headBinder tailBinder) = do

143+ headVar <- fresh

144+ tailVar <- fresh

145+ js1 <- binderToJs m e headVar done headBinder

146+ js2 <- binderToJs m e tailVar js1 tailBinder

147+ return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left 0))) (JSBlock

148+ ( JSVariableIntroduction (Ident headVar) (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar (Ident varName)))) :

149+ JSVariableIntroduction (Ident tailVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left 1)])) :

150+ js2

151+ )) Nothing]

148binderToJs m e varName done (NamedBinder ident binder) = do

152binderToJs m e varName done (NamedBinder ident binder) = do

149 js <- binderToJs m e varName done binder

153 js <- binderToJs m e varName done binder

150 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : js)

154 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : js)

src/Language/PureScript/Parser/Values.hs+8−3

@@ -229,7 +229,6 @@ parseObjectBinder = ObjectBinder <$> C.braces (C.commaSep (C.indented *> parseId

229

230parseArrayBinder :: P.Parsec String ParseState Binder

231parseArrayBinder = C.squares $ ArrayBinder <$> (C.commaSep (C.indented *> parseBinder))

232− <*> P.optionMaybe (C.indented *> C.colon *> C.indented *> parseBinder)

233

232

234parseNamedBinder :: P.Parsec String ParseState Binder

233parseNamedBinder :: P.Parsec String ParseState Binder

235parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))

234parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))

@@ -245,8 +244,8 @@ parseIdentifierAndBinder = do

245 binder <- C.indented *> parseBinder

244 binder <- C.indented *> parseBinder

246 return (name, binder)

245 return (name, binder)

247

246

248−parseBinder :: P.Parsec String ParseState Binder

247+parseBinderAtom :: P.Parsec String ParseState Binder

249−parseBinder = P.choice (map P.try

248+parseBinderAtom = P.choice (map P.try

250 [ parseNullBinder

249 [ parseNullBinder

251 , parseStringBinder

250 , parseStringBinder

252 , parseBooleanBinder

251 , parseBooleanBinder

@@ -259,5 +258,11 @@ parseBinder = P.choice (map P.try

259 , parseArrayBinder

258 , parseArrayBinder

260 , C.parens parseBinder ]) P.<?> "binder"

259 , C.parens parseBinder ]) P.<?> "binder"

261

260

261+parseBinder :: P.Parsec String ParseState Binder

262+parseBinder = (buildExpressionParser operators parseBinderAtom) P.<?> "expression"

263+ where

264+ operators = [ [ Infix ( C.lexeme (P.try $ C.indented *> C.reservedOp ":") >> return ConsBinder) AssocRight ] ]

265+

262parseGuardedBinder :: P.Parsec String ParseState Binder

266parseGuardedBinder :: P.Parsec String ParseState Binder

263parseGuardedBinder = flip ($) <$> parseBinder <*> P.option id (GuardedBinder <$> (C.indented *> C.lexeme (P.char '|') *> C.indented *> parseValue))

267parseGuardedBinder = flip ($) <$> parseBinder <*> P.option id (GuardedBinder <$> (C.indented *> C.lexeme (P.char '|') *> C.indented *> parseValue))

268+

src/Language/PureScript/Pretty/Values.hs+31−12

@@ -143,19 +143,38 @@ prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue (

143 , [ binary Or "||" ]

144 ]

145

146+prettyPrintBinderAtom :: Pattern () Binder String

147+prettyPrintBinderAtom = mkPattern match

148+ where

149+ match :: Binder -> Maybe String

150+ match NullBinder = Just "_"

151+ match (StringBinder str) = Just $ show str

152+ match (NumberBinder num) = Just $ either show show num

153+ match (BooleanBinder True) = Just "true"

154+ match (BooleanBinder False) = Just "false"

155+ match (VarBinder ident) = Just $ show ident

156+ match (NullaryBinder ctor) = Just $ show ctor

157+ match (UnaryBinder ctor b) = Just $ show ctor ++ " " ++ prettyPrintBinder b

158+ match (ObjectBinder bs) = Just $ "{ " ++ intercalate ", " (map (uncurry prettyPrintObjectPropertyBinder) bs) ++ " }"

159+ match (ArrayBinder bs) = Just $ "[ " ++ intercalate ", " (map prettyPrintBinder bs) ++ " ]"

160+ match (NamedBinder ident binder) = Just $ show ident ++ "@" ++ prettyPrintBinder binder

161+ match (GuardedBinder cond binder) = Just $ prettyPrintBinder binder ++ " | " ++ prettyPrintValue cond

162+ match _ = Nothing

163+

146prettyPrintBinder :: Binder -> String

164prettyPrintBinder :: Binder -> String

147−prettyPrintBinder NullBinder = "_"

165+prettyPrintBinder = fromMaybe (error "Incomplete pattern") . pattern matchBinder ()

148−prettyPrintBinder (StringBinder str) = show str

166+ where

149−prettyPrintBinder (NumberBinder num) = either show show num

167+ matchBinder :: Pattern () Binder String

150−prettyPrintBinder (BooleanBinder True) = "true"

168+ matchBinder = buildPrettyPrinter operators (prettyPrintBinderAtom <+> fmap parens matchBinder)

151−prettyPrintBinder (BooleanBinder False) = "false"

169+ operators :: OperatorTable () Binder String

152−prettyPrintBinder (VarBinder ident) = show ident

170+ operators =

153−prettyPrintBinder (NullaryBinder ctor) = show ctor

171+ OperatorTable [ [ AssocR matchConsBinder (\b1 b2 -> b1 ++ " : " ++ b2) ] ]

154−prettyPrintBinder (UnaryBinder ctor b) = show ctor ++ " " ++ prettyPrintBinder b

172+

155−prettyPrintBinder (ObjectBinder bs) = "{ " ++ intercalate ", " (map (uncurry prettyPrintObjectPropertyBinder) bs) ++ " }"

173+matchConsBinder :: Pattern () Binder (Binder, Binder)

156−prettyPrintBinder (ArrayBinder bs rest) = "[ " ++ intercalate ", " (map prettyPrintBinder bs) ++ maybe "" (("; " ++) . prettyPrintBinder) rest ++ " ]"

174+matchConsBinder = mkPattern match'

157−prettyPrintBinder (NamedBinder ident binder) = show ident ++ "@" ++ prettyPrintBinder binder

175+ where

158−prettyPrintBinder (GuardedBinder cond binder) = prettyPrintBinder binder ++ " | " ++ prettyPrintValue cond

176+ match' (ConsBinder b1 b2) = Just (b1, b2)

177+ match' _ = Nothing

159

178

160prettyPrintObjectPropertyBinder :: String -> Binder -> String

179prettyPrintObjectPropertyBinder :: String -> Binder -> String

161prettyPrintObjectPropertyBinder key binder = key ++ ": " ++ prettyPrintBinder binder

180prettyPrintObjectPropertyBinder key binder = key ++ ": " ++ prettyPrintBinder binder

src/Language/PureScript/TypeChecker/Types.hs+8−6

@@ -469,15 +469,17 @@ inferBinder val (ObjectBinder props) = do

469 m1 <- inferBinder propTy binder

470 m2 <- inferRowProperties nrow (RCons name propTy row) binders

471 return $ m1 `M.union` m2

472−inferBinder val (ArrayBinder binders rest) = do

472+inferBinder val (ArrayBinder binders) = do

473 el <- fresh

474 m1 <- M.unions <$> mapM (inferBinder el) binders

475 val ~~ Array el

476− case rest of

476+ return m1

477− Nothing -> return m1

477+inferBinder val (ConsBinder headBinder tailBinder) = do

478− Just binder -> do

478+ el <- fresh

479+ m1 <- inferBinder el headBinder

479− m2 <- inferBinder val binder

480+ m2 <- inferBinder val tailBinder

481+ val ~~ Array el

480− return $ m1 `M.union` m2

482+ return $ m1 `M.union` m2

481inferBinder val (NamedBinder name binder) = do

483inferBinder val (NamedBinder name binder) = do

482 m <- inferBinder val binder

484 m <- inferBinder val binder

483 return $ M.insert name val m

485 return $ M.insert name val m

src/Language/PureScript/Values.hs+2−1

@@ -95,6 +95,7 @@ data Binder

95 | NullaryBinder (Qualified ProperName)

96 | UnaryBinder (Qualified ProperName) Binder

97 | ObjectBinder [(String, Binder)]

98− | ArrayBinder [Binder] (Maybe Binder)

98+ | ArrayBinder [Binder]

99+ | ConsBinder Binder Binder

99 | NamedBinder Ident Binder

100 | NamedBinder Ident Binder

100 | GuardedBinder Value Binder deriving (Show, Data, Typeable)

101 | GuardedBinder Value Binder deriving (Show, Data, Typeable)