git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Lightweight syntax for single argument functions
7b064bdPhil Freeman
examples/Maybe.ps+1
@@ -1,5 +1,6 @@
1data Maybe a = Nothing | Just a
1data Maybe a = Nothing | Just a
2
2
3+maybe :: forall a b. b -> (a -> b) -> Maybe a -> b
3maybe = \b -> \f -> \m -> case m of
4maybe = \b -> \f -> \m -> case m of
4 Nothing -> b
5 Nothing -> b
5 Just a -> f(a)
6 Just a -> f(a)
src/PureScript/CodeGen/Externs.hs+7
@@ -66,6 +66,12 @@ typeApp = Pattern $ A.Kleisli match
66 match (TypeApp f x) = Just (f, x)
66 match (TypeApp f x) = Just (f, x)
67 match _ = Nothing
67 match _ = Nothing
68
68
69+singleArgumentFunction :: Pattern Type (Type, Type)
70+singleArgumentFunction = Pattern $ A.Kleisli match
71+ where
72+ match (Function [arg] ret) = Just (arg, ret)
73+ match _ = Nothing
74+
69function :: Pattern Type ([Type], Type)
75function :: Pattern Type ([Type], Type)
70function = Pattern $ A.Kleisli match
76function = Pattern $ A.Kleisli match
71 where
77 where
@@ -81,6 +87,7 @@ typeToPs = fromMaybe (error "Incomplete pattern") . pattern matchType
81 operators =
87 operators =
82 OperatorTable $ [ AssocL typeApp $ \f x -> f ++ " " ++ x
88 OperatorTable $ [ AssocL typeApp $ \f x -> f ++ " " ++ x
83 , Split function $ \args ret -> "(" ++ intercalate ", " (map typeToPs args) ++ ") -> " ++ typeToPs ret
89 , Split function $ \args ret -> "(" ++ intercalate ", " (map typeToPs args) ++ ") -> " ++ typeToPs ret
90+ , AssocL singleArgumentFunction $ \arg ret -> arg ++ " -> " ++ ret
84 ]
91 ]
85
92
86polyTypeToPs :: PolyType -> String
93polyTypeToPs :: PolyType -> String
src/PureScript/Parser/Types.hs+6−1
@@ -22,6 +22,7 @@ import PureScript.Types
22import PureScript.Parser.Common
22import PureScript.Parser.Common
23import Control.Applicative
23import Control.Applicative
24import qualified Text.Parsec as P
24import qualified Text.Parsec as P
25+import qualified Text.Parsec.Expr as P
25import Control.Arrow (Arrow(..))
26import Control.Arrow (Arrow(..))
26
27
27parseNumber :: P.Parsec String P.Column Type
28parseNumber :: P.Parsec String P.Column Type
@@ -69,7 +70,11 @@ parsePolyType = PolyType <$> (P.option [] (indented *> reserved "forall" *> many
69 <*> parseType
70 <*> parseType
70
71
71parseType :: P.Parsec String P.Column Type
72parseType :: P.Parsec String P.Column Type
72−parseType = fold (lexeme parseTypeAtom) (lexeme parseTypeAtom) TypeApp
73+parseType = P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom
74+ where
75+ postfixTable :: [P.Parsec String P.Column (Type -> Type)]
76+ postfixTable = [ flip TypeApp <$> parseTypeAtom ]
77+ operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocLeft ] ]
73
78
74parseNameAndType :: P.Parsec String P.Column (String, Type)
79parseNameAndType :: P.Parsec String P.Column (String, Type)
75parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
80parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
src/PureScript/TypeChecker/Types.hs+8−1
@@ -83,6 +83,13 @@ findUnknownTypes = everything (++) (mkQ [] f)
83 f (TUnknown n) = [n]
83 f (TUnknown n) = [n]
84 f _ = []
84 f _ = []
85
85
86+findTypeVars :: (Data d) => d -> [String]
87+findTypeVars = everything (++) (mkQ [] f)
88+ where
89+ f :: Type -> [String]
90+ f (TypeVar v) = [v]
91+ f _ = []
92+
86findUnknownRows :: (Data d) => d -> [Int]
93findUnknownRows :: (Data d) => d -> [Int]
87findUnknownRows = everything (++) (mkQ [] f)
94findUnknownRows = everything (++) (mkQ [] f)
88 where
95 where
@@ -95,7 +102,7 @@ varIfUnknown ty =
95 let
102 let
96 (ty', m) = flip runState M.empty $ everywhereM (flip extM g $ mkM f) ty
103 (ty', m) = flip runState M.empty $ everywhereM (flip extM g $ mkM f) ty
97 in
104 in
98− PolyType (sort $ nub $ M.elems m) ty'
105+ PolyType (sort $ nub $ M.elems m ++ findTypeVars ty) ty'
99 where
106 where
100 f :: Type -> State (M.Map Int String) Type
107 f :: Type -> State (M.Map Int String) Type
101 f (TUnknown n) = do
108 f (TUnknown n) = do