e74c777 · rowtype-yoga/purescript-native

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

Add indexer notation for operators at the top level #142

commite74c7771e64ed3ce7771ec61102d1c2529be1757 authorPhil Freeman <paf31@cantab.net> dateMon 3 Feb 2014, 17:25 (13 years ago) parent9fd5b26

5 files changed+40−53

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/JS.hs+24−19 src/Language/PureScript/CodeGen/JS/AST.hs+1−14 src/Language/PureScript/CodeGen/Optimize.hs+11−7 src/Language/PureScript/Parser/JS.hs+3−8 src/Language/PureScript/Pretty/JS.hs+1−5

src/Language/PureScript/CodeGen/JS.hs+24−19

@@ -52,8 +52,8 @@ moduleToJs opts (Module pname@(ProperName name) decls) env =

5252 [ JSVariableIntroduction name Nothing

5353 , JSApp (JSFunction Nothing [name]

5454 (JSBlock (concat $ mapMaybe (\decl -> fmap (map $ optimize opts) $ declToJs opts (ModuleName pname) decl env) (sortBy typeClassesLast decls))))

55− [JSAssignment (JSAssignVariable name)

56− (JSBinary Or (JSVar name) (JSObjectLiteral []))]

55+ [JSAssignment (JSVar name)

56+ (JSBinary Or (JSVar name) (JSObjectLiteral []))]

5757 ]

5858 where

5959 typeClassesLast (ExternDeclaration TypeClassDictionaryImport _ _ _) (ExternDeclaration TypeClassDictionaryImport _ _ _) = EQ

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

6666--

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

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

69− Just [ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val)),

70− setProperty (identToJs ident) (var ident) mp ]

69+ Just $ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val))

70+ : setProperty ident (var ident) mp

7171declToJs opts mp (BindingGroupDeclaration vals) e =

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

73− [ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val)),

74− setProperty (identToJs ident) (var ident) mp ]

73+ JSVariableIntroduction (identToJs ident) (Just (valueToJs opts mp e val))

74+ : setProperty ident (var ident) mp

7575 ) vals

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

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

@@ -83,19 +83,22 @@ declToJs _ mp (DataDeclaration _ _ ctors) _ =

8383 (JSBlock [JSReturn

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

8585 , ("value", JSVar "value") ])])

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

86+ in ctorJs : setProperty (Escaped ctor) (JSVar ctor) mp

8787declToJs opts mp (DataBindingGroupDeclaration ds) e =

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

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

90− Just [ js

91− , setProperty (identToJs ident) (var ident) mp ]

90+ Just $ js : setProperty ident (var ident) mp

9291declToJs _ _ _ _ = Nothing

9392

94−setProperty :: String -> JS -> ModuleName -> JS

95−setProperty prop val (ModuleName (ProperName moduleName)) = JSAssignment (JSAssignProperty prop (JSAssignVariable moduleName)) val

93+setProperty :: Ident -> JS -> ModuleName -> [JS]

94+setProperty ident@(Op op) val (ModuleName (ProperName moduleName)) =

95+ [ JSAssignment (JSAccessor (identToJs ident) (JSVar moduleName)) val

96+ , JSAssignment (JSIndexer (JSStringLiteral op) (JSVar moduleName)) (JSAccessor (identToJs ident) (JSVar moduleName)) ]

97+setProperty ident val (ModuleName (ProperName moduleName)) =

98+ [ JSAssignment (JSAccessor (identToJs ident) (JSVar moduleName)) val ]

9699

97100var :: Ident -> JS

98−var name = JSVar $ identToJs name

101+var = JSVar . identToJs

99102

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

101104valueToJs _ _ _ (NumericLiteral n) = JSNumericLiteral n

@@ -154,13 +157,15 @@ runtimeTypeChecks arg ty =

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

155158

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

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

158− Just (_, ty) | isExtern ty -> var ident

159− Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified (Just aliasModule) aliasIdent)

160− _ -> case qual of

