language-ecmascript 0.16.2 → 0.17
raw patch · 5 files changed
+432/−32 lines, 5 files
Files
- CHANGELOG +3/−0
- LICENSE +1/−1
- language-ecmascript.cabal +4/−3
- src/Language/ECMAScript3/Syntax/Arbitrary.hs +38/−28
- src/Language/ECMAScript3/Syntax/CodeGen.hs +386/−0
CHANGELOG view
@@ -1,5 +1,8 @@ Version change log. +=0.17=+Added helper functions for code generation (see Language.ECMAScript3.Syntax.CodeGen). Bug fixes to the Arbitrary instances.+ =0.16.2= Build fixes for GHC 7.4.2 and 7.8.2.
LICENSE view
@@ -1,5 +1,5 @@ Copyright (c) 2007--2012, Brown University, 2008-2012 Claudiu Saftoiu,-2012-2014 Stevens Institute of Technology.+2012-2015 Stevens Institute of Technology. All Rights Reserved. Redistribution and use in source and binary forms, with or without
language-ecmascript.cabal view
@@ -1,8 +1,8 @@ Name: language-ecmascript-Version: 0.16.2+Version: 0.17 Cabal-Version: >= 1.10 Copyright: (c) 2007-2012 Brown University, (c) 2008-2010 Claudiu Saftoiu,- (c) 2012-2014 Stevens Institute of Technology+ (c) 2012-2015 Stevens Institute of Technology License: BSD3 License-file: LICENSE Author: Andrey Chudnov, Arjun Guha, Spiridon Aristides Eliopoulos,@@ -29,7 +29,7 @@ Source-repository this type: git location: git://github.com/jswebtools/language-ecmascript.git- tag: 0.16.2+ tag: 0.17 Library Hs-Source-Dirs:@@ -56,6 +56,7 @@ Language.ECMAScript3.Syntax Language.ECMAScript3.Syntax.Annotations Language.ECMAScript3.Syntax.Arbitrary+ Language.ECMAScript3.Syntax.CodeGen Language.ECMAScript3.Syntax.QuasiQuote Language.ECMAScript3.Analysis.Environment Language.ECMAScript3.Analysis.LabelSets
src/Language/ECMAScript3/Syntax/Arbitrary.hs view
@@ -22,6 +22,7 @@ import Test.Feat.Class import Test.Feat.Enumerate import Test.Feat.Modifiers+import Control.Arrow deriveEnumerable ''AssignOp deriveEnumerable ''InfixOp@@ -179,15 +180,15 @@ fixUp :: a -> Gen a instance (Data a) => Fixable (JavaScript a) where- fixUp (Script a ss) = (liftM (Script a) (fixBreakContinue ss))- >>=transformBiM (return . identifierFixup- :: Id a -> Gen (Id a))- >>=transformBiM (fixUpFunExpr+ fixUp = transformBiM (return . identifierFixup+ :: Id a -> Gen (Id a))+ >=>transformBiM (fixUpFunExpr :: Expression a -> Gen (Expression a))- >>=transformBiM (fixUpFunStmt+ >=>transformBiM (fixUpFunStmt :: Statement a -> Gen (Statement a))- >>=transformBiM (return . fixLValue+ >=>transformBiM (return . fixLValue :: LValue a -> Gen (LValue a))+ >=>(\(Script a ss)-> liftM (Script a) $ fixBreakContinue ss) instance (Data a) => Fixable (Expression a) where fixUp = (fixUpFunExpr . transformBi (identifierFixup :: Id a -> Id a))@@ -298,27 +299,25 @@ fixBC stmt@(LabelledStmt a lab s) = do labs <- gets fst if (unId lab) `elem` labs- -- if duplicate label, delete the current statement (but- -- keep it's child statement)- then descendM fixBC stmt- else liftM (LabelledStmt a lab) $ descendM fixBC s+ -- if duplicate label, delete the current statement (but+ -- keep it's child statement)+ then descendM fixBC s+ else pushLabel lab $ descendM fixBC stmt fixBC stmt@(BreakStmt a mlab) = do encls <- gets snd- case mlab of- Nothing -> if or $ map isIterSwitch encls then return stmt+ case (mlab, encls) of+ (_, []) -> return $ EmptyStmt a+ (Nothing, _) -> if all isIterSwitch encls+ then return stmt -- if none of the enclosing statements is an -- iteration or switch statement, substitute -- the break statement for an empty statement else return $ EmptyStmt a- Just lab@(Id b _) ->+ (Just lab@(Id b _), _) -> if any (elem (unId lab) . getLabelSet) encls then return stmt- else if not $ and $ map isIterSwitch encls- -- if none of the enclosing statements is an- -- iteration or switch statement, substitute- -- the break statement for an empty statement- then return $ EmptyStmt a- else case concatMap getLabelSet encls of+ else if all isIterSwitch encls+ then case concatMap getLabelSet encls of -- if none of the enclosing statements have -- labels, remove the label from the break -- statement@@ -326,17 +325,21 @@ -- if some of them have labels, add the first -- label to the break statement ls -> do newLab <- lift $ selectRandomElement ls- return $ BreakStmt a (Just $ Id b newLab)+ return $ BreakStmt a $ Just $ Id b newLab+ -- if none of the enclosing statements is an+ -- iteration or switch statement, substitute+ -- the break statement for an empty statement+ else return $ EmptyStmt a fixBC stmt@(ContinueStmt a mlab) = do encls <- gets snd let enIts = filter isIter encls- case mlab of- Nothing -> if not $ null enIts then return stmt- -- if none of the enclosing statements are- -- iteration statements, substitute the- -- continue statement for an empty statement- else return $ EmptyStmt a- Just lab@(Id b _) ->+ case (mlab, enIts) of+ -- if none of the enclosing statements are+ -- iteration statements, substitute the+ -- continue statement for an empty statement+ (_, []) -> return $ EmptyStmt a+ (Nothing, _) -> return stmt+ (Just lab@(Id b _), _) -> if any (elem (unId lab) . getLabelSet) enIts then return stmt else case concatMap getLabelSet enIts of@@ -353,7 +356,14 @@ -- label to the break statement ls -> do newLab <- lift $ selectRandomElement ls return $ ContinueStmt a (Just $ Id b newLab)- fixBC s = descendM fixBC s+ fixBC s@(WhileStmt {}) = iterCommon s+ fixBC s@(DoWhileStmt {}) = iterCommon s+ fixBC s@(ForStmt {}) = iterCommon s+ fixBC s@(ForInStmt {}) = iterCommon s+ fixBC s@(SwitchStmt {}) = pushEnclosing EnclosingSwitch $ descendM fixBC s+ fixBC s@(BlockStmt {}) = pushEnclosing EnclosingOther $ descendM fixBC s+ fixBC s = descendM fixBC s+ iterCommon s = pushEnclosing EnclosingIter $ descendM fixBC s -- | choose n elements from a list randomly rChooseElem :: [a] -> Int -> Gen [a]
+ src/Language/ECMAScript3/Syntax/CodeGen.hs view
@@ -0,0 +1,386 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+-- | Utility combinator functions for simplifying writing programmatic+-- generation of ECMAScript code. Recommended to use together with the+-- -XOverloadedStrings GHC extension.+module Language.ECMAScript3.Syntax.CodeGen where++import Language.ECMAScript3.Syntax+import Data.Default.Class+import Data.String++script :: Default a => [Statement a] -> JavaScript a+script = Script def++instance Default a => IsString (Id a) where+ fromString = Id def++instance Default a => IsString (Prop a) where+ fromString = PropString def++ident :: Default a => String -> Id a+ident = Id def++propId :: Default a => Id a -> Prop a+propId = PropId def++propS :: Default a => String -> Prop a+propS = PropString def++propN :: Default a => Integer -> Prop a+propN = PropNum def++instance Default a => IsString (LValue a) where+ fromString = LVar def++lvar :: Default a => String -> LValue a+lvar = LVar def++ldot :: Default a => Expression a -> String -> LValue a+ldot = LDot def++lbrack :: Default a => Expression a -> Expression a -> LValue a+lbrack = LBracket def++instance Default a => IsString (Expression a) where+ fromString = StringLit def++string :: Default a => String -> Expression a+string = StringLit def++regexp :: Default a => String -> Bool -> Bool -> Expression a+regexp = RegexpLit def++number :: Default a => Double -> Expression a+number = NumLit def++bool :: Default a => Bool -> Expression a+bool = BoolLit def++int :: Default a => Int -> Expression a+int = IntLit def++null_ :: Default a => Expression a+null_ = NullLit def++array :: Default a => [Expression a] -> Expression a+array = ArrayLit def++object :: Default a => [(Prop a, Expression a)] -> Expression a+object = ObjectLit def++this :: Default a => Expression a+this = ThisRef def++var :: Default a => Id a -> Expression a+var = VarRef def++dot :: Default a => Expression a -> Id a -> Expression a+dot = DotRef def++brack :: Default a => Expression a -> Expression a -> Expression a+brack = BracketRef def++new :: Default a => Expression a -> [Expression a] -> Expression a+new = NewExpr def++prefix :: Default a => PrefixOp -> Expression a -> Expression a+prefix = PrefixExpr def++lnot :: Default a => Expression a -> Expression a+lnot = prefix PrefixLNot++bnot :: Default a => Expression a -> Expression a+bnot = prefix PrefixBNot++plus :: Default a => Expression a -> Expression a+plus = prefix PrefixPlus++minus :: Default a => Expression a -> Expression a+minus = prefix PrefixMinus++typeof :: Default a => Expression a -> Expression a+typeof = prefix PrefixTypeof++void :: Default a => Expression a -> Expression a+void = prefix PrefixVoid++delete :: Default a => Expression a -> Expression a+delete = prefix PrefixDelete++uassign :: Default a => UnaryAssignOp -> LValue a -> Expression a+uassign = UnaryAssignExpr def++preinc :: Default a => LValue a -> Expression a+preinc = uassign PrefixInc++predec :: Default a => LValue a -> Expression a+predec = uassign PrefixDec++postinc :: Default a => LValue a -> Expression a+postinc = uassign PostfixInc++postdec :: Default a => LValue a -> Expression a+postdec = uassign PostfixDec++infixe+ :: Default a =>+ InfixOp -> Expression a -> Expression a -> Expression a+infixe = InfixExpr def++lt :: Default a => Expression a -> Expression a -> Expression a+lt = infixe OpLT++le :: Default a => Expression a -> Expression a -> Expression a+le = infixe OpLEq++gt :: Default a => Expression a -> Expression a -> Expression a+gt = infixe OpGT++ge :: Default a => Expression a -> Expression a -> Expression a+ge = infixe OpGEq++in_ :: Default a => Expression a -> Expression a -> Expression a+in_= infixe OpIn++instanceof+ :: Default a => Expression a -> Expression a -> Expression a+instanceof = infixe OpInstanceof++eq :: Default a => Expression a -> Expression a -> Expression a+eq = infixe OpEq++neq :: Default a => Expression a -> Expression a -> Expression a+neq = infixe OpNEq++steq :: Default a => Expression a -> Expression a -> Expression a+steq = infixe OpStrictEq++stneq :: Default a => Expression a -> Expression a -> Expression a+stneq = infixe OpStrictNEq++land :: Default a => Expression a -> Expression a -> Expression a+land = infixe OpLAnd++lor :: Default a => Expression a -> Expression a -> Expression a+lor = infixe OpLOr++mul :: Default a => Expression a -> Expression a -> Expression a+mul = infixe OpMul++div :: Default a => Expression a -> Expression a -> Expression a+div = infixe OpDiv++mod :: Default a => Expression a -> Expression a -> Expression a+mod = infixe OpMod++sub :: Default a => Expression a -> Expression a -> Expression a+sub = infixe OpSub++lshift :: Default a => Expression a -> Expression a -> Expression a+lshift = infixe OpLShift++srshift+ :: Default a => Expression a -> Expression a -> Expression a+srshift = infixe OpSpRShift++zrshift+ :: Default a => Expression a -> Expression a -> Expression a+zrshift = infixe OpZfRShift++band :: Default a => Expression a -> Expression a -> Expression a+band = infixe OpBAnd++bor :: Default a => Expression a -> Expression a -> Expression a+bor = infixe OpBOr++xor :: Default a => Expression a -> Expression a -> Expression a+xor = infixe OpBXor++add :: Default a => Expression a -> Expression a -> Expression a+add = infixe OpAdd++cond+ :: Default a =>+ Expression a -> Expression a -> Expression a -> Expression a+cond = CondExpr def++assignop :: Default a => AssignOp -> LValue a -> Expression a -> Expression a+assignop = AssignExpr def++assign+ :: Default a => LValue a -> Expression a -> Expression a+assign = assignop OpAssign++assignadd :: Default a => LValue a -> Expression a -> Expression a+assignadd = assignop OpAssignAdd++assignsub :: Default a => LValue a -> Expression a -> Expression a+assignsub = assignop OpAssignSub++assignmul :: Default a => LValue a -> Expression a -> Expression a+assignmul = assignop OpAssignMul++assigndiv :: Default a => LValue a -> Expression a -> Expression a+assigndiv = assignop OpAssignDiv++assignmod :: Default a => LValue a -> Expression a -> Expression a+assignmod = assignop OpAssignMod++assignlshift+ :: Default a => LValue a -> Expression a -> Expression a+assignlshift = assignop OpAssignLShift++assignsrshift+ :: Default a => LValue a -> Expression a -> Expression a+assignsrshift = assignop OpAssignSpRShift++assignzrshift+ :: Default a => LValue a -> Expression a -> Expression a+assignzrshift = assignop OpAssignZfRShift++assignband :: Default a => LValue a -> Expression a -> Expression a+assignband = assignop OpAssignBAnd++assignxor :: Default a => LValue a -> Expression a -> Expression a+assignxor = assignop OpAssignBXor++assignbor :: Default a => LValue a -> Expression a -> Expression a+assignbor = assignop OpAssignBOr++list :: Default a => [Expression a] -> Expression a+list = ListExpr def++call :: Default a => Expression a -> [Expression a] -> Expression a+call = CallExpr def++func+ :: Default a => Id a -> [Id a] -> [Statement a] -> Expression a+func id = FuncExpr def (Just id)++lambda :: Default a => [Id a] -> [Statement a] -> Expression a+lambda = FuncExpr def Nothing++casee :: Default a => Expression a -> [Statement a] -> CaseClause a+casee = CaseClause def++defaultc :: Default a => [Statement a] -> CaseClause a+defaultc = CaseDefault def++catch :: Default a => Id a -> Statement a -> CatchClause a+catch = CatchClause def++vardecl :: Default a => Id a -> VarDecl a+vardecl id = VarDecl def id Nothing++varinit :: Default a => Id a -> Expression a -> VarDecl a+varinit id = VarDecl def id . Just++block :: Default a => [Statement a] -> Statement a+block = BlockStmt def++empty :: Default a => Statement a+empty = EmptyStmt def++expr :: Default a => Expression a -> Statement a+expr = ExprStmt def++ifte+ :: Default a =>+ Expression a -> Statement a -> Statement a -> Statement a+ifte = IfStmt def++ift :: Default a => Expression a -> Statement a -> Statement a+ift = IfSingleStmt def++switch+ :: Default a => Expression a -> [CaseClause a] -> Statement a+switch = SwitchStmt def++while :: Default a => Expression a -> Statement a -> Statement a+while = WhileStmt def++dowhile :: Default a => Statement a -> Expression a -> Statement a+dowhile = DoWhileStmt def++break :: Default a => Maybe (Id a) -> Statement a+break = BreakStmt def++continue :: Default a => Maybe (Id a) -> Statement a+continue = ContinueStmt def++label :: Default a => Id a -> Statement a -> Statement a+label = LabelledStmt def++forin+ :: Default a =>+ ForInInit a -> Expression a -> Statement a -> Statement a+forin = ForInStmt def++for+ :: Default a =>+ ForInit a+ -> Maybe (Expression a)+ -> Maybe (Expression a)+ -> Statement a+ -> Statement a+for = ForStmt def++try :: Default a => Statement a -> Statement a+try b = TryStmt def b Nothing Nothing++trycatch+ :: Default a =>+ Statement a -> CatchClause a -> Maybe (Statement a) -> Statement a+trycatch b c = TryStmt def b (Just c)++tryfinally+ :: Default a => Statement a -> Statement a -> Statement a+tryfinally b f = TryStmt def b Nothing (Just f)++trycatchfinally+ :: Default a =>+ Statement a -> CatchClause a -> Statement a -> Statement a+trycatchfinally b c f = TryStmt def b (Just c) (Just f)++throw :: Default a => Expression a -> Statement a+throw = ThrowStmt def++returns :: Default a => Expression a -> Statement a+returns = ReturnStmt def . Just++ret :: Default a => Statement a+ret = ReturnStmt def Nothing++with :: Default a => Expression a -> Statement a -> Statement a+with = WithStmt def++vardecls :: Default a => [VarDecl a] -> Statement a+vardecls = VarDeclStmt def++function+ :: Default a => Id a -> [Id a] -> [Statement a] -> Statement a+function = FunctionStmt def++-- | Convert an identifier to a String literal+id2string :: Id a -> Expression a+id2string (Id a s) = StringLit a s++-- | Helper function to convert LValues to expressions+lv2e :: LValue a -> Expression a+lv2e lval = case lval of+ LVar a vname -> VarRef a (Id a vname)+ LDot a obj fname -> DotRef a obj (Id a fname)+ LBracket a obj field -> BracketRef a obj field++-- | Convert an expression to an l-value. May fail with an error+e2lv :: Expression a -> LValue a+e2lv e = case e of+ VarRef a (Id _ vname) -> LVar a vname+ DotRef a obj (Id _ fname) -> LDot a obj fname+ BracketRef a obj field -> LBracket a obj field+ _ -> error "expr2LVal: Can't convert an expression to an LValue"+ +forInInit2lv :: ForInInit a -> LValue a+forInInit2lv i = case i of+ ForInVar (Id a s) -> LVar a s+ ForInLVal lv -> lv