d66e332 · rowtype-yoga/purescript-native

PureScript.cabal+11−14

compare with golang

unifiedsplit

@@ -15,19 +15,19 @@ data-dir: ""

15library

16 build-depends: base -any, syb -any, cmdtheline -any,

17 containers -any, mtl -any, parsec -any, utf8-string -any

18− exposed-modules: PureScript

18+ exposed-modules: PureScript PureScript.Declarations PureScript.Names PureScript.TypeChecker.Synonyms

19+ PureScript.CodeGen.Externs PureScript.CodeGen.JS

20+ PureScript.CodeGen.Common.Gen PureScript.CodeGen.Common Main

21+ PureScript.CodeGen PureScript.Kinds PureScript.Parser

22+ PureScript.TypeChecker PureScript.Types PureScript.Values

23+ PureScript.Parser.Common PureScript.Parser.Declarations

24+ PureScript.Parser.Types PureScript.Parser.Values

25+ PureScript.TypeChecker.Kinds PureScript.TypeChecker.Monad

26+ PureScript.TypeChecker.Types

19 exposed: True

27 exposed: True

20 buildable: True

28 buildable: True

21 hs-source-dirs: src

29 hs-source-dirs: src

22− other-modules: PureScript.Names PureScript.TypeChecker.Synonyms

30+ other-modules:

23− PureScript.CodeGen.Externs PureScript.CodeGen.JS

24− PureScript.CodeGen.Common.Gen PureScript.CodeGen.Common Main

25− PureScript.CodeGen PureScript.Kinds PureScript.Parser

26− PureScript.TypeChecker PureScript.Types PureScript.Values

27− PureScript.Parser.Common PureScript.Parser.Declarations

28− PureScript.Parser.Types PureScript.Parser.Values

29− PureScript.TypeChecker.Kinds PureScript.TypeChecker.Monad

30− PureScript.TypeChecker.Types

31

32executable psc

33 build-depends: base -any, cmdtheline -any, containers -any,

@@ -35,7 +35,4 @@ executable psc

35 main-is: Main.hs

36 buildable: True

37 hs-source-dirs: src

38− other-modules: PureScript.Names PureScript.TypeChecker.Synonyms

38+ other-modules:

39− PureScript.CodeGen.Externs PureScript.CodeGen.JS

40− PureScript.CodeGen.Common.Gen PureScript.CodeGen.Common

41−

examples/ReadShow.ps+2−2

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

1−extern read :: forall a. (String) -> a

1+extern read :: forall a. String -> a

2

3−extern show :: forall a. (a) -> String

3+extern show :: forall a. a -> String

4

5test = \x -> show(read(x))

examples/TypeSynonyms.ps+3−3

@@ -1,9 +1,9 @@

1type Lens a b =

