eb34595 · rowtype-yoga/purescript-native

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

on golang help sign in

Revert "Use [..] property access for non-JS-safe ids"

eb34595Gary Burgess13 years ago

src/Language/PureScript.hs+1−1

compare with golang

unifiedsplit

@@ -65,6 +65,6 @@ compile opts ms = do

65 _ | optionsRunMain opts -> do

66 when ((ModuleName (ProperName "Main"), Ident "main") `M.notMember` (names env)) $

67 Left "Main.main is undefined"

68− return $ js ++ [JSApp (JSAccessor (Ident "main") (JSVar (Ident "Main"))) []]

68+ return $ js ++ [JSApp (JSAccessor "main" (JSVar (Ident "Main"))) []]

69 | otherwise -> return js

70 return (prettyPrintJS js', exts, env)

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

@@ -66,11 +66,11 @@ moduleToJs opts (Module pname@(ProperName name) decls) env =

66declToJs :: Options -> ModuleName -> Declaration -> Environment -> Maybe [JS]

67declToJs opts mp (ValueDeclaration ident _ _ val) e =

68 Just [ JSVariableIntroduction ident (Just (valueToJs opts mp e val)),

69− setProperty ident (JSVar ident) mp ]

69+ setProperty (identToJs ident) (JSVar ident) mp ]

70declToJs opts mp (BindingGroupDeclaration vals) e =

71 Just $ concatMap (\(ident, val) ->

72 [ JSVariableIntroduction ident (Just (valueToJs opts mp e val)),

73− setProperty ident (JSVar ident) mp ]

73+ setProperty (identToJs ident) (JSVar ident) mp ]

74 ) vals

75declToJs _ mp (DataDeclaration _ _ ctors) _ =

76 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->

@@ -82,15 +82,15 @@ declToJs _ mp (DataDeclaration _ _ ctors) _ =

82 (JSBlock [JSReturn

83 (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn)))

84 , ("value", JSVar (Ident "value")) ])])

85− in [ ctorJs, setProperty (Ident ctor) (JSVar (Ident ctor)) mp ]

85+ in [ ctorJs, setProperty ctor (JSVar (Ident ctor)) mp ]

86declToJs opts mp (DataBindingGroupDeclaration ds) e =

87 Just $ concat $ mapMaybe (flip (declToJs opts mp) e) ds

88declToJs _ mp (ExternDeclaration importTy ident (Just js) _) _ =

89 Just [ js

90− , setProperty ident (JSVar ident) mp ]

90+ , setProperty (identToJs ident) (JSVar ident) mp ]

91declToJs _ _ _ _ = Nothing

93−setProperty :: Ident -> JS -> ModuleName -> JS

93+setProperty :: String -> JS -> ModuleName -> JS

94setProperty prop val (ModuleName (ProperName moduleName)) = JSAssignment (JSAssignProperty prop (JSAssignVariable (Ident moduleName))) val

96valueToJs :: Options -> ModuleName -> Environment -> Value -> JS

@@ -99,16 +99,16 @@ valueToJs _ _ _ (StringLiteral s) = JSStringLiteral s

99valueToJs _ _ _ (BooleanLiteral b) = JSBooleanLiteral b

100valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs opts m e) xs)

101valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs opts m e)) ps)

102−valueToJs opts m e (ObjectUpdate o ps) = JSApp (JSAccessor (Ident "extend") (JSVar (Ident "Object"))) [ valueToJs opts m e o, JSObjectLiteral (map (second (valueToJs opts m e)) ps)]

102+valueToJs opts m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs opts m e o, JSObjectLiteral (map (second (valueToJs opts m e)) ps)]

103valueToJs _ m e (Constructor (Qualified Nothing name)) =

104 case M.lookup (m, name) (dataConstructors e) of

105− Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS id (Qualified (Just aliasModule) aliasIdent)

105+ Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified (Just aliasModule) aliasIdent)

106 _ -> JSVar . Ident . runProperName $ name

107−valueToJs _ _ _ (Constructor name) = qualifiedToJS (Ident . runProperName) name

107+valueToJs _ _ _ (Constructor name) = qualifiedToJS runProperName name

108valueToJs opts m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs opts m e) sts))) []

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

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

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

111+valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)

112valueToJs opts m e (Indexer index val) = JSIndexer (valueToJs opts m e index) (valueToJs opts m e val)

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

114valueToJs opts m e (Abs arg val) = JSFunction Nothing [arg] (JSBlock [JSReturn (valueToJs opts m e val)])

@@ -140,22 +140,22 @@ runtimeTypeChecks arg ty =

140 let

141 (pairs, _) = rowToList row

142 in

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

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

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

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

146 argumentCheck _ _ = []

147 typeCheck :: JS -> String -> JS

148 typeCheck js ty' = JSIfElse (JSBinary NotEqualTo (JSTypeOf js) (JSStringLiteral ty')) (JSBlock [JSThrow (JSStringLiteral $ ty' ++ " expected")]) Nothing

149 arrayCheck :: JS -> JS

150− arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor (Ident "isArray") (JSVar (Ident "Array"))) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing

150+ arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor "isArray" (JSVar (Ident "Array"))) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing

151

152varToJs :: ModuleName -> Environment -> Qualified Ident -> JS

153varToJs m e qual@(Qualified _ ident) = case M.lookup (qualify m qual) (names e) of

154 Just (_, ty) | isExtern ty -> JSVar ident

155− Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS id (Qualified (Just aliasModule) aliasIdent)

155+ Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified (Just aliasModule) aliasIdent)

156 _ -> case qual of

157 Qualified Nothing _ -> JSVar ident

158− _ -> qualifiedToJS id qual

158+ _ -> qualifiedToJS identToJs qual

159 where

160 isExtern (Extern ForeignImport) = True

161 isExtern (Alias m' ident') = case M.lookup (m', ident') (names e) of

@@ -163,9 +163,9 @@ varToJs m e qual@(Qualified _ ident) = case M.lookup (qualify m qual) (names e)

163 Nothing -> error "Undefined alias in varToJs"

164 isExtern _ = False

165

166−qualifiedToJS :: (a -> Ident) -> Qualified a -> JS

166+qualifiedToJS :: (a -> String) -> Qualified a -> JS

167qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = JSAccessor (f a) (JSVar (Ident m))

168−qualifiedToJS f (Qualified Nothing a) = JSVar (f a)

168+qualifiedToJS f (Qualified Nothing a) = JSVar (Ident (f a))

169

170bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS

171bindersToJs opts m e binders vals = runGen (unusedNames (binders, vals)) $ do

@@ -199,16 +199,16 @@ binderToJs m e varName done (NullaryBinder ctor) =

199 then

200 return done

201 else

202− return [JSIfElse (JSBinary EqualTo (JSAccessor (Ident "ctor") (JSVar varName)) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ canonicalizeDataConstructor m e ctor)))) (JSBlock done) Nothing]

202+ return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar varName)) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ canonicalizeDataConstructor m e ctor)))) (JSBlock done) Nothing]

203binderToJs m e varName done (UnaryBinder ctor b) = do

204 value <- fresh

205 js <- binderToJs m e value done b

206− let success = JSBlock (JSVariableIntroduction value (Just (JSAccessor (Ident "value") (JSVar varName))) : js)

206+ let success = JSBlock (JSVariableIntroduction value (Just (JSAccessor "value" (JSVar varName))) : js)

207 if isOnlyConstructor m e ctor

208 then

209 return [success]

210 else

211− return [JSIfElse (JSBinary EqualTo (JSAccessor (Ident "ctor") (JSVar varName)) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ canonicalizeDataConstructor m e ctor))))

211+ return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar varName)) (JSStringLiteral (show ((\(mp, nm) -> Qualified (Just mp) nm) $ canonicalizeDataConstructor m e ctor))))

212 success

213 Nothing]

214binderToJs m e varName done (ObjectBinder bs) = go done bs

@@ -219,10 +219,10 @@ binderToJs m e varName done (ObjectBinder bs) = go done bs

219 propVar <- fresh

220 done'' <- go done' bs'

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

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

222+ return (JSVariableIntroduction propVar (Just (JSAccessor prop (JSVar varName))) : js)

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

224 js <- go done 0 bs

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

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

226 where

227 go :: [JS] -> Integer -> [Binder] -> Gen [JS]

228 go done' _ [] = return done'

@@ -236,9 +236,9 @@ binderToJs m e varName done (ConsBinder headBinder tailBinder) = do

236 tailVar <- fresh

237 js1 <- binderToJs m e headVar done headBinder

238 js2 <- binderToJs m e tailVar js1 tailBinder

239− return [JSIfElse (JSBinary GreaterThan (JSAccessor (Ident "length") (JSVar varName)) (JSNumericLiteral (Left 0))) (JSBlock

239+ return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left 0))) (JSBlock

240 ( JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar varName))) :

241− JSVariableIntroduction tailVar (Just (JSApp (JSAccessor (Ident "slice") (JSVar varName)) [JSNumericLiteral (Left 1)])) :

241+ JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left 1)])) :

242 js2

243 )) Nothing]

244binderToJs m e varName done (NamedBinder ident binder) = do

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

@@ -61,7 +61,7 @@ data JS

61 -- |

62 -- An object property accessor expression

63 --

64− | JSAccessor Ident JS

64+ | JSAccessor String JS

65 -- |

66 -- A function introduction (optional name, arguments, body)

67 --

@@ -142,4 +142,4 @@ data JSAssignment

142 -- |

143 -- Assign an object property

144 --

145− | JSAssignProperty Ident JSAssignment deriving (Show, Eq, Data, Typeable)

145+ | JSAssignProperty String JSAssignment deriving (Show, Eq, Data, Typeable)

src/Language/PureScript/CodeGen/Optimize.hs+6−5

@@ -42,6 +42,7 @@ import Data.Generics

42import Language.PureScript.Names

43import Language.PureScript.CodeGen.JS.AST

44import Language.PureScript.Options

45+import Language.PureScript.Pretty.Common (identToJs)

45import Language.PureScript.Sugar.TypeClasses

46import Language.PureScript.Sugar.TypeClasses

46 (mkDictionaryValueName)

47 (mkDictionaryValueName)

47import Language.PureScript.Types (Type(..))

48import Language.PureScript.Types (Type(..))

@@ -263,18 +264,18 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

263 isReturn (JSApp retPoly [JSApp effDict []]) | isRetPoly retPoly && isEffDict effDict = True

264 isReturn (JSApp retPoly [JSApp effDict []]) | isRetPoly retPoly && isEffDict effDict = True

264 isReturn _ = False

265 isReturn _ = False

265 isBindPoly (JSVar (Op ">>=")) = True

266 isBindPoly (JSVar (Op ">>=")) = True

266− isBindPoly (JSAccessor prop (JSVar (Ident "Prelude"))) | prop == (Op ">>=") = True

267+ isBindPoly (JSAccessor prop (JSVar (Ident "Prelude"))) | prop == identToJs (Op ">>=") = True

267 isBindPoly _ = False

268 isBindPoly _ = False

268 isRetPoly (JSVar (Ident "ret")) = True

269 isRetPoly (JSVar (Ident "ret")) = True

269− isRetPoly (JSAccessor (Ident "ret") (JSVar (Ident "Prelude"))) = True

270+ isRetPoly (JSAccessor "ret" (JSVar (Ident "Prelude"))) = True

270 isRetPoly _ = False

271 isRetPoly _ = False

271 prelude = ModuleName (ProperName "Prelude")

272 prelude = ModuleName (ProperName "Prelude")

272 effModule = ModuleName (ProperName "Eff")

273 effModule = ModuleName (ProperName "Eff")

273− Right effDictName@(Ident _) = mkDictionaryValueName

274+ Right (Ident effDictName) = mkDictionaryValueName

274 effModule

275 effModule

275 (Qualified (Just prelude) (ProperName "Monad"))

276 (Qualified (Just prelude) (ProperName "Monad"))

276 (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))

277 (TypeConstructor (Qualified (Just effModule) (ProperName "Eff")))

277− isEffDict (JSVar ident@(Ident _)) | ident == effDictName = True

278+ isEffDict (JSVar (Ident ident)) | ident == effDictName = True

278 isEffDict (JSAccessor prop (JSVar (Ident "Eff"))) | prop == effDictName = True

279 isEffDict (JSAccessor prop (JSVar (Ident "Eff"))) | prop == effDictName = True

279 isEffDict _ = False

280 isEffDict _ = False

280 undo :: JS -> JS

281 undo :: JS -> JS

@@ -297,5 +298,5 @@ inlineDollar = everywhere (mkT convert)

297 convert :: JS -> JS

298 convert :: JS -> JS

298 convert (JSApp (JSApp dollar [f]) [x]) | isDollar dollar = JSApp f [x]

299 convert (JSApp (JSApp dollar [f]) [x]) | isDollar dollar = JSApp f [x]

299 convert other = other

300 convert other = other

300− isDollar (JSAccessor name (JSVar (Ident "Prelude"))) | name == (Op "$") = True

301+ isDollar (JSAccessor name (JSVar (Ident "Prelude"))) | name == identToJs (Op "$") = True

301 isDollar _ = False

302 isDollar _ = False

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

