0b890e7 · rowtype-yoga/purescript-native

RELEASE-0.5.md+1

compare with golang

unifiedsplit

@@ -52,6 +52,7 @@

52- Type errors have been simplified, the full trace can be enabled with `--verbose-errors` or `-v` (paf31)

53- Error messages now display source positions (paf31, garyb)

54- The type classes implementation and code generation was greatly simplified. (paf31)

55+- Object properties and row labels can now be accessed with arbitrary string names by using string literals. (paf31)

55

56

56### Bug Fixes

57### Bug Fixes

57

58

examples/passing/Objects.purs+12

@@ -14,5 +14,17 @@ module Main where

14

15 typed :: { foo :: Number }

16 typed = { foo: 0 }

17+

18+ test2 = \x -> x."!@#"

19+

20+ test3 = typed."foo"

21+

22+ test4 = test2 weirdObj

23+ where

24+ weirdObj :: { "!@#" :: Number }

25+ weirdObj = { "!@#": 1 }

26+

27+ test5 = case { "***": 1 } of

28+ { "***" = n } -> n

17

29

18 main = Debug.Trace.trace "Done"

30 main = Debug.Trace.trace "Done"

purescript.cabal+1−1

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

1name: purescript

2−version: 0.4.15.1

2+version: 0.4.16

3cabal-version: >=1.8

4build-type: Custom

5license: MIT

src/Language/PureScript/CodeGen/Common.hs+7−1

@@ -32,7 +32,6 @@ identToJs :: Ident -> String

32identToJs (Ident name) | nameIsJsReserved name = "$$" ++ name

33identToJs (Ident name) = concatMap identCharToString name

34identToJs (Op op) = concatMap identCharToString op

35−identToJs (Escaped name) = name

36

35

37-- |

36-- |

38-- Attempts to find a human-readable name for a symbol, if none has been specified returns the

37-- Attempts to find a human-readable name for a symbol, if none has been specified returns the

@@ -130,5 +129,12 @@ nameIsJsReserved name =

130 , "with"

129 , "with"

131 , "yield" ]

130 , "yield" ]

132

131

132+-- |

133+-- Test if a string is a valid JS identifier (may return false negatives)

134+--

135+isIdent :: String -> Bool

136+isIdent s@(first : rest) | not (nameIsJsReserved s) && isAlpha first && all isAlphaNum rest = True

137+isIdent _ = False

138+

133moduleNameToJs :: ModuleName -> String

139moduleNameToJs :: ModuleName -> String

134moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)

140moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)

src/Language/PureScript/CodeGen/JS.hs+11−7

@@ -19,7 +19,8 @@ module Language.PureScript.CodeGen.JS (

19 module AST,

20 declToJs,

21 moduleToJs,

22− wrapExportsContainer

22+ wrapExportsContainer,

23+ isIdent

23) where

24) where

24

25

25import Data.Maybe (fromMaybe, mapMaybe)

26import Data.Maybe (fromMaybe, mapMaybe)

@@ -90,7 +91,7 @@ declToJs _ _ _ _ = Nothing

90-- module.

91-- module.

91--

92--

92exportToJs :: DeclarationRef -> [JS]

93exportToJs :: DeclarationRef -> [JS]

93−exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Escaped . runProperName)

94+exportToJs (TypeRef _ (Just dctors)) = flip map dctors (export . Ident . runProperName)

94exportToJs (ValueRef name) = [export name]

95exportToJs (ValueRef name) = [export name]

95exportToJs (TypeInstanceRef name) = [export name]

96exportToJs (TypeInstanceRef name) = [export name]

96exportToJs _ = []

97exportToJs _ = []

@@ -115,9 +116,12 @@ var = JSVar . identToJs

115-- indexer is returned.

116-- indexer is returned.

116--

117--

117accessor :: Ident -> JS -> JS

118accessor :: Ident -> JS -> JS

118−accessor (Ident name) | nameIsJsReserved name = JSIndexer (JSStringLiteral name)

119+accessor (Ident prop) = accessorString prop

119accessor (Op op) = JSIndexer (JSStringLiteral op)

120accessor (Op op) = JSIndexer (JSStringLiteral op)

120−accessor ident = JSAccessor (identToJs ident)

121+

122+accessorString :: String -> JS -> JS

123+accessorString prop | isIdent prop = JSAccessor prop

124+ | otherwise = JSIndexer (JSStringLiteral prop)

121

125

122-- |

126-- |

123-- Generate code in the simplified Javascript intermediate representation for a value or expression.

127-- Generate code in the simplified Javascript intermediate representation for a value or expression.