2− { get :: (a) -> b

2+ { get :: a -> b

3− ; set :: (a) -> (b) -> b

3+ ; set :: a -> b -> b

4 }

5

6−composeLenses :: forall a b c. (Lens a b) -> (Lens b c) -> Lens a c

6+composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c

7composeLenses = \l1 -> \l2 ->

8 { get: \a -> l2.get(l1.get(a))

9 , set: \a -> \c -> do

src/Main.hs+1−1

@@ -45,7 +45,7 @@ compile inputFiles outputFile externsFile = do

45 Nothing -> U.putStrLn js

46 case externsFile of

47 Nothing -> return ()

48− Just filePath -> U.writeFile filePath $ intercalate "\n" $ map (uncurry externToPs) $ M.toList $ names env

48+ Just filePath -> U.writeFile filePath $ intercalate "\n" $ mapMaybe (externToPs env) decls

49 exitSuccess

50

51inputFiles :: Term [FilePath]

src/PureScript.hs+2

@@ -17,6 +17,7 @@ module PureScript (

17 module PureScript.Types,

18 module PureScript.Kinds,

19 module PureScript.Declarations,

20+ module PureScript.Names,

20 module PureScript.Parser,

21 module PureScript.Parser,

21 module PureScript.CodeGen,

22 module PureScript.CodeGen,

22 module PureScript.TypeChecker

23 module PureScript.TypeChecker

@@ -26,6 +27,7 @@ import PureScript.Values

26import PureScript.Types

27import PureScript.Types

27import PureScript.Kinds

28import PureScript.Kinds

28import PureScript.Declarations

29import PureScript.Declarations

30+import PureScript.Names

29import PureScript.Parser

31import PureScript.Parser

30import PureScript.CodeGen

32import PureScript.CodeGen

31import PureScript.TypeChecker

33import PureScript.TypeChecker

src/PureScript/CodeGen/Common.hs+12−3

@@ -16,6 +16,7 @@

16

17module PureScript.CodeGen.Common where

18

19+import Data.Char

19import Data.Maybe (fromMaybe)

20import Data.Maybe (fromMaybe)

20import Data.List (nub, intersperse, intercalate)

21import Data.List (nub, intersperse, intercalate)

21import Data.Function (fix)

22import Data.Function (fix)

@@ -26,10 +27,18 @@ import Control.Category ((>>>))

26import qualified Control.Arrow as A

27import qualified Control.Arrow as A

27import Control.Arrow ((***))

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

28

29

30+import PureScript.Names

29import PureScript.Values

31import PureScript.Values

30import PureScript.Types

32import PureScript.Types

31import PureScript.Declarations

33import PureScript.Declarations

32

34

35+identToJs :: Ident -> String

36+identToJs (Ident name) = name

37+identToJs (Op op) = concatMap opCharToString op

38+ where

39+ opCharToString :: Char -> String

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

41+

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

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

34

43

35pattern :: Pattern a b -> a -> Maybe b

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

@@ -61,7 +70,7 @@ wrap split f p = fix $ \c -> (split >>> (C.id *** c) >>> A.arr (uncurry f)) <|>

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

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

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

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

63

72

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

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

65

74

66data Operator a r where

75data Operator a r where

67 AssocL :: Pattern a (a, a) -> (r -> r -> r) -> Operator a r

76 AssocL :: Pattern a (a, a) -> (r -> r -> r) -> Operator a r

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

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

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

71

80

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

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

73−buildPrettyPrinter table p = foldl (\p' op ->

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

74 case op of

83 case op of

75 AssocL pat g -> chainl pat g p'

84 AssocL pat g -> chainl pat g p'

76 AssocR pat g -> chainr pat g p'

85 AssocR pat g -> chainr pat g p'

77 Wrap pat g -> wrap pat g p'

86 Wrap pat g -> wrap pat g p'

78 Split pat g -> split pat g p'

87 Split pat g -> split pat g p'

79− ) p $ runOperatorTable table

88+ )) p $ runOperatorTable table

src/PureScript/CodeGen/Externs.hs+14−5

@@ -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 qualified Data.Map as M

24import Control.Applicative

25import Control.Applicative

25

26

26import PureScript.Values

27import PureScript.Values

@@ -30,8 +31,15 @@ import PureScript.Declarations

30import PureScript.TypeChecker.Monad

31import PureScript.TypeChecker.Monad

31import PureScript.CodeGen.Common

32import PureScript.CodeGen.Common

32

33

33−externToPs :: Ident -> (PolyType, NameKind) -> String

34+externToPs :: Environment -> Declaration -> Maybe String

35+externToPs env (ValueDeclaration name _) = do

36+ (ty, _) <- M.lookup name $ names env

37+ return $ "extern " ++ show name ++ " :: " ++ polyTypeToPs ty

38+externToPs env (ExternDeclaration name ty) =

34−externToPs name (ty, _) = "extern " ++ show name ++ " :: " ++ polyTypeToPs ty

39+ return $ "extern " ++ show name ++ " :: " ++ polyTypeToPs ty

40+externToPs env (TypeSynonymDeclaration name args ty) =

41+ return $ "type " ++ name ++ " " ++ intercalate " " args ++ " = " ++ typeToPs ty

42+externToPs _ _ = Nothing

35

43

36typeLiterals :: Pattern Type String

44typeLiterals :: Pattern Type String

37typeLiterals = Pattern $ A.Kleisli match

45typeLiterals = Pattern $ A.Kleisli match

@@ -85,9 +93,10 @@ typeToPs = fromMaybe (error "Incomplete pattern") . pattern matchType

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

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

86 operators :: OperatorTable Type String

94 operators :: OperatorTable Type String

87 operators =

95 operators =

88− OperatorTable $ [ AssocL typeApp $ \f x -> f ++ " " ++ x

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

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

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

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

90− , AssocL singleArgumentFunction $ \arg ret -> arg ++ " -> " ++ ret

99+ ]

91 ]

100 ]

92

101

93polyTypeToPs :: PolyType -> String

102polyTypeToPs :: PolyType -> String

src/PureScript/CodeGen/JS.hs+27−34

@@ -29,13 +29,6 @@ import PureScript.Declarations

29import PureScript.CodeGen.Common

30import PureScript.CodeGen.Common.Gen

31

32−identToJs :: Ident -> String

33−identToJs (Ident name) = name

34−identToJs (Op op) = concatMap opCharToString op

35− where

36− opCharToString :: Char -> String

37− opCharToString = (:) '$'. show . ord

38−

39declToJs :: Declaration -> Maybe String

32declToJs :: Declaration -> Maybe String

40declToJs (ValueDeclaration ident val) = Just $ "var " ++ identToJs ident ++ " = " ++ valueToJs val ++ ";"

33declToJs (ValueDeclaration ident val) = Just $ "var " ++ identToJs ident ++ " = " ++ valueToJs val ++ ";"