@@ -81,7 +81,7 @@ parseJSAtom = P.choice

81 , P.parens C.tokenParser parseJS ]

83parseAccessor :: JS -> P.Parsec String u JS

84−parseAccessor js = P.try $ flip JSAccessor js <$> (C.dot *> P.notFollowedBy C.opLetter *> (Ident <$> C.identifier))

84+parseAccessor js = P.try $ flip JSAccessor js <$> (C.dot *> P.notFollowedBy C.opLetter *> C.identifier)

86parseIndexer :: JS -> P.Parsec String u JS

87parseIndexer js = P.try $ flip JSIndexer js <$> (P.squares C.tokenParser parseJS)

src/Language/PureScript/Pretty/Common.hs+2−5

@@ -34,13 +34,10 @@ import Language.PureScript.Names

34-- * Symbols are encoded as a dollar symbol ($) followed by their ordinal value

35--

36identToJs :: Ident -> String

37−identToJs (Ident name) = stringToJsIdent name

37+identToJs (Ident name) = concatMap identCharToString name

38−identToJs (Op op) = stringToJsIdent op

38+identToJs (Op op) = concatMap identCharToString op

39identToJs (Escaped name) = name

41−stringToJsIdent :: String -> String

42−stringToJsIdent name = concatMap identCharToString name

43−

44identCharToString :: Char -> String

41identCharToString :: Char -> String

45identCharToString c | isAlphaNum c = [c]

42identCharToString c | isAlphaNum c = [c]

46identCharToString '_' = "_"

43identCharToString '_' = "_"

src/Language/PureScript/Pretty/JS.hs+3−8

@@ -140,12 +140,7 @@ literals = mkPattern' match

140

141targetToJs :: JSAssignment -> String

142targetToJs (JSAssignVariable ident) = identToJs ident

143−targetToJs (JSAssignProperty prop target) = targetToJs target ++ (propAccess prop)

143+targetToJs (JSAssignProperty prop target) = targetToJs target ++ "." ++ prop

144−

145−propAccess :: Ident -> String

146−propAccess prop@(Ident id) | (identToJs prop) /= id = "[\"" ++ id ++ "\"]"

147−propAccess (Op op) = "[\"" ++ op ++ "\"]"

148−propAccess prop = "." ++ (identToJs prop)

149

144

150conditional :: Pattern PrinterState JS ((JS, JS), JS)

145conditional :: Pattern PrinterState JS ((JS, JS), JS)

151conditional = mkPattern match

146conditional = mkPattern match

@@ -153,7 +148,7 @@ conditional = mkPattern match

153 match (JSConditional cond th el) = Just ((th, el), cond)

148 match (JSConditional cond th el) = Just ((th, el), cond)

154 match _ = Nothing

149 match _ = Nothing

155

150

156−accessor :: Pattern PrinterState JS (Ident, JS)

151+accessor :: Pattern PrinterState JS (String, JS)

157accessor = mkPattern match

152accessor = mkPattern match

158 where

153 where

159 match (JSAccessor prop val) = Just (prop, val)

154 match (JSAccessor prop val) = Just (prop, val)

@@ -228,7 +223,7 @@ prettyPrintJS' = A.runKleisli $ runPattern matchValue

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

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

229 operators :: OperatorTable PrinterState JS String

224 operators :: OperatorTable PrinterState JS String

230 operators =

225 operators =

231− OperatorTable [ [ Wrap accessor $ \prop val -> val ++ (propAccess prop) ]

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

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

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

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

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

234 , [ Wrap lam $ \(name, args) ret -> "function "

229 , [ Wrap lam $ \(name, args) ret -> "function "

src/Language/PureScript/Sugar/TypeClasses.hs+1−1

@@ -73,7 +73,7 @@ typeClassDictionaryDeclaration name arg members =

73typeClassMemberToDictionaryAccessor :: ProperName -> String -> Declaration -> Declaration

74typeClassMemberToDictionaryAccessor name arg (TypeDeclaration ident ty) =

75 ExternDeclaration TypeClassAccessorImport ident

76− (Just (JSFunction (Just ident) [Ident "dict"] (JSBlock [JSReturn (JSAccessor ident (JSVar (Ident "dict")))])))

76+ (Just (JSFunction (Just ident) [Ident "dict"] (JSBlock [JSReturn (JSAccessor (identToJs ident) (JSVar (Ident "dict")))])))

77 (ForAll arg (ConstrainedType [(Qualified Nothing name, TypeVar arg)] ty))

78typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type class definition"