@@ -132,7 +136,7 @@ valueToJs opts m e (ObjectUpdate o ps) = extendObj (valueToJs opts m e o) (map (

132valueToJs _ m _ (Constructor name) = qualifiedToJS m (Ident . runProperName) name

136valueToJs _ m _ (Constructor name) = qualifiedToJS m (Ident . runProperName) name

133valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)

137valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)

134valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)

138valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)

135−valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)

139+valueToJs opts m e (Accessor prop val) = accessorString prop (valueToJs opts m e val)

136valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]

140valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]

137valueToJs opts m e (Let ds val) = JSApp (JSFunction Nothing [] (JSBlock (concat (mapMaybe (flip (declToJs opts m) e) ds) ++ [JSReturn $ valueToJs opts m e val]))) []

141valueToJs opts m e (Let ds val) = JSApp (JSFunction Nothing [] (JSBlock (concat (mapMaybe (flip (declToJs opts m) e) ds) ++ [JSReturn $ valueToJs opts m e val]))) []

138valueToJs opts m e (Abs (Left arg) val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m (bindName m arg e) val)])

142valueToJs opts m e (Abs (Left arg) val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m (bindName m arg e) val)])

@@ -199,7 +203,7 @@ runtimeTypeChecks arg ty =

199 let

203 let

200 (pairs, _) = rowToList row

204 (pairs, _) = rowToList row

201 in

205 in

202− typeCheck val "object" : concatMap (\(prop, ty') -> argumentCheck (JSAccessor prop val) ty') pairs

206+ typeCheck val "object" : concatMap (\(prop, ty') -> argumentCheck (accessorString prop val) ty') pairs

203 argumentCheck val (TypeApp (TypeApp t _) _) | t == tyFunction = [typeCheck val "function"]

207 argumentCheck val (TypeApp (TypeApp t _) _) | t == tyFunction = [typeCheck val "function"]

204 argumentCheck val (ForAll _ ty' _) = argumentCheck val ty'

208 argumentCheck val (ForAll _ ty' _) = argumentCheck val ty'

205 argumentCheck _ _ = []

209 argumentCheck _ _ = []

@@ -284,7 +288,7 @@ binderToJs m e varName done (ObjectBinder bs) = go done bs

284 propVar <- fresh

288 propVar <- fresh

285 done'' <- go done' bs'

289 done'' <- go done' bs'

286 js <- binderToJs m e propVar done'' binder

290 js <- binderToJs m e propVar done'' binder

287− return (JSVariableIntroduction propVar (Just (JSAccessor prop (JSVar varName))) : js)

291+ return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)

288binderToJs m e varName done (ArrayBinder bs) = do

292binderToJs m e varName done (ArrayBinder bs) = do

289 js <- go done 0 bs

293 js <- go done 0 bs

290 return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]

294 return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]

src/Language/PureScript/CodeGen/JS/AST.hs−2

@@ -19,8 +19,6 @@ module Language.PureScript.CodeGen.JS.AST where

19

20import Data.Data

21

22−

23−

24-- |

22-- |

25-- Built-in unary operators

23-- Built-in unary operators

26--

24--

src/Language/PureScript/Names.hs+1−18

@@ -19,7 +19,6 @@ module Language.PureScript.Names where

19

20import Data.List

21import Data.Data

22−import Data.Function (on)

23

22

24-- |

23-- |

25-- Names for value identifiers

24-- Names for value identifiers

@@ -32,27 +31,11 @@ data Ident

32 -- |

31 -- |

33 -- A symbolic name for an infix operator

32 -- A symbolic name for an infix operator

34 --

33 --

35− | Op String

36− -- |

37− -- An escaped name

38− --

39− | Escaped String deriving (Data, Typeable)

34+ | Op String deriving (Eq, Ord, Data, Typeable)

40

35

41instance Show Ident where

36instance Show Ident where

42 show (Ident s) = s

37 show (Ident s) = s

43 show (Op op) = '(':op ++ ")"

38 show (Op op) = '(':op ++ ")"

44− show (Escaped s) = s

45−

46−instance Eq Ident where

47− Ident s1 == Ident s2 = s1 == s2

48− Op s1 == Op s2 = s1 == s2

49− Escaped s1 == Escaped s2 = s1 == s2

50− Ident s1 == Escaped s2 = s1 == s2

51− Escaped s1 == Ident s2 = s1 == s2

52− _ == _ = False

53−

54−instance Ord Ident where

55− compare = compare `on` show

56

39

57-- |

40-- |

58-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.

41-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.

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

@@ -232,7 +232,7 @@ parseObjectLiteral :: P.Parsec String ParseState Value

232parseObjectLiteral = ObjectLiteral <$> C.braces (C.commaSep parseIdentifierAndValue)

233

234parseIdentifierAndValue :: P.Parsec String ParseState (String, Value)

235−parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C.colon)