41declToJs (DataDeclaration _ _ ctors) =

34declToJs (DataDeclaration _ _ ctors) =

@@ -117,33 +110,33 @@ valueToJs = fromMaybe (error "Incomplete pattern") . pattern matchValue

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

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

118 operators :: OperatorTable Value String

111 operators :: OperatorTable Value String

119 operators =

112 operators =

120− OperatorTable $ [ Wrap accessor $ \prop val -> val ++ "." ++ prop

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

121− , Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]"

114+ , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]

122− , Wrap app $ \args val -> val ++ "(" ++ args ++ ")"

115+ , [ Wrap app $ \args val -> val ++ "(" ++ args ++ ")" ]

123− , Split lam $ \args val -> "function (" ++ intercalate "," args ++ ") { return " ++ valueToJs val ++ "; }"

116+ , [ Split lam $ \args val -> "function (" ++ intercalate "," args ++ ") { return " ++ valueToJs val ++ "; }" ]

124− , binary LessThan "<"

117+ , [ binary LessThan "<" ]

125− , binary LessThanOrEqualTo "<="

118+ , [ binary LessThanOrEqualTo "<=" ]

126− , binary GreaterThan ">"

119+ , [ binary GreaterThan ">" ]

127− , binary GreaterThanOrEqualTo ">="

120+ , [ binary GreaterThanOrEqualTo ">=" ]

128− , unary Not "!"

121+ , [ unary Not "!" ]

129− , unary BitwiseNot "~"

122+ , [ unary BitwiseNot "~" ]

130− , unary Negate "-"

123+ , [ unary Negate "-" ]

131− , binary Multiply "*"

124+ , [ binary Multiply "*" ]

132− , binary Divide "/"

125+ , [ binary Divide "/" ]

133− , binary Modulus "%"

126+ , [ binary Modulus "%" ]

134− , binary Concat "++"

127+ , [ binary Concat "++" ]

135− , binary Add "+"

128+ , [ binary Add "+" ]

136− , binary Subtract "-"

129+ , [ binary Subtract "-" ]

137− , binary ShiftLeft "<<"

130+ , [ binary ShiftLeft "<<" ]

138− , binary ShiftRight ">>"

131+ , [ binary ShiftRight ">>" ]

139− , binary ZeroFillShiftRight ">>>"

132+ , [ binary ZeroFillShiftRight ">>>" ]

140− , binary EqualTo "==="

133+ , [ binary EqualTo "===" ]

141− , binary NotEqualTo "!=="

134+ , [ binary NotEqualTo "!==" ]

142− , binary BitwiseAnd "&"

135+ , [ binary BitwiseAnd "&" ]

143− , binary BitwiseXor "^"

136+ , [ binary BitwiseXor "^" ]

144− , binary BitwiseOr "|"

137+ , [ binary BitwiseOr "|" ]

145− , binary And "&&"

138+ , [ binary And "&&" ]

146− , binary Or "||"

139+ , [ binary Or "||" ]

147 ]

140 ]

148

141

149unaryOperatorString :: UnaryOperator -> String

142unaryOperatorString :: UnaryOperator -> String

src/PureScript/Parser/Common.hs+4−1

@@ -62,7 +62,10 @@ reservedNames = [ "case"

62 , "try"

63 , "typeof"

64 , "void"

65− , "with" ]

65+ , "with"

66+ , "Number"

67+ , "String"

68+ , "Boolean" ]

66

69

67reservedOpNames :: [String]

70reservedOpNames :: [String]

68reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"

71reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"

src/PureScript/Parser/Types.hs+5−5

@@ -26,13 +26,13 @@ import qualified Text.Parsec.Expr as P

26import Control.Arrow (Arrow(..))

27

28parseNumber :: P.Parsec String P.Column Type

29−parseNumber = const Number <$> P.string "Number"

29+parseNumber = const Number <$> reserved "Number"

30

31parseString :: P.Parsec String P.Column Type

32−parseString = const String <$> P.string "String"

32+parseString = const String <$> reserved "String"

33

34parseBoolean :: P.Parsec String P.Column Type

35−parseBoolean = const Boolean <$> P.string "Boolean"

35+parseBoolean = const Boolean <$> reserved "Boolean"

36

37parseArray :: P.Parsec String P.Column Type

38parseArray = squares $ Array <$> parseType

@@ -73,8 +73,8 @@ parseType :: P.Parsec String P.Column Type

73parseType = P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom

74 where

75 postfixTable :: [P.Parsec String P.Column (Type -> Type)]

76− postfixTable = [ flip TypeApp <$> parseTypeAtom ]

76+ postfixTable = [ flip TypeApp <$> (indented *> parseTypeAtom) ]

77− operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocLeft ] ]

77+ operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocRight ] ]

78

79parseNameAndType :: P.Parsec String P.Column (String, Type)

80parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType