@@ -25,6 +25,7 @@ import Data.Char import Data.Map (Map) import qualified Data.Map as Map import Data.Tree +import Data.Generics -- not Haskel 98 -- data showd :: CToken -> String @@ -71,71 +72,71 @@ data PrimaryE = PEThis CToken -- this | PEXml CToken | PEFunc FuncE | PEParens CToken ListE CToken -- (, List of expressions , ) - deriving (Show) + deriving (Show, Data, Typeable) data ListE = ListE [(AssignE, (Maybe CToken))] - deriving (Show) + deriving (Show, Data, Typeable) data ArrayLit = ArrayLitC CToken (Maybe Elision) CToken -- [, maybe commas, ] | ArrayLit CToken ElementList CToken -- [, element list, ] - deriving (Show) + deriving (Show, Data, Typeable) data ElementList = El (Maybe Elision) AssignE [EAE] (Maybe Elision) - deriving (Show) + deriving (Show, Data, Typeable) data EAE = EAE Elision AssignE - deriving (Show) + deriving (Show, Data, Typeable) data Elision = Elision [CToken] -- commas possible separated by space in a list - deriving (Show) + deriving (Show, Data, Typeable) -data ObjectLit = ObjectLit CToken (Maybe PropertyList) CToken deriving (Show) +data ObjectLit = ObjectLit CToken (Maybe PropertyList) CToken deriving (Show, Data, Typeable) -data PropertyList = PropertyList [(CToken, CToken, AssignE, (Maybe CToken))] deriving (Show) -- [propertyName, :, assignE, maybe ','] +data PropertyList = PropertyList [(CToken, CToken, AssignE, (Maybe CToken))] deriving (Show, Data, Typeable) -- [propertyName, :, assignE, maybe ','] -data FuncE = FuncE CToken (Maybe CToken) Signature BlockItem deriving (Show) -- function, maybe ident, signature, block +data FuncE = FuncE CToken (Maybe CToken) Signature BlockItem deriving (Show, Data, Typeable) -- function, maybe ident, signature, block data Arguments = Arguments CToken (Maybe ListE) CToken - deriving (Show) + deriving (Show, Data, Typeable) data SuperE = SuperE CToken (Maybe Arguments) - deriving (Show) + deriving (Show, Data, Typeable) data PostFixE = PFFull FullPostFixE (Maybe CToken) | PFShortNew ShortNewE (Maybe CToken) - deriving (Show) + deriving (Show, Data, Typeable) data FullPostFixE = FPFPrimary PrimaryE [FullPostFixSubE] | FPFFullNew FullNewE [FullPostFixSubE] | FPFSuper SuperE PropertyOp [FullPostFixSubE] | FPFInc PostFixE CToken | FPFDec PostFixE CToken - deriving (Show) + deriving (Show, Data, Typeable) data FullPostFixSubE = FPSProperty PropertyOp | FPSArgs Arguments | FPSQuery QueryOp - deriving (Show) + deriving (Show, Data, Typeable) data FullNewE = FN CToken FullNewE Arguments | FNPrimary PrimaryE [PropertyOp] | FNSuper SuperE [PropertyOp] - deriving (Show) + deriving (Show, Data, Typeable) data ShortNewE = SN CToken ShortNewSubE - deriving (Show) + deriving (Show, Data, Typeable) data ShortNewSubE = SNSFull FullNewE | SNSShort ShortNewE - deriving (Show) + deriving (Show, Data, Typeable) data PropertyOp = PropertyOp CToken CToken -- . , identifier | PropertyB CToken ListE CToken -- [ list expression ] - deriving (Show) + deriving (Show, Data, Typeable) data QueryOp = QueryOpDD CToken CToken | QueryOpD CToken CToken ListE CToken - deriving (Show) + deriving (Show, Data, Typeable) data UnaryE = UEPrimary PostFixE | UEDelete CToken PostFixE @@ -147,27 +148,27 @@ data UnaryE = UEPrimary PostFixE | UEMinus CToken UnaryE | UEBitNot CToken UnaryE | UENot CToken UnaryE - deriving (Show) + deriving (Show, Data, Typeable) data AritE = AEUnary UnaryE | AEBinary CToken AritE AritE - deriving (Show) + deriving (Show, Data, Typeable) data RegE = RegE CToken [CToken] CToken (Maybe CToken) - deriving (Show) + deriving (Show, Data, Typeable) data CondE = CondE AritE (Maybe (CToken, AssignE, CToken, AssignE)) | CondRE RegE - deriving (Show) + deriving (Show, Data, Typeable) data NAssignE = NAssignE AritE (Maybe (CToken, NAssignE, CToken, NAssignE)) - deriving (Show) + deriving (Show, Data, Typeable) data AssignE = ACond CondE | AAssign PostFixE CToken AssignE | ACompound PostFixE CToken AssignE | ALogical PostFixE CToken AssignE - deriving (Show) + deriving (Show, Data, Typeable) data BlockItem = Tok CToken | Expr AssignE @@ -179,32 +180,32 @@ data BlockItem = Tok CToken | VarS (Maybe [CToken]) CToken [VarBinding] -- maybe attributes, var, varbindings | ForS CToken CToken (Maybe ForInit) CToken (Maybe ListE) CToken (Maybe ListE) CToken BlockItem -- for( ? ; ? ; ?) {} | Metadata Metadata - deriving (Show) + deriving (Show, Data, Typeable) data Metadata = MDSwf [(CToken, CToken)] | MD CToken CToken [CToken] CToken - deriving (Show) + deriving (Show, Data, Typeable) data ForInit = FIListE ListE | FIVarS BlockItem - deriving (Show) + deriving (Show, Data, Typeable) data VarBinding = VarBinding CToken CToken AsType (Maybe (CToken, AssignE)) (Maybe CToken) -- identifier, :, datatype, (maybe (=, assignE)), maybe ',' - deriving (Show) + deriving (Show, Data, Typeable) data Signature = Signature CToken [Arg] CToken (Maybe (CToken, AsType)) -- left paren, arguments, right paren, :, return type - deriving (Show) + deriving (Show, Data, Typeable) data Arg = Arg CToken CToken AsType (Maybe (CToken, AssignE)) (Maybe CToken) -- arg name, :, type, maybe default value, maybe comma | RestArg CToken CToken (Maybe (CToken, AsType)) -- ..., name - deriving (Show) + deriving (Show, Data, Typeable) data Package = Package CToken CToken (Maybe CToken) BlockItem -- whitespace, package, maybe name, block - deriving (Show) + deriving (Show, Data, Typeable) data Ast = AS3Program Package AsState | AS3Directives [BlockItem] AsState - deriving (Show) + deriving (Show, Data, Typeable) type AsParser = Parsec TList AsState @@ -214,7 +215,7 @@ data AsType = AsType CToken | AsTypeRest | AsTypeUser CToken | AsTypeUnknown - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Data, Typeable) -- Symbol Lookup key data AsDef = DefPackage Name @@ -224,7 +225,7 @@ data AsDef = DefPackage Name | DefVar Name -- can be for constants too | DefNamespace Name | DefNone - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Data, Typeable) type Attribute = String -- Symbol Lookup value @@ -232,15 +233,15 @@ data AsDefInfo = DiNone -- | DiClass [Attribute] (Maybe AsDef) (Maybe [AsDef]) -- attributes, extends, implements | DiFunction [Attribute] | DiVar AsType - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Data, Typeable) type AsDefTuple = (AsDef, AsDefInfo) data AsStateEl = AsStateEl { sid::Int, scope::Map AsDef AsDefInfo } - deriving (Show) + deriving (Show, Data, Typeable) data AsState = AsState{ filename::String, outfile::String, curId::Int, flags::Map String String, accessors::Map String (AsType, Bool, Bool), initMembers::[String], path::[Int], scopes::Tree AsStateEl } - deriving (Show) + deriving (Show, Data, Typeable) initState :: AsState initState = AsState{ filename = "", outfile = "", curId = 0, path = [0], flags = Map.empty, accessors = Map.empty, initMembers = [], scopes = newScope 0} ActionhaXe/Data.hs @@ -17,7 +17,7 @@ -} -- Turn the as3 source into Tokens for parsing -module ActionhaXe.Lexer (runLexer, Token, tokenSource, tokenLine, tokenCol, tokenItem, tokenItemS, TokenType(..), TokenNum(..), keywords, operators) where +module ActionhaXe.Lexer (runLexer, Token, tokenSource, tokenLine, tokenCol, tokenItem, tokenItemS, TPos(..), TokenType(..), TokenNum(..), keywords, operators) where import Text.Parsec import Text.Parsec.String (Parser) @@ -25,12 +25,16 @@ import Text.Parsec.Char import Text.Parsec.Perm import Data.Char import Data.List +import Data.Generics -- not Haskell '98 -type Token = (SourcePos, TokenType) +type Token = (TPos, TokenType) -tokenSource (s, i) = sourceName s -tokenLine (s, i) = sourceLine s -tokenCol (s, i) = sourceColumn s +data TPos = TPos SourceName Line Column + deriving (Show, Eq, Ord, Data, Typeable) + +tokenSource ((TPos s l c), i) = s +tokenLine ((TPos s l c), i) = l +tokenCol ((TPos s l c), i) = c tokenItem (s, i) = i tokenItemS (p, i) = case i of @@ -44,7 +48,6 @@ tokenItemS (p, i) = case i of TokenIdent s -> s TokenString s -> s TokenNl s -> s --- TokenRegex (s,s') -> s++s' TokenEscaped s -> s TokenXml s -> s TokenKw s -> s @@ -55,7 +58,7 @@ data TokenNum = TokenInteger String | TokenDouble String | TokenOctal String | TokenHex String - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Data, Typeable) data TokenType = TokenWhite String @@ -64,13 +67,12 @@ data TokenType = | TokenIdent String | TokenString String | TokenNl String --- | TokenRegex (String, String) | TokenEscaped String | TokenKw String | TokenOp String | TokenXml String | TokenUnknown String - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Data, Typeable) keywords = [ "...", "as", "break", "case", "catch", "class", "const", "continue", "default", "delete", "do", "else", "extends", "false", "finally", "for", "function", "if", @@ -133,12 +135,6 @@ xml = do{ char '<'; t <- many1 (satisfy (\c -> isPrint c && c /= '>')); char '>' xmlSTag = do{ char '<'; t <- manyTill (satisfy (\c -> isPrint c && c /= '/' && c /= '>')) (string "/>"); return $ TokenXml $ "<"++t++"/>"} -{- -regexOptions = permute (catter <$?> ('_', char 'g') <|?> ('_', char 'i') <|?> ('_', char 'm') <|?> ('_', char 's') <|?> ('_', char 'x')) - where catter g i m s x = filter (\c -> c /= '_') [g, i, m, s, x] -regex = do { char '/'; notFollowedBy (char ' '); s <- manyTill escapedAnyChar (char '/'); o <- optionMaybe regexOptions; return $ maybe (TokenRegex ("/"++(concat s)++"/", "")) (\m -> TokenRegex ("/"++(concat s)++"/", m)) o} --} - number = try (do{ char '0'; char 'x'; x <- many1 hexDigit; return $ TokenNum $ TokenHex $ "0x"++x}) <|> try (do{ char '0'; x <- many1 octDigit; return $ TokenNum $ TokenOctal $ "0"++x}) <|> try (do{ x <- double; return $ TokenNum $ TokenDouble $ x }) @@ -164,7 +160,6 @@ atoken = <|> try (do{ x <- commentMLine; return x}) <|> try (do{ x <- xmlSTag; return x}) <|> try (do{ x <- xml; return x}) --- <|> try (do{ x <- regex; return x}) <|> try (do{ x <- escapedCharToken; return x}) <|> try (do{ x <- number; return x}) <|> try (do{ x <- operator; return x}) @@ -175,7 +170,7 @@ atoken = <|> do{ x <- anyToken; return $ TokenUnknown $ x:[]} -lexer = many1 (do { p <- getPosition; t <- atoken; return (p, t) }) +lexer = many1 (do { p <- getPosition; t <- atoken; return (TPos (sourceName p) (sourceLine p) (sourceColumn p), t) }) runLexer :: String -> String -> [Token] runLexer filename s = case parse lexer filename s of ActionhaXe/Lexer.hs @@ -155,7 +155,7 @@ methodAttributes = permute $ list <$?> (emptyctok, (try (kw "public") <|> try (k signature = do{ lp <- op "("; a <- sigargs; rp <- op ")"; ret <- optionMaybe ( do{ o <- op ":"; r <- datatype; return (o, r)}); return $ Signature lp a rp ret} -- missing return type means constructor sigargs = do{ s <- many sigarg; return s} -sigarg = try(do{ a <- idn; o <- op ":"; t <- datatype; d <- optionMaybe( do{ o' <- op "="; a <- assignE; return $ (o, a)}); c <- optionMaybe(op ","); storeVar a t; return $ Arg a o t d c}) +sigarg = try(do{ a <- idn; o <- op ":"; t <- datatype; d <- optionMaybe( do{ o <- op "="; a <- assignE; return $ (o, a)}); c <- optionMaybe(op ","); storeVar a t; return $ Arg a o t d c}) <|> do{ d <- op "..."; i <- idn; t <- optionMaybe (do{ o <- op ":"; t <- datatype; return (o, t)}); storeVar i AsTypeRest; return $ RestArg d i t } {- ActionhaXe/Parser.hs @@ -21,13 +21,13 @@ import ActionhaXe.Lexer import ActionhaXe.Data import Text.Parsec import Text.Parsec.Prim +import Text.Parsec.Pos mytoken :: (Token -> Maybe a) -> AsParser a mytoken test = token showTok posFromTok testTok - where - showTok (pos, t) = show t - posFromTok (pos, t) = pos - testTok t = test t + where showTok (pos, t) = show t + posFromTok a@(pos, t) = newPos (tokenSource a) (tokenLine a) (tokenCol a) + testTok t = test t anytok' = mytoken $ \t -> Just [t] @@ -65,12 +65,6 @@ str' = mytoken $ \t -> case tokenItem t of TokenString x -> Just [t] _ -> Nothing -{- -reg' = mytoken $ \t -> case tokenItem t of - TokenRegex x -> Just [t] - _ -> Nothing --} - kw' k = mytoken $ \t -> case tokenItem t of TokenKw k'| k == k' -> Just [t] _ -> Nothing @@ -86,7 +80,6 @@ xml' = mytoken $ \t -> case tokenItem t of idn = mylexeme $ id' num = mylexeme $ num' str = mylexeme $ str' ---reg = mylexeme $ reg' xml = mylexeme $ xml' mid i = mylexeme $ mid' i ActionhaXe/Prim.hs @@ -29,6 +29,7 @@ import Control.Monad.State import Data.Foldable (foldlM, foldrM) import Data.List (intercalate) import Data.Char (toUpper, isAlphaNum) +import Data.Generics -- not Haskell 98 -- flags mainPackage = "mainPackage" @@ -245,7 +246,8 @@ signature (Signature l args r ret) = do{ a <- showArgs args showArgs as = do{ as' <- mapM showArg as; return $ concat as'} where showArg (Arg n c t i mc) = do{ i' <- maybe (return "") (\(o, e) -> do{ e' <- assignE e; return $ showb o ++ e'}) i - ; return $ (case i of{ Just d -> "?"; Nothing -> ""}) ++ showb n ++ showb c ++ datatype t ++ i' ++ maybeEl showb mc + ; t' <- datatypeiM t i + ; return $ (case i of{ Just d -> "?"; Nothing -> ""}) ++ showb n ++ showb c ++ t' ++ i' ++ maybeEl showb mc } showArg (RestArg o n t) = do{ return $ showd n ++ ":Array<Dynamic>"} @@ -260,8 +262,12 @@ varBinding :: VarBinding -> Bool -> StateT AsState IO String varBinding (VarBinding n c d i s) initMember = do{ i' <- maybe (return "") (\(o, e) -> do{ e' <- assignE e; return $ showb o ++ e'}) i; ; if i' /= "" && initMember - then do{ insertInitMember $ showb n ++ (if last(showb n) == ' ' then "" else " ") ++ i' ++ ";"; return $ showl [n,c] ++ datatype d ++ maybeEl showb s} - else return $ showl [n,c] ++ datatype d ++ i' ++ maybeEl showb s + then do{ insertInitMember $ showb n ++ (if last(showb n) == ' ' then "" else " ") ++ i' ++ ";" + ; d' <- datatypeiM d i + ; return $ showl [n,c] ++ d' ++ maybeEl showb s} + else do{ d' <- datatypeiM d i + ; return $ showl [n,c] ++ d' ++ i' ++ maybeEl showb s + } } namespace ns = case ns of @@ -270,23 +276,60 @@ namespace ns = case ns of datatypet d = span (\c -> isAlphaNum c || c =='>' || c == '<') (datatype d) -datatype d = case d of - AsType n -> (case (showd n) of - "void" -> "Void" - "Boolean" -> "Bool" - "uint" -> "UInt" - "int" -> "Int" - "Number" -> "Float" - "String" -> "String" - "*" -> "Dynamic" - "Object" -> "Dynamic" - "Function"-> "Dynamic" - "Array" -> "Array<Dynamic>" - "XML" -> "Xml" - "RegExp" -> "EReg" - ) ++ showw n - AsTypeRest -> "Array<Dynamic>" - AsTypeUser n -> showb n +datatype d = + case d of + AsType n -> (case (showd n) of + "void" -> "Void" + "Boolean" -> "Bool" + "uint" -> "UInt" + "int" -> "Int" + "Number" -> "Number" + "String" -> "String" + "*" -> "Dynamic" + "Object" -> "Dynamic" + "Function"-> "Dynamic" + "Array" -> "Array<Dynamic>" + "XML" -> "XML" + "RegExp" -> "EReg" + ) ++ showw n + AsTypeRest -> "Array<Dynamic>" + AsTypeUser n -> showb n + +datatypeiM d Nothing = return $ datatype d +datatypeiM d i = + case d of + AsType n -> do{ r <- case (showd n) of + "void" -> return "Void" + "Boolean" -> return "Bool" + "uint" -> return "UInt" + "int" -> return "Int" + "Number" -> do{ case i of + Just (o, e) -> do{ case (hasFloat e) of + True -> return "Float" + False -> return "Int" + } + Nothing -> return "Float" + } + "String" -> return "String" + "*" -> return "Dynamic" + "Object" -> return "Dynamic" + "Function"-> return "Dynamic" + "Array" -> return "Array<Dynamic>" + "XML" -> return "XML" + "RegExp" -> return "EReg" + ; return $ r ++ showw n + } + AsTypeRest -> return $ "Array<Dynamic>" + AsTypeUser n -> return $ showb n +{- AsTypeNone -> case i of + Just (o, e) -> + Nothing -> "Dynamic" +-} + +hasFloat = everything (||) (False `mkQ` isFloat) + +isFloat (TokenDouble x) = True +isFloat _ = False primaryE x = case x of PEThis x -> do{ return $ showb x} @@ -294,7 +337,6 @@ primaryE x = case x of PELit x -> do{ return $ showb x} PEArray x -> do{ r <- arrayLit x; return r} PEObject x -> do{ r <- objectLit x; return r} --- PERegex x -> do{ return $ "~" ++ showb x} PEXml x -> do{ return $ "Xml.parse(\""++ showd x ++ "\")" ++ showw x} PEFunc x -> do{ r <- funcE x; return r} PEParens l x r -> do{ v <- listE x; return $ showb l ++ v ++ showd r ++ showw r} @@ -381,6 +423,7 @@ aritENoIn = aritE binaryE (AEBinary o x y) | showd o == "as" = do{ x' <- aritE x >>= (\c -> return $ splitLR c); y' <- aritE y >>= (\c -> return $ splitLR c); return $ "cast( "++ (x'!!1) ++", "++ (y'!!1) ++")" ++ (y'!!2) } + | showd o == "is" = do{ x' <- aritE x >>= (\c -> return $ splitLR c); y' <- aritE y >>= (\c -> return $ splitLR c); return $ "Std.is( "++ (x'!!1) ++", "++ (y'!!1) ++")" ++ (y'!!2) } | otherwise = do{ x' <- aritE x; y' <- aritE y; return $ x' ++ showb o ++ y'} ActionhaXe/Translator.hs @@ -18,16 +18,17 @@ module Main where import ActionhaXe.Lexer -import Text.Parsec.Pos + import System.Environment (getArgs) import Text.PrettyPrint -format s a = parens (hcat [text (sourceName s), space, int (sourceLine s), colon, int (sourceColumn s) ]) <+> text a +format:: Token -> Doc +format t = parens (hcat [text (tokenSource t), space, int (tokenLine t), colon, int (tokenCol t) ]) <+> text (tokenItemS t) -unknowns ts = [ format s a | t@(s, TokenUnknown a) <- ts] -comments ts = [ format s a | t@(s, TokenComment a) <- ts] -strings ts = [ format s a | t@(s, TokenString a) <- ts] -xmls ts = [ format s a | t@(s, TokenXml a) <- ts] +unknowns ts = [ format t | t@(s, TokenUnknown a) <- ts] +comments ts = [ format t | t@(s, TokenComment a) <- ts] +strings ts = [ format t | t@(s, TokenString a) <- ts] +xmls ts = [ format t | t@(s, TokenXml a) <- ts] main = do args <- getArgs let filename = args!!0 Tokenize.hs as3tohaxe e28d78f96509867655b77b22d591886eb50a7d9d Don-Duong Quach geekrelief@gmail.com http://github.com/geekrelief/as3tohaxe/commit/634f524eb11229c429bf45d5a924cd2ee2539720 634f524eb11229c429bf45d5a924cd2ee2539720 2008-10-22T23:16:29-07:00 2008-10-22T23:16:29-07:00 Added generics support to dive throught the AST and Number translation with initializer hinting i.e. (a:Number = -1.0, b:Number = 10) => (a:Float = -1.0, b:Int = 10) a61c724e35d97a4926eafb57fe98439d0cdfb661 Don-Duong Quach geekrelief@gmail.com