a70b5dd · rowtype-yoga/purescript-native

examples/passing/DctorName.pursnew file+33

compare with golang

unifiedsplit

@@ -0,0 +1,33 @@

1+module Main where

2+

3+import Prelude

4+import Control.Monad.Eff.Console (log)

5+

6+newtype Bar' = Bar' Int

7+

8+data Foo' = Foo' Bar'

9+

10+data Baz'' = Baz'' | Baz'

11+

12+f ∷ Foo' → Boolean

13+f a = case a of Foo' b → true

14+

15+f' ∷ Boolean

16+f' = f $ Foo' $ Bar' 0

17+

18+g ∷ Baz'' → Int

19+g Baz'' = 0

20+g Baz' = 1

21+

22+g' ∷ Int

23+g' = g Baz''

24+

25+h ∷ Bar' → Int

26+h (Bar' x)

27+ | x <= 10 = x * 2

28+ | otherwise = 10

29+

30+h' ∷ Int

31+h' = h $ Bar' 4

32+

33+main = log "Done"

src/Language/PureScript/CodeGen/JS.hs+8−8

@@ -244,23 +244,23 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

244 ret <- valueToJs val

245 return $ JSApp Nothing (JSFunction Nothing Nothing [] (JSBlock Nothing (ds' ++ [JSReturn Nothing ret]))) []

246 valueToJs' (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =

247− return $ JSVariableIntroduction Nothing ctor (Just $

247+ return $ JSVariableIntroduction Nothing (properToJs ctor) (Just $

248 JSObjectLiteral Nothing [("create",

249 JSFunction Nothing Nothing ["value"]

250 (JSBlock Nothing [JSReturn Nothing $ JSVar Nothing "value"]))])

251 valueToJs' (Constructor _ _ (ProperName ctor) []) =

252− return $ iife ctor [ JSFunction Nothing (Just ctor) [] (JSBlock Nothing [])

252+ return $ iife (properToJs ctor) [ JSFunction Nothing (Just (properToJs ctor)) [] (JSBlock Nothing [])

253− , JSAssignment Nothing (JSAccessor Nothing "value" (JSVar Nothing ctor))

253+ , JSAssignment Nothing (JSAccessor Nothing "value" (JSVar Nothing (properToJs ctor)))

254− (JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing ctor) []) ]

254+ (JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing (properToJs ctor)) []) ]

255 valueToJs' (Constructor _ _ (ProperName ctor) fields) =

256 let constructor =

257 let body = [ JSAssignment Nothing (JSAccessor Nothing (identToJs f) (JSVar Nothing "this")) (var f) | f <- fields ]

258− in JSFunction Nothing (Just ctor) (identToJs `map` fields) (JSBlock Nothing body)

258+ in JSFunction Nothing (Just (properToJs ctor)) (identToJs `map` fields) (JSBlock Nothing body)

259 createFn =

260− let body = JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing ctor) (var `map` fields)

260+ let body = JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing (properToJs ctor)) (var `map` fields)

261 in foldr (\f inner -> JSFunction Nothing Nothing [identToJs f] (JSBlock Nothing [JSReturn Nothing inner])) body fields

262− in return $ iife ctor [ constructor

262+ in return $ iife (properToJs ctor) [ constructor

263− , JSAssignment Nothing (JSAccessor Nothing "create" (JSVar Nothing ctor)) createFn

263+ , JSAssignment Nothing (JSAccessor Nothing "create" (JSVar Nothing (properToJs ctor))) createFn

264 ]

265

266 iife :: String -> [JS] -> JS

src/Language/PureScript/CodeGen/JS/Common.hs+5−2

@@ -26,10 +26,13 @@ moduleNameToJs (ModuleName pns) =

26-- * Symbols are prefixed with '$' followed by a symbol name or their ordinal value.

27--

28identToJs :: Ident -> String

29−identToJs (Ident name)

29+identToJs (Ident name) = properToJs name

30+identToJs (GenIdent _ _) = internalError "GenIdent in identToJs"

31+

32+properToJs :: String -> String

33+properToJs name

30 | nameIsJsReserved name || nameIsJsBuiltIn name = "$$" ++ name

34 | nameIsJsReserved name || nameIsJsBuiltIn name = "$$" ++ name

31 | otherwise = concatMap identCharToString name

35 | otherwise = concatMap identCharToString name

32−identToJs (GenIdent _ _) = internalError "GenIdent in identToJs"

33

36

34-- |

37-- |

35-- Test if a string is a valid JS identifier without escaping.

38-- Test if a string is a valid JS identifier without escaping.

src/Language/PureScript/Parser/Common.hs+6

@@ -28,6 +28,12 @@ properName = ProperName <$> uname

28typeName :: TokenParser (ProperName 'TypeName)

29typeName = ProperName <$> tyname

30

31+-- |

32+-- Parse a proper name for a data constructor.

33+--

34+dataConstructorName :: TokenParser (ProperName 'ConstructorName)

35+dataConstructorName = ProperName <$> dconsname

36+

31-- |

37-- |

32-- Parse a module name

38-- Parse a module name

33--

39--

src/Language/PureScript/Parser/Declarations.hs+4−4

@@ -71,7 +71,7 @@ parseDataDeclaration = do

71 tyArgs <- many (indented *> kindedIdent)

72 ctors <- P.option [] $ do

73 indented *> equals

74− P.sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe

74+ P.sepBy1 ((,) <$> dataConstructorName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe

75 return $ DataDeclaration dtype name tyArgs ctors

76

77parseTypeDeclaration :: TokenParser Declaration

@@ -360,7 +360,7 @@ parseVar :: TokenParser Expr

360parseVar = Var <$> C.parseQualified C.parseIdent

361

362parseConstructor :: TokenParser Expr

363−parseConstructor = Constructor <$> C.parseQualified C.properName

363+parseConstructor = Constructor <$> C.parseQualified C.dataConstructorName

364

365parseCase :: TokenParser Expr

366parseCase = Case <$> P.between (reserved "case") (C.indented *> reserved "of") (commaSep1 parseValue)

@@ -494,10 +494,10 @@ parseNumberLiteral = LiteralBinder . NumericLiteral <$> (sign <*> number)

494 <|> return id

495

496parseNullaryConstructorBinder :: TokenParser Binder

497−parseNullaryConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> pure []

497+parseNullaryConstructorBinder = ConstructorBinder <$> C.parseQualified C.dataConstructorName <*> pure []

498

499parseConstructorBinder :: TokenParser Binder

500−parseConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> many (C.indented *> parseBinderNoParens)

500+parseConstructorBinder = ConstructorBinder <$> C.parseQualified C.dataConstructorName <*> many (C.indented *> parseBinderNoParens)

501

502parseObjectBinder:: TokenParser Binder

503parseObjectBinder = LiteralBinder <$> parseObjectLiteral (C.indented *> parseIdentifierAndBinder)

src/Language/PureScript/Parser/Lexer.hs+7

@@ -43,6 +43,7 @@ module Language.PureScript.Parser.Lexer

43 , lname'

44 , qualifier

45 , tyname

46+ , dconsname

46 , uname

47 , uname

47 , uname'

48 , uname'

48 , mname

49 , mname

@@ -452,6 +453,12 @@ tyname = token go P.<?> "type name"

452 go (UName s) = Just s

453 go (UName s) = Just s

453 go _ = Nothing

454 go _ = Nothing

454

455

456+dconsname :: TokenParser String

457+dconsname = token go P.<?> "data constructor name"

458+ where

459+ go (UName s) = Just s

460+ go _ = Nothing

461+

455mname :: TokenParser String

462mname :: TokenParser String

456mname = token go P.<?> "module name"

463mname = token go P.<?> "module name"

457 where

464 where