235+parseIdentifierAndValue = (,) <$> (C.indented *> (C.identifier <|> C.stringLiteral) <* C.indented <* C.colon)

236 <*> (C.indented *> parseValue)

237

238parseAbs :: P.Parsec String ParseState Value

@@ -295,14 +295,14 @@ parseValueAtom = P.choice

295

296parsePropertyUpdate :: P.Parsec String ParseState (String, Value)

297parsePropertyUpdate = do

298− name <- C.lexeme C.identifier

298+ name <- C.lexeme (C.identifier <|> C.stringLiteral)

299 _ <- C.lexeme $ C.indented *> P.char '='

300 value <- C.indented *> parseValue

301 return (name, value)

302

303parseAccessor :: Value -> P.Parsec String ParseState Value

304parseAccessor (Constructor _) = P.unexpected "constructor"

305−parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> C.identifier) <*> pure obj

305+parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> (C.identifier <|> C.stringLiteral)) <*> pure obj

306

307parseDo :: P.Parsec String ParseState Value

308parseDo = do

@@ -377,7 +377,7 @@ parseNullBinder = C.lexeme (P.char '_') *> P.notFollowedBy C.identLetter *> retu

377

378parseIdentifierAndBinder :: P.Parsec String ParseState (String, Binder)

379parseIdentifierAndBinder = do

380− name <- C.lexeme C.identifier

380+ name <- C.lexeme (C.identifier <|> C.stringLiteral)

381 _ <- C.lexeme $ C.indented *> P.char '='

382 binder <- C.indented *> parseBinder

383 return (name, binder)

src/Language/PureScript/Parser/Types.hs+1−1

@@ -118,7 +118,7 @@ parsePolyType :: P.Parsec String ParseState Type

118parsePolyType = parseAnyType

119

120parseNameAndType :: P.Parsec String ParseState t -> P.Parsec String ParseState (String, t)

121−parseNameAndType p = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> p

121+parseNameAndType p = (,) <$> (indented *> (identifier <|> stringLiteral) <* indented <* lexeme (P.string "::")) <*> p

122

123parseRowEnding :: P.Parsec String ParseState Type

124parseRowEnding = P.option REmpty (TypeVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))

src/Language/PureScript/Pretty/JS.hs+6−1

@@ -18,6 +18,7 @@ module Language.PureScript.Pretty.JS (

18) where

19

20import Language.PureScript.Pretty.Common

21+import Language.PureScript.CodeGen.JS (isIdent)

21import Language.PureScript.CodeGen.JS.AST

22import Language.PureScript.CodeGen.JS.AST

22

23

23import Data.List

24import Data.List

@@ -46,13 +47,17 @@ literals = mkPattern' match

46 match (JSObjectLiteral ps) = fmap concat $ sequence

47 match (JSObjectLiteral ps) = fmap concat $ sequence

47 [ return "{\n"

48 [ return "{\n"

48 , withIndent $ do

49 , withIndent $ do

49− jss <- forM ps $ \(key, value) -> fmap ((key ++ ": ") ++) . prettyPrintJS' $ value

50+ jss <- forM ps $ \(key, value) -> fmap ((objectPropertyToString key ++ ": ") ++) . prettyPrintJS' $ value

50 indentString <- currentIndent

51 indentString <- currentIndent

51 return $ intercalate ", \n" $ map (indentString ++) jss

52 return $ intercalate ", \n" $ map (indentString ++) jss

52 , return "\n"

53 , return "\n"

53 , currentIndent

54 , currentIndent

54 , return "}"

55 , return "}"

55 ]

56 ]

57+ where

58+ objectPropertyToString :: String -> String

59+ objectPropertyToString s | isIdent s = s

60+ | otherwise = show s

56 match (JSBlock sts) = fmap concat $ sequence

61 match (JSBlock sts) = fmap concat $ sequence