161− Qualified Nothing _ -> var ident

162− _ -> qualifiedToJS identToJs qual

160+varToJs m e qual@(Qualified _ ident) = go qual

163161 where

162+ go qual = case M.lookup (qualify m qual) (names e) of

163+ Just (_, ty) | isExtern ty -> var ident

164+ Just (_, Alias aliasModule aliasIdent) -> go (Qualified (Just aliasModule) aliasIdent)

165+ _ -> case qual of

166+ Qualified Nothing _ -> var ident

167+ Qualified (Just (ModuleName (ProperName mn))) (Op op) -> JSIndexer (JSStringLiteral op) (JSVar mn)

168+ _ -> qualifiedToJS identToJs qual

164169 isExtern (Extern ForeignImport) = True

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

166171 Just (_, ty') -> isExtern ty'

@@ -263,7 +268,7 @@ isOnlyConstructor m e ctor =

263268

264269statementToJs :: Options -> ModuleName -> Environment -> Statement -> JS

265270statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction (identToJs ident) (Just (valueToJs opts m e value))

266−statementToJs opts m e (Assignment target value) = JSAssignment (JSAssignVariable (identToJs target)) (valueToJs opts m e value)

271+statementToJs opts m e (Assignment target value) = JSAssignment (JSVar (identToJs target)) (valueToJs opts m e value)

267272statementToJs opts m e (While cond sts) = JSWhile (valueToJs opts m e cond) (JSBlock (map (statementToJs opts m e) sts))

268273statementToJs opts m e (For ident start end sts) = JSFor (identToJs ident) (valueToJs opts m e start) (valueToJs opts m e end) (JSBlock (map (statementToJs opts m e) sts))

269274statementToJs opts m e (If ifst) = ifToJs ifst

src/Language/PureScript/CodeGen/JS/AST.hs+1−14

@@ -88,7 +88,7 @@ data JS

8888 -- |

8989 -- A variable assignment

9090 --

91− | JSAssignment JSAssignment JS

91+ | JSAssignment JS JS

9292 -- |

9393 -- While loop

9494 --

@@ -129,16 +129,3 @@ data JS

129129 -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)

130130 --

131131 | JSRaw String deriving (Show, Eq, Data, Typeable)

132−

133−-- |

134−-- Data type for expressions which can appear on the left hand side of an assignment

135−--

136−data JSAssignment

137− -- |

138− -- Assign a variable

139− --

140− = JSAssignVariable String

141− -- |

142− -- Assign an object property

143− --

144− | JSAssignProperty String JSAssignment deriving (Show, Eq, Data, Typeable)

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

@@ -105,9 +105,11 @@ isUsed var1 = everything (||) (mkQ False check)

105105 check (JSAssignment target _) | var1 == targetVariable target = True

106106 check _ = False

107107

108−targetVariable :: JSAssignment -> String

109−targetVariable (JSAssignVariable var) = var

110−targetVariable (JSAssignProperty _ tgt) = targetVariable tgt

108+targetVariable :: JS -> String

109+targetVariable (JSVar var) = var

110+targetVariable (JSAccessor _ tgt) = targetVariable tgt

111+targetVariable (JSIndexer _ tgt) = targetVariable tgt

112+targetVariable _ = error "Invalid argument to targetVariable"

111113

112114isUpdated :: (Data d) => String -> d -> Bool

113115isUpdated var1 = everything (||) (mkQ False check)

@@ -231,7 +233,7 @@ tco' = everywhere (mkT convert)

231233 JSBlock $ zipWith (\val arg ->

232234 JSVariableIntroduction (tcoVar arg) (Just val)) allArgumentValues allArgs

233235 ++ map (\arg ->

234− JSAssignment (JSAssignVariable arg) (JSVar (tcoVar arg))) allArgs

236+ JSAssignment (JSVar arg) (JSVar (tcoVar arg))) allArgs

235237 ++ [ JSContinue tcoLabel ]

236238 loopify other = other

237239 collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]

@@ -257,12 +259,13 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)

257259 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =

258260 JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSReturn (JSApp ret []) ]

259261 convert other = other

260− isBind (JSApp bindPoly [JSApp effDict []]) | isBindPoly bindPoly && isEffDict effDict = True

262+ isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict effDict = True

261263 isBind _ = False

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

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

263265 isReturn _ = False

264266 isBindPoly (JSVar op) | op == identToJs (Op ">>=") = True

265267 isBindPoly (JSAccessor prop (JSVar "Prelude")) | prop == identToJs (Op ">>=") = True

268+ isBindPoly (JSIndexer (JSStringLiteral ">>=") (JSVar "Prelude")) = True

266269 isBindPoly _ = False

267270 isRetPoly (JSVar "ret") = True

268271 isRetPoly (JSAccessor "ret" (JSVar "Prelude")) = True

@@ -296,5 +299,6 @@ inlineDollar = everywhere (mkT convert)

296299 convert :: JS -> JS

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

298301 convert other = other

299− isDollar (JSAccessor name (JSVar "Prelude")) | name == identToJs (Op "$") = True

302+ isDollar (JSAccessor "$dollar" (JSVar "Prelude")) = True

303+ isDollar (JSIndexer (JSStringLiteral "$") (JSVar "Prelude")) = True

300304 isDollar _ = False

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

@@ -74,7 +74,6 @@ parseJSAtom = P.choice

7474 , parseBlock

7575 , P.try parseVar

7676 , parseVariableIntroduction

77− , P.try parseAssignment

7877 , parseWhile

7978 , parseIf

8079 , parseReturn

@@ -110,7 +109,7 @@ parseJS =

110109 $ indexersAndAccessors) P.<?> "javascript"

111110 where

112111 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseJSAtom

113− postfixTable1 = [ parseAccessor, parseIndexer, parseConditional ]

112+ postfixTable1 = [ parseAccessor, parseIndexer, parseConditional, parseAssignment ]

114113 postfixTable2 = [ \v -> P.try $ JSApp v <$> (P.parens C.tokenParser (P.commaSep C.tokenParser parseJS)) ]

115114 operators = [ [ binary LessThan "<" P.AssocLeft]

116115 , [ binary LessThanOrEqualTo "<=" P.AssocLeft]

@@ -149,17 +148,13 @@ parseVariableIntroduction = do

149148 return value

150149 return $ JSVariableIntroduction name value

151150

152−parseAssignment :: P.Parsec String u JS

153−parseAssignment = do

154− tgt <- parseAssignmentTarget

151+parseAssignment :: JS -> P.Parsec String u JS

152+parseAssignment tgt = do

155153 _ <- C.lexeme $ P.char '='

156154 value <- parseJS

157155 _ <- C.semi

158156 return $ JSAssignment tgt value

159157

160−parseAssignmentTarget :: P.Parsec String u JSAssignment

161−parseAssignmentTarget = C.buildPostfixParser [] (JSAssignVariable <$> P.identifier C.tokenParser)

162−

163158parseWhile :: P.Parsec String u JS

164159parseWhile = JSWhile <$> (C.reserved "while" *> P.parens C.tokenParser parseJS)

165160 <*> parseJS

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

@@ -96,7 +96,7 @@ literals = mkPattern' match

9696 , maybe (return "") (fmap (" = " ++) . prettyPrintJS') value

9797 ]

9898 match (JSAssignment target value) = fmap concat $ sequence

99− [ return $ targetToJs target

99+ [ prettyPrintJS' target

100100 , return " = "

101101 , prettyPrintJS' value

102102 ]

@@ -138,10 +138,6 @@ literals = mkPattern' match

138138 match (JSRaw js) = return js

139139 match _ = mzero

140140

141−targetToJs :: JSAssignment -> String

142−targetToJs (JSAssignVariable ident) = ident

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

144−

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

146142conditional = mkPattern match

147143 where