Skip to content

Commit b37c730

Browse files
paf31paf31
committed
Remove multiple argument functions, allow type class instances for ->
1 parent 24679fb commit b37c730

File tree

26 files changed

+141
-173
lines changed

26 files changed

+141
-173
lines changed

‎examples/passing/Arrays.purs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,9 +10,9 @@ test2 = \arr -> case arr of
1010

1111
data Tree = One Number | Some [Tree]
1212

13-
test3 = \(tree, sum) -> case tree of
13+
test3 = \tree sum -> case tree of
1414
One n -> n
15-
Some (n1 : n2 : rest) -> test3(n1, sum) * 10 + test3(n2, sum) * 5 + sum(rest)
15+
Some (n1 : n2 : rest) -> test3 n1 sum * 10 + test3 n2 sum * 5 + sum rest
1616

1717
test4 = \arr -> case arr of
1818
[] -> 0

‎examples/passing/ExternRaw.purs‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,6 @@ module ExternRaw where
22

33
foreign import first "function first(xs) { return xs[0]; }" :: forall a. [a] -> a
44

5-
foreign import cond "function cond(b, t, f) { return b ? t : f; }" :: forall a. (Boolean, a, a) -> a
6-
75
foreign import loop "function loop() { while (true) {} }" :: forall a. a
86

97
foreign import concat "function concat(xs) { \

‎examples/passing/Functions.purs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,15 +2,15 @@ module Functions where
22

33
test1 = \ -> 0
44

5-
test2 = \() -> 0
5+
test2 = \_ -> 0
66

7-
test3 = \a (b, c) d -> a + b + c + d
7+
test3 = \a b c d -> a + b + c + d
88

9-
test4 = \(a) -> a
9+
test4 = \a -> a
1010

1111
test5 = \(%%) -> 1 %% 2
1212

13-
test6 = \((+++), (***)) -> 1 +++ 2 *** 3
13+
test6 = \(+++) (***) -> 1 +++ 2 *** 3
1414

1515
module Main where
1616

‎examples/passing/Import.purs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ module M2 where
99

1010
import M1
1111

12-
main = \() -> foo 42
12+
main = \_ -> foo 42
1313

1414
module Main where
1515

‎examples/passing/Operators.purs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -12,11 +12,11 @@ module Operators1 where
1212

1313
module Operators2 where
1414

15-
test1 = \(x, y, z) -> x * y + z(x)(y)
15+
test1 = \x y z -> x * y + z(x)(y)
1616

1717
test2 = (\x -> x.foo false) { foo : \_ -> 1 }
1818

19-
test3 = (\(x, y) -> x)(1 + 2 * (1 + 2), true && (false || false))
19+
test3 = (\x y -> x)(1 + 2 * (1 + 2)) (true && (false || false))
2020

2121
k = \x -> \y -> x
2222

@@ -30,7 +30,7 @@ module Operators2 where
3030

3131
test6 = ((\x -> x) `k` 2) 3
3232

33-
(<>) = \s1 -> \s2 -> s1 ++ s2
33+
(<>) = \s1 s2 -> s1 ++ s2
3434

3535
test7 = "Hello" <> "World!"
3636

@@ -57,7 +57,7 @@ import Global
5757
import Arrays
5858

5959
main = do
60-
print (test1 (1, 2, \x y -> x + y))
60+
print $ test1 1 2 $ \x y -> x + y
6161
print test2
6262
print test3
6363
print test4

‎examples/passing/TopLevelCase.purs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
11
module TopLevelCase where
22

3-
gcd :: (Number, Number) -> Number
4-
gcd (0, x) = x
5-
gcd (x, 0) = x
6-
gcd (x, y) | x > y = gcd (x % y, y)
7-
gcd (x, y) = gcd (y % x, x)
3+
gcd :: Number -> Number -> Number
4+
gcd 0 x = x
5+
gcd x 0 = x
6+
gcd x y | x > y = gcd (x % y) y
7+
gcd x y = gcd (y % x) x
88

99
guardsTest (x:xs) | x > 0 = guardsTest xs
1010
guardsTest xs = xs

‎examples/passing/TypeClasses.purs‎

Lines changed: 12 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -8,24 +8,24 @@ class Show a where
88
instance Show String where
99
show s = s
1010

11-
test1 = \ -> show "testing"
11+
test1 = \_ -> show "testing"
1212

1313
f :: forall a. (TypeClasses.Show a) => a -> String
1414
f x = show x
1515

16-
test2 = \ -> f "testing"
16+
test2 = \_ -> f "testing"
1717

1818
test7 :: forall a. (Show a) => a -> String
1919
test7 = show
2020

21-
test8 = \ -> show $ "testing"
21+
test8 = \_ -> show $ "testing"
2222

2323
data Data a = Data a
2424

2525
instance (TypeClasses.Show a) => TypeClasses.Show (Data a) where
2626
show (Data a) = "Data (" ++ show a ++ ")"
2727

28-
test3 = \ -> show (Data "testing")
28+
test3 = \_ -> show (Data "testing")
2929

3030
class Monad m where
3131
ret :: forall a. a -> m a
@@ -42,10 +42,10 @@ instance TypeClasses.Monad Maybe where
4242
(>>=) Nothing _ = Nothing
4343
(>>=) (Just a) f = f a
4444

45-
test4 :: forall m. (Monad m) => () -> m Number
46-
test4 = \ -> ret 1
45+
test4 :: forall a m. (Monad m) => a -> m Number
46+
test4 = \_ -> ret 1
4747

48-
test5 = \ -> Just 1 >>= \n -> ret (n + 1)
48+
test5 = \_ -> Just 1 >>= \n -> ret (n + 1)
4949

5050
module TypeClasses2 where
5151

@@ -55,7 +55,11 @@ instance (TypeClasses.Show a) => TypeClasses.Show [a] where
5555
show [] = "[]"
5656
show (x:xs) = TypeClasses.show x ++ ", " ++ TypeClasses.show xs
5757

58-
test6 = \ -> show ["testing"]
58+
test6 = \_ -> show ["testing"]
59+
60+
instance TypeClasses.Monad (->) r where
61+
ret a r = a
62+
(>>=) f g r = g (f r) r
5963

6064
module Main where
6165

‎libraries/prelude/prelude.purs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -406,15 +406,15 @@ module Math where
406406
, acos :: Number -> Number
407407
, asin :: Number -> Number
408408
, atan :: Number -> Number
409-
, atan2 :: (Number, Number) -> Number
409+
--, atan2 :: (Number, Number) -> Number
410410
, aceil :: Number -> Number
411411
, cos :: Number -> Number
412412
, exp :: Number -> Number
413413
, floor :: Number -> Number
414414
, log :: Number -> Number
415-
, max :: (Number, Number) -> Number
416-
, pow :: (Number, Number) -> Number
417-
, random :: () -> Number
415+
--, max :: (Number, Number) -> Number
416+
--, pow :: (Number, Number) -> Number
417+
--, random :: () -> Number
418418
, round :: Number -> Number
419419
, sin :: Number -> Number
420420
, sqrt :: Number -> Number

‎psci/Main.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,7 @@ createTemporaryModule imports value =
6464
trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
6565
mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing
6666
(P.Do [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value
67-
, P.DoNotationValue (P.App trace [ P.Var (P.Qualified Nothing (P.Ident "it")) ] )
67+
, P.DoNotationValue (P.App trace (P.Var (P.Qualified Nothing (P.Ident "it"))) )
6868
])
6969
in
7070
P.Module moduleName $ map (importDecl . P.ModuleName) imports ++ [mainDecl]

‎src/Language/PureScript/CodeGen/JS.hs‎

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -110,27 +110,27 @@ valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (va
110110
valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)
111111
valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)
112112
valueToJs opts m e (Indexer index val) = JSIndexer (valueToJs opts m e index) (valueToJs opts m e val)
113-
valueToJs opts m e (App val args) = JSApp (valueToJs opts m e val) (map (valueToJs opts m e) args)
114-
valueToJs opts m e (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs opts m e val)])
115-
valueToJs opts m e (TypedValue _ (Abs args val) ty) | optionsPerformRuntimeTypeChecks opts = JSFunction Nothing args (JSBlock $ runtimeTypeChecks args ty ++ [JSReturn (valueToJs opts m e val)])
113+
valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]
114+
valueToJs opts m e (Abs arg val) = JSFunction Nothing [arg] (JSBlock [JSReturn (valueToJs opts m e val)])
115+
valueToJs opts m e (TypedValue _ (Abs arg val) ty) | optionsPerformRuntimeTypeChecks opts = JSFunction Nothing [arg] (JSBlock $ runtimeTypeChecks arg ty ++ [JSReturn (valueToJs opts m e val)])
116116
valueToJs opts m e (Unary op val) = JSUnary op (valueToJs opts m e val)
117117
valueToJs opts m e (Binary op v1 v2) = JSBinary op (valueToJs opts m e v1) (valueToJs opts m e v2)
118118
valueToJs _ m e (Var ident) = varToJs m e ident
119119
valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
120120
valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
121121
valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
122122

123-
runtimeTypeChecks :: [Ident] -> Type -> [JS]
124-
runtimeTypeChecks args ty =
123+
runtimeTypeChecks :: Ident -> Type -> [JS]
124+
runtimeTypeChecks arg ty =
125125
let
126-
argTys = getFunctionArgumentTypes ty
126+
argTy = getFunctionArgumentType ty
127127
in
128-
concat $ zipWith argumentCheck (map JSVar args) argTys
128+
maybe [] (argumentCheck (JSVar arg)) argTy
129129
where
130-
getFunctionArgumentTypes :: Type -> [Type]
131-
getFunctionArgumentTypes (Function funArgs _) = funArgs
132-
getFunctionArgumentTypes (ForAll _ ty') = getFunctionArgumentTypes ty'
133-
getFunctionArgumentTypes _ = []
130+
getFunctionArgumentType :: Type -> Maybe Type
131+
getFunctionArgumentType (TypeApp (TypeApp Function funArg) _) = Just funArg
132+
getFunctionArgumentType (ForAll _ ty') = getFunctionArgumentType ty'
133+
getFunctionArgumentType _ = Nothing
134134
argumentCheck :: JS -> Type -> [JS]
135135
argumentCheck val Number = [typeCheck val "number"]
136136
argumentCheck val String = [typeCheck val "string"]
@@ -141,7 +141,7 @@ runtimeTypeChecks args ty =
141141
(pairs, _) = rowToList row
142142
in
143143
typeCheck val "object" : concatMap (\(prop, ty') -> argumentCheck (JSAccessor prop val) ty') pairs
144-
argumentCheck val (Function _ _) = [typeCheck val "function"]
144+
argumentCheck val (TypeApp (TypeApp Function _) _) = [typeCheck val "function"]
145145
argumentCheck val (ForAll _ ty') = argumentCheck val ty'
146146
argumentCheck _ _ = []
147147
typeCheck :: JS -> String -> JS
@@ -253,7 +253,7 @@ isOnlyConstructor m e ctor =
253253
numConstructors ty = length $ filter (\(ty1, _) -> ((==) `on` typeConstructor) ty ty1) $ M.elems $ dataConstructors e
254254
typeConstructor (TypeConstructor qual) = qualify m qual
255255
typeConstructor (ForAll _ ty) = typeConstructor ty
256-
typeConstructor (Function _ ty) = typeConstructor ty
256+
typeConstructor (TypeApp (TypeApp Function _) ty) = typeConstructor ty
257257
typeConstructor (TypeApp ty _) = typeConstructor ty
258258
typeConstructor fn = error $ "Invalid arguments to typeConstructor: " ++ show fn
259259

0 commit comments

Comments
 (0)