a70b5dd · rowtype-yoga/purescript-native

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

Allow symbols in data contructors (#2384)

* Allow symbols in data contructors * Accept bindings with data contructors containing symbols * Refactor identifier codegen to use common code * Update data constructor example

commita70b5dd927e360bded78cd66156352b120a955db authorBrandon Hamilton <brandon.hamilton@gmail.com> dateWed 12 Oct 2016, 05:38 (10 years ago) parent427c2a2

6 files changed+63−14

compare with golang

unifiedsplit

examples/passing/DctorName.purs+33 src/Language/PureScript/CodeGen/JS.hs+8−8 src/Language/PureScript/CodeGen/JS/Common.hs+5−2 src/Language/PureScript/Parser/Common.hs+6 src/Language/PureScript/Parser/Declarations.hs+4−4 src/Language/PureScript/Parser/Lexer.hs+7

examples/passing/DctorName.pursnew file+33

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

1+module Main where

3+import Prelude

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

6+newtype Bar' = Bar' Int

8+data Foo' = Foo' Bar'

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_ =

244244 ret <- valueToJs val

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

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

247− return $ JSVariableIntroduction Nothing ctor (Just $

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

248248 JSObjectLiteral Nothing [("create",

249249 JSFunction Nothing Nothing ["value"]

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

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

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

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

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

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

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

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

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

256256 let constructor =

257257 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)

259259 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)

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

262− in return $ iife ctor [ constructor

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

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

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

264264 ]

265265

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

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

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

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

2727--

2828identToJs :: 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

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

3135 | otherwise = concatMap identCharToString name

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

3336

3437-- |

3538-- 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

2828typeName :: TokenParser (ProperName 'TypeName)

2929typeName = ProperName <$> tyname

3030

31+-- |

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

33+--

34+dataConstructorName :: TokenParser (ProperName 'ConstructorName)

35+dataConstructorName = ProperName <$> dconsname

36+

3137-- |

3238-- Parse a module name

3339--

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

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

7171 tyArgs <- many (indented *> kindedIdent)

7272 ctors <- P.option [] $ do

7373 indented *> equals

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

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

7575 return $ DataDeclaration dtype name tyArgs ctors

7676

7777parseTypeDeclaration :: TokenParser Declaration

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

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

361361

362362parseConstructor :: TokenParser Expr

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

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

364364

365365parseCase :: TokenParser Expr

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

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

494494 <|> return id

495495

496496parseNullaryConstructorBinder :: TokenParser Binder

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

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

498498

499499parseConstructorBinder :: TokenParser Binder

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

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

501501

502502parseObjectBinder:: TokenParser Binder

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

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

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

4343 , lname'

4444 , qualifier

4545 , tyname

46+ , dconsname

4647 , uname

4748 , uname'

4849 , mname

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

452453 go (UName s) = Just s

453454 go _ = Nothing

454455

456+dconsname :: TokenParser String

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

458+ where

459+ go (UName s) = Just s

460+ go _ = Nothing

461+

455462mname :: TokenParser String

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

457464 where