0f7185b · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Use ArrowPlus instead of Alternative, get rid of strange Alternative instance. S and iota combinator examples. Fix non-terminating pretty-printer issue

0f7185bPhil Freeman13 years ago

examples/iota.psnew file+5

compare with golang

unifiedsplit

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

1+s = \x -> \y -> \z -> x z (y z)

3+k = \x -> \y -> x

5+iota = \x -> x s k

examples/s.psnew file+1

@@ -0,0 +1 @@

1+s = \x, y, z -> x z (y z)

src/PureScript/CodeGen/Common.hs+11−19

@@ -25,7 +25,7 @@ import Control.Applicative (Applicative(..), Alternative(..))

25import qualified Control.Category as C

26import Control.Category ((>>>))

27import qualified Control.Arrow as A

28−import Control.Arrow ((***))

28+import Control.Arrow ((***), (<+>))

30import PureScript.Names

31import PureScript.Values

@@ -39,36 +39,28 @@ identToJs (Op op) = concatMap opCharToString op

39 opCharToString :: Char -> String

40 opCharToString = (:) '$'. show . ord

42−newtype Pattern a b = Pattern { runPattern :: A.Kleisli Maybe a b } deriving (C.Category, A.Arrow)

42+newtype Pattern a b = Pattern { runPattern :: A.Kleisli Maybe a b } deriving (C.Category, A.Arrow, A.ArrowZero, A.ArrowPlus)

43−

44−pattern :: Pattern a b -> a -> Maybe b

45−pattern = A.runKleisli . runPattern

47instance Functor (Pattern a) where

44instance Functor (Pattern a) where

48− fmap f p = Pattern $ A.Kleisli $ fmap f . pattern p

45+ fmap f (Pattern p) = Pattern $ A.Kleisli $ fmap f . A.runKleisli p

50−instance Applicative (Pattern a) where

47+pattern :: Pattern a b -> a -> Maybe b

51− pure = Pattern . A.Kleisli . const . pure

48+pattern = A.runKleisli . runPattern

52− f <*> x = Pattern . A.Kleisli $ \a -> pattern f a <*> pattern x a

53−

54−instance Alternative (Pattern a) where

55− empty = Pattern $ A.Kleisli $ \a -> empty

56− (Pattern (A.Kleisli p)) <|> (Pattern (A.Kleisli q)) = Pattern $ A.Kleisli $ \a -> p a <|> q a

58parens :: String -> String

50parens :: String -> String

59parens s = ('(':s) ++ ")"

51parens s = ('(':s) ++ ")"

61chainl :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r

53chainl :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r

62−chainl split f p = fix $ \c -> (split >>> (c *** p) >>> A.arr (uncurry f)) <|> p

54+chainl split f p = fix $ \c -> (split >>> ((c <+> p) *** p) >>> A.arr (uncurry f))

64chainr :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r

56chainr :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r

65−chainr split f p = fix $ \c -> (split >>> (p *** c) >>> A.arr (uncurry f)) <|> p

57+chainr split f p = fix $ \c -> (split >>> (p *** (c <+> p)) >>> A.arr (uncurry f))

67wrap :: Pattern a (s, a) -> (s -> r -> r) -> Pattern a r -> Pattern a r

59wrap :: Pattern a (s, a) -> (s -> r -> r) -> Pattern a r -> Pattern a r

68−wrap split f p = fix $ \c -> (split >>> (C.id *** c) >>> A.arr (uncurry f)) <|> p

60+wrap split f p = fix $ \c -> (split >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f))

70split :: Pattern a (s, t) -> (s -> t -> r) -> Pattern a r -> Pattern a r

62split :: Pattern a (s, t) -> (s -> t -> r) -> Pattern a r -> Pattern a r

71−split s f p = (s >>> A.arr (uncurry f)) <|> p

63+split s f p = (s >>> A.arr (uncurry f))

73data OperatorTable a r = OperatorTable { runOperatorTable :: [ [Operator a r] ] }

65data OperatorTable a r = OperatorTable { runOperatorTable :: [ [Operator a r] ] }