57 [ return "{\n"

62 [ return "{\n"

58 , withIndent $ prettyStatements sts

63 , withIndent $ prettyStatements sts

src/Language/PureScript/Sugar/TypeClasses.hs+14−10

@@ -29,7 +29,7 @@ import Language.PureScript.CodeGen.Common (identToJs)

29

30import Control.Applicative

31import Control.Monad.State

32−import Control.Arrow (second)

32+import Control.Arrow (first, second)

33import Data.Maybe (catMaybes)

34

35import qualified Data.Map as M

@@ -97,19 +97,23 @@ desugarDecl mn (PositionedDeclaration pos d) = do

97 return (dr, map (PositionedDeclaration pos) ds)

98desugarDecl _ other = return (Nothing, [other])

99

100−memberToNameAndType :: Declaration -> (String, Type)

100+memberToNameAndType :: Declaration -> (Ident, Type)

101−memberToNameAndType (TypeDeclaration ident ty) = (identToJs ident, ty)

101+memberToNameAndType (TypeDeclaration ident ty) = (ident, ty)

102memberToNameAndType (PositionedDeclaration _ d) = memberToNameAndType d

103memberToNameAndType _ = error "Invalid declaration in type class definition"

104

105+identToProperty :: Ident -> String

106+identToProperty (Ident name) = name

107+identToProperty (Op op) = op

108+

105typeClassDictionaryDeclaration :: ProperName -> [String] -> [Declaration] -> Declaration

109typeClassDictionaryDeclaration :: ProperName -> [String] -> [Declaration] -> Declaration

106typeClassDictionaryDeclaration name args members =

110typeClassDictionaryDeclaration name args members =

107− TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (map memberToNameAndType members, REmpty))

111+ TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (map (first identToProperty . memberToNameAndType) members, REmpty))

108

112

109typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration

113typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration

110typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =

114typeClassMemberToDictionaryAccessor mn name args (TypeDeclaration ident ty) =

111 ExternDeclaration TypeClassAccessorImport ident

115 ExternDeclaration TypeClassAccessorImport ident

112− (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSAccessor (identToJs ident) (JSVar "dict"))])))

116+ (Just (JSFunction (Just $ identToJs ident) ["dict"] (JSBlock [JSReturn (JSIndexer (JSStringLiteral (identToProperty ident)) (JSVar "dict"))])))

113 (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty))

117 (quantify (ConstrainedType [(Qualified (Just mn) name, map TypeVar args)] ty))

114typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =

118typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =

115 PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d

119 PositionedDeclaration pos $ typeClassMemberToDictionaryAccessor mn name args d

@@ -127,13 +131,13 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do

127 -- Replace the type arguments with the appropriate types in the member types

131 -- Replace the type arguments with the appropriate types in the member types

128 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys

132 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys

129 -- Create values for the type instance members

133 -- Create values for the type instance members

130− memberNames <- mapM (memberToNameAndValue memberTypes) decls

134+ memberNames <- map (first identToProperty) <$> mapM (memberToNameAndValue memberTypes) decls

131 -- Create the type of the dictionary

135 -- Create the type of the dictionary

132 -- The type is an object type, but depending on type instance dependencies, may be constrained.

136 -- The type is an object type, but depending on type instance dependencies, may be constrained.

133 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary

137 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary

134 -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no

138 -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no

135 -- dependencies, we introduce an unnamed function parameter.

139 -- dependencies, we introduce an unnamed function parameter.

136− let dictTy = TypeApp tyObject (rowFromList (memberTypes, REmpty))

140+ let dictTy = TypeApp tyObject (rowFromList (map (first identToProperty) memberTypes, REmpty))

137 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)

141 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)

138 dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames) else ObjectLiteral memberNames

142 dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames) else ObjectLiteral memberNames

139 return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)

143 return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)

@@ -141,11 +145,11 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do

141 unit :: Type

145 unit :: Type

142 unit = TypeApp tyObject REmpty

146 unit = TypeApp tyObject REmpty

143

147

144− memberToNameAndValue :: [(String, Type)] -> Declaration -> Desugar (String, Value)

148+ memberToNameAndValue :: [(Ident, Type)] -> Declaration -> Desugar (Ident, Value)

145 memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do

149 memberToNameAndValue tys' d@(ValueDeclaration ident _ _ _ _) = do

146− _ <- lift . maybe (Left $ mkErrorStack "Type class member type not found" Nothing) Right $ lookup (identToJs ident) tys'

150+ _ <- lift . maybe (Left $ mkErrorStack "Type class member type not found" Nothing) Right $ lookup ident tys'

147 let memberValue = typeInstanceDictionaryEntryValue d

151 let memberValue = typeInstanceDictionaryEntryValue d

148− return (identToJs ident, memberValue)

152+ return (ident, memberValue)

149 memberToNameAndValue tys' (PositionedDeclaration pos d) = do

153 memberToNameAndValue tys' (PositionedDeclaration pos d) = do

150 (ident, val) <- memberToNameAndValue tys' d

154 (ident, val) <- memberToNameAndValue tys' d

151 return (ident, PositionedValue pos val)

155 return (ident, PositionedValue pos val)