eb34595 · rowtype-yoga/purescript-native

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

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

This reverts commit f6501d081978b4c23d3f1d4e62efc71a6f62df61.

commiteb345956aa532c363a20ecfae7222a06853f3e59 authorGary Burgess <garyb@users.noreply.github.com> dateMon 3 Feb 2014, 23:18 (13 years ago) parentf6501d0

8 files changed+38−45

compare with golang

unifiedsplit

src/Language/PureScript.hs+1−1 src/Language/PureScript/CodeGen/JS.hs+22−22 src/Language/PureScript/CodeGen/JS/AST.hs+2−2 src/Language/PureScript/CodeGen/Optimize.hs+6−5 src/Language/PureScript/Parser/JS.hs+1−1 src/Language/PureScript/Pretty/Common.hs+2−5 src/Language/PureScript/Pretty/JS.hs+3−8 src/Language/PureScript/Sugar/TypeClasses.hs+1−1

src/Language/PureScript.hs+1−1

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

6565 _ | optionsRunMain opts -> do

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

6767 Left "Main.main is undefined"

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

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

6969 | otherwise -> return js

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

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

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

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

69− setProperty ident (JSVar ident) mp ]

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

7070declToJs opts mp (BindingGroupDeclaration vals) e =

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

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

73− setProperty ident (JSVar ident) mp ]

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

7474 ) vals

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

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

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

8282 (JSBlock [JSReturn

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

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

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

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

8686declToJs opts mp (DataBindingGroupDeclaration ds) e =

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

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

8989 Just [ js

90− , setProperty ident (JSVar ident) mp ]

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

9191declToJs _ _ _ _ = Nothing

9292

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

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

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

9595

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

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

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

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

101101valueToJs 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)]

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

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

106106 _ -> JSVar . Ident . runProperName $ name

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

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

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

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

110110valueToJs 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)

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

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

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

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

140140 let

141141 (pairs, _) = rowToList row

142142 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

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

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

146146 argumentCheck _ _ = []

147147 typeCheck :: JS -> String -> JS

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

149149 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

151151

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

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

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

156156 _ -> case qual of

157157 Qualified Nothing _ -> JSVar ident

158− _ -> qualifiedToJS id qual

158+ _ -> qualifiedToJS identToJs qual

159159 where

160160 isExtern (Extern ForeignImport) = True

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

163163 Nothing -> error "Undefined alias in varToJs"

164164 isExtern _ = False

165165

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

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

167167qualifiedToJS 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))

169169

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

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

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

199199 then

200200 return done

201201 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]

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

204204 value <- fresh

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

207207 if isOnlyConstructor m e ctor

208208 then

209209 return [success]

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

212212 success

213213 Nothing]

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

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

219219 propVar <- fresh

220220 done'' <- go done' bs'

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

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

224224 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]

226226 where

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

228228 go done' _ [] = return done'

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

236236 tailVar <- fresh

237237 js1 <- binderToJs m e headVar done headBinder

238238 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

240240 ( 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)])) :

242242 js2

243243 )) Nothing]

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

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

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

6161 -- |

6262 -- An object property accessor expression

6363 --

64− | JSAccessor Ident JS

64+ | JSAccessor String JS

6565 -- |

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

6767 --

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

142142 -- |

143143 -- Assign an object property

144144 --

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

4242import Language.PureScript.Names

4343import Language.PureScript.CodeGen.JS.AST

4444import Language.PureScript.Options

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

4546import Language.PureScript.Sugar.TypeClasses

4647 (mkDictionaryValueName)

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

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

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

264265 isReturn _ = False

265266 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

267268 isBindPoly _ = False

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

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

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

270271 isRetPoly _ = False

271272 prelude = ModuleName (ProperName "Prelude")

272273 effModule = ModuleName (ProperName "Eff")

273− Right effDictName@(Ident _) = mkDictionaryValueName

274+ Right (Ident effDictName) = mkDictionaryValueName

274275 effModule

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

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

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

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

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

279280 isEffDict _ = False

280281 undo :: JS -> JS

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

297298 convert :: JS -> JS

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

299300 convert other = other

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

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

301302 isDollar _ = False

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

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

8181 , P.parens C.tokenParser parseJS ]

8282

8383parseAccessor :: 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)

8585

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

8787parseIndexer 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

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

3535--

3636identToJs :: Ident -> String

37−identToJs (Ident name) = stringToJsIdent name

38−identToJs (Op op) = stringToJsIdent op

37+identToJs (Ident name) = concatMap identCharToString name

38+identToJs (Op op) = concatMap identCharToString op

3939identToJs (Escaped name) = name

4040

41−stringToJsIdent :: String -> String

42−stringToJsIdent name = concatMap identCharToString name

43−

4441identCharToString :: Char -> String

4542identCharToString c | isAlphaNum c = [c]

4643identCharToString '_' = "_"

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

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

140140

141141targetToJs :: JSAssignment -> String

142142targetToJs (JSAssignVariable ident) = identToJs ident

143−targetToJs (JSAssignProperty prop target) = targetToJs target ++ (propAccess 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)

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

149144

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

151146conditional = mkPattern match

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

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

154149 match _ = Nothing

155150

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

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

157152accessor = mkPattern match

158153 where

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

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

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

229224 operators :: OperatorTable PrinterState JS String

230225 operators =

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

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

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

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

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

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

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

7373typeClassMemberToDictionaryAccessor :: ProperName -> String -> Declaration -> Declaration

7474typeClassMemberToDictionaryAccessor name arg (TypeDeclaration ident ty) =

7575 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")))])))

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

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

7979