@@ -79,10 +71,10 @@ data Operator a r where

79 Split :: Pattern a (s, t) -> (s -> t -> r) -> Operator a r

71 Split :: Pattern a (s, t) -> (s -> t -> r) -> Operator a r

81buildPrettyPrinter :: OperatorTable a r -> Pattern a r -> Pattern a r

73buildPrettyPrinter :: OperatorTable a r -> Pattern a r -> Pattern a r

82−buildPrettyPrinter table p = foldl (\p' ops -> foldl1 (<|>) (flip map ops $ \op ->

74+buildPrettyPrinter table p = foldl (\p' ops -> foldl1 (<+>) (flip map ops $ \op ->

83 case op of

75 case op of

84 AssocL pat g -> chainl pat g p'

76 AssocL pat g -> chainl pat g p'

85 AssocR pat g -> chainr pat g p'

77 AssocR pat g -> chainr pat g p'

86 Wrap pat g -> wrap pat g p'

78 Wrap pat g -> wrap pat g p'

87 Split pat g -> split pat g p'

79 Split pat g -> split pat g p'

88− )) p $ runOperatorTable table

80+ ) <+> p') p $ runOperatorTable table

src/PureScript/CodeGen/Externs.hs+3−2

@@ -21,6 +21,7 @@ module PureScript.CodeGen.Externs (

21import Data.Maybe (fromMaybe)

22import Data.List (intersperse, intercalate)

23import qualified Control.Arrow as A

24+import Control.Arrow ((<+>))

24import qualified Data.Map as M

25import qualified Data.Map as M

25import Control.Applicative

26import Control.Applicative

@@ -90,12 +91,12 @@ typeToPs :: Type -> String

90typeToPs = fromMaybe (error "Incomplete pattern") . pattern matchType

91typeToPs = fromMaybe (error "Incomplete pattern") . pattern matchType

91 where

92 where

92 matchType :: Pattern Type String

93 matchType :: Pattern Type String

93− matchType = buildPrettyPrinter operators (typeLiterals <|> fmap parens matchType)

94+ matchType = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchType)

94 operators :: OperatorTable Type String

95 operators :: OperatorTable Type String

95 operators =

96 operators =

96 OperatorTable $ [ [ AssocL typeApp $ \f x -> f ++ " " ++ x ]

97 OperatorTable $ [ [ AssocL typeApp $ \f x -> f ++ " " ++ x ]

97 , [ AssocR singleArgumentFunction $ \arg ret -> arg ++ " -> " ++ ret

98 , [ AssocR singleArgumentFunction $ \arg ret -> arg ++ " -> " ++ ret

98− , Split function $ \args ret -> "(" ++ intercalate ", " (map typeToPs args) ++ ") -> " ++ typeToPs ret

99+ , Wrap function $ \args ret -> "(" ++ intercalate ", " (map typeToPs args) ++ ") -> " ++ ret

99 ]

100 ]

101 ]

101

102

src/PureScript/CodeGen/JS.hs+2−1

@@ -20,6 +20,7 @@ import Data.Char

20import Data.Maybe (fromMaybe)

21import Data.List (intercalate)

22import qualified Control.Arrow as A

23+import Control.Arrow ((<+>))

23import Control.Applicative

24import Control.Applicative

25import PureScript.Types

26import PureScript.Types

@@ -107,7 +108,7 @@ valueToJs :: Value -> String

107valueToJs = fromMaybe (error "Incomplete pattern") . pattern matchValue

108valueToJs = fromMaybe (error "Incomplete pattern") . pattern matchValue

108 where

109 where

109 matchValue :: Pattern Value String

110 matchValue :: Pattern Value String

110− matchValue = buildPrettyPrinter operators (literals <|> fmap parens matchValue)

111+ matchValue = buildPrettyPrinter operators (literals <+> fmap parens matchValue)

111 operators :: OperatorTable Value String

112 operators :: OperatorTable Value String

112 operators =

113 operators =

113 OperatorTable $ [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]

114 OperatorTable $ [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]