git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Split up ArrayBinder into ArrayBinder and ConsBinder
commit7551a6ed2c2dbde64df6c040804f4ee87c8840e7 authorPhil Freeman <paf31@cantab.net> dateSun 22 Dec 2013, 17:02 (13 years ago) parent5ff260b
8 files changed+82−45
compare with golang
unifiedsplit
examples/passing/Arrays.purs+8−2 libraries/prelude/prelude.purs+7−7 purescript.cabal+1−1 src/Language/PureScript/CodeGen/JS.hs+17−13 src/Language/PureScript/Parser/Values.hs+8−3 src/Language/PureScript/Pretty/Values.hs+31−12 src/Language/PureScript/TypeChecker/Types.hs+8−6 src/Language/PureScript/Values.hs+2−1
examples/passing/Arrays.purs+8−2
@@ -4,11 +4,17 @@ test2 = \arr -> case arr of
44 [x, y] -> x + y
55 [x] -> x
66 [] -> 0
7− [x, y : _] -> x + y
7+ (x : y : _) -> x + y
88
99data Tree = One Number | Some [Tree]
1010
1111test3 = \(tree, sum) -> case tree of
1212 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+
1420
libraries/prelude/prelude.purs+7−7
@@ -44,27 +44,27 @@ bindEither = either (\e -> \_ -> Left e) (\a -> \f -> f a)
4444
4545head :: forall a. [a] -> a
4646head = \xs -> case xs of
47− [x:_] -> x
47+ x : _ -> x
4848
4949headSafe :: forall a. [a] -> Maybe a
5050headSafe = \xs -> case xs of
51− [x:_] -> Just x
51+ x : _ -> Just x
5252 _ -> Nothing
5353
5454tail :: forall a. [a] -> [a]
5555tail = \xs -> case xs of
56− [_:xs] -> xs
56+ _ : xs -> xs
5757
5858tailSafe :: forall a. [a] -> Maybe [a]
5959tailSafe = \xs -> case xs of
60− [_:xs] -> Just xs
60+ _ : xs -> Just xs
6161 _ -> Nothing
6262
6363foreign import map :: forall a b. (a -> b) -> [a] -> [b]
6464
6565foldr :: forall a b. (a -> b -> a) -> a -> [b] -> a
6666foldr = \f -> \a -> \bs -> case bs of
67− [b:bs] -> f (foldr f a bs) b
67+ b : bs -> f (foldr f a bs) b
6868 [] -> a
6969
7070foldl :: forall a b. (a -> b -> b) -> b -> [a] -> b
@@ -130,7 +130,7 @@ range = \lo -> \hi -> {
130130
131131zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
132132zipWith = \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)
134134 _ -> []
135135
136136any :: forall a. (a -> Boolean) -> [a] -> Boolean
@@ -171,7 +171,7 @@ zip = zipWith tuple
171171
172172unzip :: forall a b. [Tuple a b] -> Tuple [a] [b]
173173unzip = \ts -> case ts of
174− [t:ts1] -> case unzip ts1 of
174+ t : ts1 -> case unzip ts1 of
175175 { fst = as, snd = bs } -> tuple (cons t.fst as) (cons t.snd bs)
176176 [] -> tuple [] []
177177
purescript.cabal+1−1
@@ -1,5 +1,5 @@
11name: purescript
2−version: 0.1.18
2+version: 0.1.19
33cabal-version: >=1.8
44build-type: Simple
55license: MIT
src/Language/PureScript/CodeGen/JS.hs+17−13
@@ -128,23 +128,27 @@ binderToJs m e varName done (ObjectBinder bs) = go done bs
128128 done'' <- go done' bs'
129129 js <- binderToJs m e propVar done'' binder
130130 return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)
131−binderToJs m e varName done (ArrayBinder bs rest) = do
132− js <- go done rest 0 bs
133− return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
131+binderToJs m e varName done (ArrayBinder bs) = do
132+ js <- go done 0 bs
133+ return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
134134 where
135− cmp :: BinaryOperator
136− cmp = maybe EqualTo (const GreaterThanOrEqualTo) rest
137− go :: [JS] -> Maybe Binder -> Integer -> [Binder] -> Gen [JS]
138− go done' Nothing _ [] = 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
135+ go :: [JS] -> Integer -> [Binder] -> Gen [JS]
136+ go done' _ [] = return done'
137+ go done' index (binder:bs') = do
144138 elVar <- fresh
145− done'' <- go done' rest' (index + 1) bs'
139+ done'' <- go done' (index + 1) bs'
146140 js <- binderToJs m e elVar done'' binder
147141 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]
148152binderToJs m e varName done (NamedBinder ident binder) = do
149153 js <- binderToJs m e varName done binder
150154 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
229229
230230parseArrayBinder :: P.Parsec String ParseState Binder
231231parseArrayBinder = C.squares $ ArrayBinder <$> (C.commaSep (C.indented *> parseBinder))
232− <*> P.optionMaybe (C.indented *> C.colon *> C.indented *> parseBinder)
233232
234233parseNamedBinder :: P.Parsec String ParseState Binder
235234parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))
@@ -245,8 +244,8 @@ parseIdentifierAndBinder = do
245244 binder <- C.indented *> parseBinder
246245 return (name, binder)
247246
248−parseBinder :: P.Parsec String ParseState Binder
249−parseBinder = P.choice (map P.try
247+parseBinderAtom :: P.Parsec String ParseState Binder
248+parseBinderAtom = P.choice (map P.try
250249 [ parseNullBinder
251250 , parseStringBinder
252251 , parseBooleanBinder
@@ -259,5 +258,11 @@ parseBinder = P.choice (map P.try
259258 , parseArrayBinder
260259 , C.parens parseBinder ]) P.<?> "binder"
261260
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+
262266parseGuardedBinder :: P.Parsec String ParseState Binder
263267parseGuardedBinder = 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 (
143143 , [ binary Or "||" ]
144144 ]
145145
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+
146164prettyPrintBinder :: Binder -> String
147−prettyPrintBinder NullBinder = "_"
148−prettyPrintBinder (StringBinder str) = show str
149−prettyPrintBinder (NumberBinder num) = either show show num
150−prettyPrintBinder (BooleanBinder True) = "true"
151−prettyPrintBinder (BooleanBinder False) = "false"
152−prettyPrintBinder (VarBinder ident) = show ident
153−prettyPrintBinder (NullaryBinder ctor) = show ctor
154−prettyPrintBinder (UnaryBinder ctor b) = show ctor ++ " " ++ prettyPrintBinder b
155−prettyPrintBinder (ObjectBinder bs) = "{ " ++ intercalate ", " (map (uncurry prettyPrintObjectPropertyBinder) bs) ++ " }"
156−prettyPrintBinder (ArrayBinder bs rest) = "[ " ++ intercalate ", " (map prettyPrintBinder bs) ++ maybe "" (("; " ++) . prettyPrintBinder) rest ++ " ]"
157−prettyPrintBinder (NamedBinder ident binder) = show ident ++ "@" ++ prettyPrintBinder binder
158−prettyPrintBinder (GuardedBinder cond binder) = prettyPrintBinder binder ++ " | " ++ prettyPrintValue cond
165+prettyPrintBinder = fromMaybe (error "Incomplete pattern") . pattern matchBinder ()
166+ where
167+ matchBinder :: Pattern () Binder String
168+ matchBinder = buildPrettyPrinter operators (prettyPrintBinderAtom <+> fmap parens matchBinder)
169+ operators :: OperatorTable () Binder String
170+ operators =
171+ OperatorTable [ [ AssocR matchConsBinder (\b1 b2 -> b1 ++ " : " ++ b2) ] ]
172+
173+matchConsBinder :: Pattern () Binder (Binder, Binder)
174+matchConsBinder = mkPattern match'
175+ where
176+ match' (ConsBinder b1 b2) = Just (b1, b2)
177+ match' _ = Nothing
159178
160179prettyPrintObjectPropertyBinder :: String -> Binder -> String
161180prettyPrintObjectPropertyBinder key binder = key ++ ": " ++ prettyPrintBinder binder
src/Language/PureScript/TypeChecker/Types.hs+8−6
@@ -469,15 +469,17 @@ inferBinder val (ObjectBinder props) = do
469469 m1 <- inferBinder propTy binder
470470 m2 <- inferRowProperties nrow (RCons name propTy row) binders
471471 return $ m1 `M.union` m2
472−inferBinder val (ArrayBinder binders rest) = do
472+inferBinder val (ArrayBinder binders) = do
473473 el <- fresh
474474 m1 <- M.unions <$> mapM (inferBinder el) binders
475475 val ~~ Array el
476− case rest of
477− Nothing -> return m1
478− Just binder -> do
479− m2 <- inferBinder val binder
480− return $ m1 `M.union` m2
476+ return m1
477+inferBinder val (ConsBinder headBinder tailBinder) = do
478+ el <- fresh
479+ m1 <- inferBinder el headBinder
480+ m2 <- inferBinder val tailBinder
481+ val ~~ Array el
482+ return $ m1 `M.union` m2
481483inferBinder val (NamedBinder name binder) = do
482484 m <- inferBinder val binder
483485 return $ M.insert name val m
src/Language/PureScript/Values.hs+2−1
@@ -95,6 +95,7 @@ data Binder
9595 | NullaryBinder (Qualified ProperName)
9696 | UnaryBinder (Qualified ProperName) Binder
9797 | ObjectBinder [(String, Binder)]
98− | ArrayBinder [Binder] (Maybe Binder)
98+ | ArrayBinder [Binder]
99+ | ConsBinder Binder Binder
99100 | NamedBinder Ident Binder
100101 | GuardedBinder Value Binder deriving (Show, Data, Typeable)