git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Lightweight syntax for single argument functions
commit7b064bd0d9885f447d628851e7b869ed8e0f2d8e authorPhil Freeman <paf31@cantab.net> dateMon 21 Oct 2013, 09:31 (13 years ago) parent117ee03
4 files changed+22−2
examples/Maybe.ps+1 src/PureScript/CodeGen/Externs.hs+7 src/PureScript/Parser/Types.hs+6−1 src/PureScript/TypeChecker/Types.hs+8−1
examples/Maybe.ps+1
@@ -1,5 +1,6 @@
11data Maybe a = Nothing | Just a
22
3+maybe :: forall a b. b -> (a -> b) -> Maybe a -> b
34maybe = \b -> \f -> \m -> case m of
45 Nothing -> b
56 Just a -> f(a)
src/PureScript/CodeGen/Externs.hs+7
@@ -66,6 +66,12 @@ typeApp = Pattern $ A.Kleisli match
6666 match (TypeApp f x) = Just (f, x)
6767 match _ = Nothing
6868
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+
6975function :: Pattern Type ([Type], Type)
7076function = Pattern $ A.Kleisli match
7177 where
@@ -81,6 +87,7 @@ typeToPs = fromMaybe (error "Incomplete pattern") . pattern matchType
8187 operators =
8288 OperatorTable $ [ AssocL typeApp $ \f x -> f ++ " " ++ x
8389 , Split function $ \args ret -> "(" ++ intercalate ", " (map typeToPs args) ++ ") -> " ++ typeToPs ret
90+ , AssocL singleArgumentFunction $ \arg ret -> arg ++ " -> " ++ ret
8491 ]
8592
8693polyTypeToPs :: PolyType -> String
src/PureScript/Parser/Types.hs+6−1
@@ -22,6 +22,7 @@ import PureScript.Types
2222import PureScript.Parser.Common
2323import Control.Applicative
2424import qualified Text.Parsec as P
25+import qualified Text.Parsec.Expr as P
2526import Control.Arrow (Arrow(..))
2627
2728parseNumber :: P.Parsec String P.Column Type
@@ -69,7 +70,11 @@ parsePolyType = PolyType <$> (P.option [] (indented *> reserved "forall" *> many
6970 <*> parseType
7071
7172parseType :: 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 ] ]
7378
7479parseNameAndType :: P.Parsec String P.Column (String, Type)
7580parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
src/PureScript/TypeChecker/Types.hs+8−1
@@ -83,6 +83,13 @@ findUnknownTypes = everything (++) (mkQ [] f)
8383 f (TUnknown n) = [n]
8484 f _ = []
8585
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+
8693findUnknownRows :: (Data d) => d -> [Int]
8794findUnknownRows = everything (++) (mkQ [] f)
8895 where
@@ -95,7 +102,7 @@ varIfUnknown ty =
95102 let
96103 (ty', m) = flip runState M.empty $ everywhereM (flip extM g $ mkM f) ty
97104 in
98− PolyType (sort $ nub $ M.elems m) ty'
105+ PolyType (sort $ nub $ M.elems m ++ findTypeVars ty) ty'
99106 where
100107 f :: Type -> State (M.Map Int String) Type
101108 f (TUnknown n) = do