= [1,2,3,4];
21 |
22 | var a:Int = 0;
23 | var i:Int = (a);
24 |
25 | var f:Dynamic = function ():String { return "f";};
26 |
27 | txt.appendText(a+" "+i+" "+ f());
28 |
29 | addChild(txt);
30 |
31 | if (o.msg == "hello") {
32 | trace("in if block");
33 | }
34 | }
35 | }
36 |
--------------------------------------------------------------------------------
/samples/Test.as:
--------------------------------------------------------------------------------
1 | package
2 | {
3 | import flash.display.Sprite;
4 | import flash.text.TextField;
5 |
6 | public class Test extends Sprite
7 | {
8 | public function Test(){
9 | var txt:TextField = new TextField();
10 |
11 | var o:Object = {red:0xFF0000, green:0x00FF00, blue:0x0000FF, msg:"hello"};
12 |
13 | var r:RegExp = /hello/gi;
14 |
15 | var x:XML =
16 |
17 | ;
18 |
19 | //txt.text = o.red;
20 | var ar:Array = [1,2,3,4];
21 |
22 | var a:int = 0;
23 | var i:int = (a);
24 |
25 | var f:Function = function lambda():String { return "f";};
26 |
27 | txt.appendText(a+" "+i+" "+ f());
28 |
29 | addChild(txt);
30 |
31 | if (o.msg == "hello") {
32 | trace("in if block");
33 | }
34 | }
35 | }
36 | }
37 |
--------------------------------------------------------------------------------
/Parseit.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | -- Parse a file
19 |
20 | import ActionhaXe.Lexer
21 | import ActionhaXe.Prim
22 | import ActionhaXe.Parser
23 | import System.Environment (getArgs)
24 |
25 |
26 |
27 | main = do args <- getArgs
28 | let filename = args!!0
29 | contents <- readFile filename
30 | let tokens = runLexer "" contents
31 | case parseTokens filename tokens of
32 | Right ast -> print ast
33 | Left err -> print err
34 |
--------------------------------------------------------------------------------
/README:
--------------------------------------------------------------------------------
1 | as3tohaxe - An Actionscript 3 to haXe source file converter written in Haskell
2 | Copyright (C) 2008-2009 Don-Duong Quach
3 |
4 | This is NOT a complete converter. It is not possible for haXe to override the
5 | getters and setters of native Flash classes (e.g. Sprite), so converting your
6 | as3 code to haxe completely is not possible as far as I know.
7 |
8 | So I stopped working on the project, but the code and executable may still be
9 | useful to someone.
10 |
11 | For more info check visit:
12 | http://www.github.com/geekrelief/as3tohaxe
13 | http://geekrelief.wordpress.com
14 |
15 | -- Running --
16 | Type 'as3tohaxe' and a directory or file to convert.
17 | A directory named "hx_output" will be created in the current
18 | directory if necessary. The supplied ".as" files will be
19 | translated into haxe files and stored there. If the command
20 | is run more than once, and pre-existing files will be overwritten.
21 |
22 | -- Binary --
23 | Binaries for Mac OSX Leopard and Windows are available under
24 | the Files section of the as3tohaxe google group.
25 |
26 | -- Compiling --
27 | Requirements
28 | - The source http://www.github.com/geekrelief/as3tohaxe
29 | - GHC (6.10.1, 6.8.3) http://www.haskell.org/ghc/
30 | - Cabal (1.6.0.1) for parsec http://www.haskell.org/cabal/
31 | - parsec 3 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/parsec
32 |
33 | Compile with: ghc --make -XDeriveDataTypeable as3tohaxe.hs
34 | or the './build' script
35 |
36 | -- License --
37 | This program and its source is GPL licensed. Please read the LICENSE
38 | for more details.
39 |
--------------------------------------------------------------------------------
/Tokenize.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | module Main where
19 |
20 | import ActionhaXe.Lexer
21 |
22 | import System.Environment (getArgs)
23 | import Text.PrettyPrint
24 |
25 | format:: Token -> Doc
26 | format t = parens (hcat [text (tokenSource t), space, int (tokenLine t), colon, int (tokenCol t) ]) <+> text (tokenItemS t)
27 |
28 | unknowns ts = [ format t | t@(s, TokenUnknown a) <- ts]
29 | comments ts = [ format t | t@(s, TokenComment a) <- ts]
30 | strings ts = [ format t | t@(s, TokenString a) <- ts]
31 | xmls ts = [ format t | t@(s, TokenXml a) <- ts]
32 |
33 | main = do args <- getArgs
34 | let filename = args!!0
35 | contents <- readFile filename
36 | let tokens = runLexer "" contents
37 | putStrLn $ render $ hcat $ punctuate (text "\n") $ unknowns tokens
38 | putStrLn "\n\nTokenized--"
39 | print tokens
40 |
41 |
--------------------------------------------------------------------------------
/ActionhaXe/CLArgs.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | module ActionhaXe.CLArgs (CLArg(..), Conf(..), clargs) where
19 |
20 | import System.Console.ParseArgs
21 | import Data.Generics
22 | import Data.Map
23 |
24 | data CLArg = NumberToInt
25 | | NoCarriage
26 | | CreateImports
27 | | Input
28 | | OutputDir
29 | deriving (Eq, Ord, Show, Data, Typeable)
30 |
31 | data Conf = Conf{ confArgs::Args CLArg, confInput::String, confOutput::String, imports::Map String [String] }
32 | | ConfNone
33 | deriving (Show, Data, Typeable)
34 |
35 | initArg f desc = Arg{ argIndex = f, argAbbr = Nothing, argName = Nothing, argData = Nothing, argDesc = desc }
36 |
37 | clargs =
38 | [
39 | (initArg NumberToInt "translate :Number to :Int (default :Float)"){ argAbbr = Just 'i', argName = Just "intnum" }
40 | , (initArg NoCarriage "remove carriage returns '\\r' in output"){ argAbbr = Just 'r', argName = Just "nocarriage" }
41 | , (initArg CreateImports "creates \"Import\" files in place of * imports (e.g. import a.*;)"){ argAbbr= Just 'c', argName = Just "imports" }
42 | , (initArg Input "input to convert") { argData = argDataRequired "directory | file" ArgtypeString }
43 | ]
44 |
--------------------------------------------------------------------------------
/samples/AsWingApplication.as:
--------------------------------------------------------------------------------
1 | /**
2 | * author: Alva sun
3 | * site : www.alvas.cn
4 | *
5 | * need AsWingA3
6 | * 2007-05-07
7 | */
8 | package example
9 | {
10 | import flash.display.Sprite;
11 | import flash.events.Event;
12 | import flash.events.MouseEvent;
13 |
14 | import org.aswing.BorderLayout;
15 | import org.aswing.FlowLayout;
16 | import org.aswing.GridLayout;
17 | import org.aswing.Insets;
18 | import org.aswing.JButton;
19 | import org.aswing.JFrame;
20 | import org.aswing.JLabel;
21 | import org.aswing.JPanel;
22 | import org.aswing.border.EmptyBorder;
23 | import org.aswing.geom.IntDimension;
24 |
25 | public class AsWingApplication extends Sprite
26 | {
27 | private static var labelPrefix : String = "Number of button clicks: ";
28 | private var numClicks : int = 0;
29 | private var label : JLabel;
30 | private var button : JButton;
31 |
32 | public function AsWingApplication(){
33 | super();
34 | createUI();
35 | }
36 |
37 | private function createUI() : void{
38 | var frame : JFrame = new JFrame( this, "AsWingApplication" );
39 | frame.getContentPane().append( createCenterPane() );
40 | frame.setSize(new IntDimension( 200, 120 ) );
41 | frame.show();
42 | }
43 |
44 | private function createCenterPane() : JPanel{
45 | var pane : JPanel = new JPanel(new FlowLayout(FlowLayout.CENTER));
46 | label = new JLabel(labelPrefix+"0");
47 | button = new JButton("I'm a AsWing button!");
48 | pane.append(button);
49 | pane.append(label);
50 | pane.setBorder(new EmptyBorder(null, new Insets(10,5,10,5)));
51 | initHandlers();
52 | return pane;
53 | }
54 |
55 | private function initHandlers() : void{
56 | //button.addActionListener( __pressButton );
57 | button.addEventListener(MouseEvent.MOUSE_UP, __pressButton);
58 | }
59 |
60 | private function __pressButton( e : Event ) : void{
61 | numClicks++;
62 | label.setText(labelPrefix+numClicks);
63 | label.revalidate();
64 | }
65 | }
66 | }
67 |
--------------------------------------------------------------------------------
/Lexitall.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | module Main where
19 |
20 | import ActionhaXe.Lexer
21 | import Text.Parsec.Pos
22 | import System.Environment (getArgs)
23 | import Text.PrettyPrint
24 | import System.Directory
25 | import Data.Char
26 | import Data.List
27 | import Control.Monad
28 |
29 | format s a = parens (hcat [text (sourceName s), space, int (sourceLine s), colon, int (sourceColumn s) ]) <+> text a
30 |
31 | {-
32 | unknowns ts = [ format s a | t@(s, TokenUnknown a) <- ts]
33 | comments ts = [ format s a | t@(s, TokenComment a) <- ts]
34 | strings ts = [ format s a | t@(s, TokenString a) <- ts]
35 | xmls ts = [ format s a | t@(s, TokenXml a) <- ts]
36 | regexs ts = [ format s (r1++"/"++r2) | t@(s, TokenRegex (r1,r2)) <- ts]
37 | -}
38 |
39 | unknowns ts = [ t | t@(s, TokenUnknown a) <- ts]
40 | comments ts = [ t | t@(s, TokenComment a) <- ts]
41 | strings ts = [ t | t@(s, TokenString a) <- ts]
42 | xmls ts = [ t | t@(s, TokenXml a) <- ts]
43 | regexs ts = [ t | t@(s, TokenRegex (r1,r2)) <- ts]
44 |
45 | inRange (s, _) (t, _) = linet > lines - 3 && linet < lines + 3
46 | where
47 | linet = sourceLine t
48 | lines = sourceLine s
49 |
50 | getContext ftoken tokens = filter (\t -> inRange ftoken t) tokens
51 |
52 | displayToken tokens t = do putStrLn "Detected Unknown: "
53 | print t
54 | putStrLn "Context --"
55 | mapM_ print $ getContext t tokens
56 |
57 | renderTokens lfilter filename =
58 | do contents <- readFile filename
59 | putStrLn $ "Checking: "++filename
60 | let tokens = runLexer filename contents
61 | let ftokens = lfilter tokens
62 | if null ftokens == False
63 | then do putStrLn $ "Detected: "++filename
64 | -- putStrLn $ render $ hcat $ punctuate (text "\n") $ ftokens
65 | mapM_ (displayToken tokens) ftokens
66 | else return ()
67 |
68 | isFile f = do t <- doesFileExist f
69 | return $ t && ("as" == (map toLower $ reverse $ take 2 $ reverse f))
70 |
71 | isDir d = do t <- doesDirectoryExist d
72 | return $ t && d /= "." && d /= ".." && d /= ".svn"
73 |
74 | getASFiles dir = do contents <- getDirectoryContents dir
75 | let c = map (\e -> dir++"/"++e) (filter (\d-> d /= "." && d /="..") contents)
76 | asfiles <- filterM isFile c
77 | asdirs <- filterM isDir c
78 | childAsFiles <- mapM getASFiles asdirs
79 | if null asfiles
80 | then return $ concat childAsFiles
81 | else return $ concat (asfiles: childAsFiles)
82 |
83 |
84 | main = do args <- getArgs
85 | if isSuffixOf ".as" (args!!0)
86 | then renderTokens unknowns $ args!!0
87 | else do asFiles <- getASFiles (args!!0)
88 | mapM_ (renderTokens unknowns) asFiles
89 |
90 | {-
91 | main = do args <- getArgs
92 | renderTokens unknowns $ args!!0
93 | -}
94 |
--------------------------------------------------------------------------------
/ActionhaXe/Prim.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | module ActionhaXe.Prim where
19 |
20 | import ActionhaXe.Lexer
21 | import ActionhaXe.Data
22 | import Text.Parsec
23 | import Text.Parsec.Prim
24 | import Text.Parsec.Pos
25 |
26 | mytoken :: (Token -> Maybe a) -> AsParser a
27 | mytoken test = token showTok posFromTok testTok
28 | where showTok (pos, t) = show t
29 | posFromTok a@(pos, t) = newPos (tokenSource a) (tokenLine a) (tokenCol a)
30 | testTok t = test t
31 |
32 | anytok' = mytoken $ \t -> Just [t]
33 |
34 | white = mytoken $ \t -> case tokenItem t of
35 | TokenWhite x -> Just t
36 | _ -> Nothing
37 |
38 | nl = mytoken $ \t -> case tokenItem t of
39 | TokenNl x -> Just t
40 | _ -> Nothing
41 |
42 | com = mytoken $ \t -> case tokenItem t of
43 | TokenComment x -> Just t
44 | _ -> Nothing
45 |
46 | whiteSpace = many (white <|> nl <|> com)
47 |
48 | startWs = do{ w <- whiteSpace; return ([], w)}
49 |
50 | mylexeme p = do{ x <- p; w <- whiteSpace; return (x, w)}
51 |
52 | num' = mytoken $ \t -> case tokenItem t of
53 | TokenNum x -> Just [t]
54 | _ -> Nothing
55 |
56 | id' = mytoken $ \t -> case tokenItem t of
57 | TokenIdent x -> Just [t]
58 | _ -> Nothing
59 |
60 | mid' i = mytoken $ \t -> case tokenItem t of
61 | TokenIdent i' | i == i' -> Just [t]
62 | _ -> Nothing
63 |
64 | str' = mytoken $ \t -> case tokenItem t of
65 | TokenString x -> Just [t]
66 | _ -> Nothing
67 |
68 | kw' k = mytoken $ \t -> case tokenItem t of
69 | TokenKw k'| k == k' -> Just [t]
70 | _ -> Nothing
71 |
72 | op' o = mytoken $ \t -> case tokenItem t of
73 | TokenOp o' | o == o' -> Just [t]
74 | _ -> Nothing
75 |
76 | xml' = mytoken $ \t -> case tokenItem t of
77 | TokenXml x -> Just [t]
78 | _ -> Nothing
79 |
80 | idn = mylexeme $ id'
81 | num = mylexeme $ num'
82 | str = mylexeme $ str'
83 | xml = mylexeme $ xml'
84 |
85 | mid i = mylexeme $ mid' i
86 | kw k = mylexeme $ kw' k
87 | op o = mylexeme $ op' o
88 |
89 | -- sepByI includes the separators in the list
90 | sepByI1 :: AsParser [a] -> AsParser [a] -> AsParser [[a]]
91 | sepByI1 p sep = do{ x <- p
92 | ; xs <- many (do{ s <- sep; i<- p; return (s++i)})
93 | ; return (x:xs)
94 | }
95 |
96 | sepByCI1 :: AsParser CToken -> AsParser CToken -> AsParser [CToken]
97 | sepByCI1 p sep = do{ x <- p
98 | ; xs <- many (do{ s <- sep; i<- p; return [s,i]})
99 | ; return (x:(concat xs))
100 | }
101 |
102 | sepEndByI1 :: AsParser [a] -> AsParser [a] -> AsParser [[a]]
103 | sepEndByI1 p sep = do{ x <- sepByI1 p sep
104 | ; s <- sep
105 | ; return $ x++[s]
106 | }
107 |
108 | ident' = do{ n <- sepByI1 id' (op' "."); return (concat n)}
109 | -- ident : qualified identifier
110 | ident = mylexeme $ ident'
111 | -- sident : qualified identifier with possible * at end
112 | sident = mylexeme $ try( do{ n <- id'; ns <- many(do{ d <- op' "."; n <- (id' <|> op' "*"); return $ d++n}); return $ n ++ concat ns}) <|> ident'
113 | --sident = mylexeme $ try( do{ n <- mid' "event"; p <- op' "."; o <- op' "*"; return $ n ++ p ++ o}) <|> ident'
114 | -- nident : identifier qualified with namespace
115 | nident = mylexeme $ do{ q<- try(do{ n'<- ident'; c <- op' "::"; return $ n'++c }) <|> return []; n <- ident'; return $ q++n }
116 |
117 | anytok = mylexeme $ anytok'
118 |
119 | maybeSemi = optionMaybe $ op ";"
120 |
--------------------------------------------------------------------------------
/as3tohaxe.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | -- Translate a file
19 |
20 | import ActionhaXe.Lexer
21 | import ActionhaXe.Data
22 | import ActionhaXe.Prim
23 | import ActionhaXe.Parser
24 | import ActionhaXe.Translator
25 | import ActionhaXe.CLArgs
26 |
27 | import System.Directory
28 | import System.Environment (getArgs)
29 | import Control.Monad.State
30 | import System.Exit
31 | import Data.Char (toUpper, toLower)
32 | import Data.List (isSuffixOf, intercalate)
33 | import System.Console.ParseArgs
34 | import Data.Maybe (fromJust, fromMaybe)
35 | import System.FilePath.Posix (takeDirectory, takeBaseName, splitDirectories)
36 | import qualified Data.Map as Map
37 |
38 | translateFile :: String -> StateT Conf IO ()
39 | translateFile filename = do
40 | conf <- get
41 | let outdir = confOutput conf
42 | let dir = takeDirectory filename
43 | dirExists <- liftIO $ doesDirectoryExist (outdir ++ dir) -- check if dir exists
44 | -- create dir
45 | liftIO $ unless dirExists (createDirectoryIfMissing True (outdir++dir) >> putStrLn ("Created " ++ outdir++dir))
46 | -- add path to imports
47 | unless dirExists (put conf{ imports = (Map.insert dir [] $ imports conf) })
48 | -- add class to imports
49 | put conf{imports = (Map.insertWith (\x y -> x ++ y) dir [takeBaseName $ (toUpper $ head filename):(tail filename)] $ imports conf) }
50 | liftIO $ putStrLn $ "Translating " ++ filename
51 | contents <- liftIO $ readFile filename
52 | let updated_contents = if gotArg (confArgs conf) NoCarriage
53 | then filter ( /= '\r' ) contents -- remove carriage
54 | else contents
55 | let tokens = runLexer "" updated_contents
56 | let outfilename = outdir ++ (reverse $ "xh" ++ ( drop 2 $ reverse filename))
57 | program <- case parseTokens filename tokens of
58 | Right p@(AS3Program x st) -> return (p, st{outfile = outfilename, conf=conf })
59 | Right p@(AS3Directives x st) -> return (p, st{outfile = outfilename, conf=conf })
60 | Left err -> fail $ show err
61 | trans <- liftIO $ runStateT (translateAs3Ast (fst program)) (snd program)
62 | liftIO $ writeFile outfilename $ fst trans
63 |
64 | isFile :: String -> StateT Conf IO Bool
65 | isFile f = do conf <- get
66 | let outdir = confOutput conf
67 | t <- liftIO $ doesFileExist f
68 | let outfilename = outdir ++ (reverse $ "xh" ++ ( drop 2 $ reverse f))
69 | o <- liftIO $ doesFileExist (outfilename)
70 | when o $ liftIO $ putStrLn $ "Skipping " ++ f
71 | return $ not o && t && ("as" == (map toLower $ reverse $ take 2 $ reverse f))
72 |
73 | isDir :: String -> StateT Conf IO Bool
74 | isDir d = do t <- liftIO $ doesDirectoryExist d
75 | return $ t
76 |
77 | translateDir :: String -> StateT Conf IO ()
78 | translateDir dir = do
79 | conf <- get
80 | let outdir = confOutput conf
81 | contents <- liftIO $ getDirectoryContents dir
82 | let c = map (\e -> dir++"/"++e) (filter (\d-> d /= "." && d /=".." && d /= ".svn") contents)
83 | asfiles <- filterM isFile c
84 | asdirs <- filterM isDir c
85 | mapM_ translateFile asfiles
86 | mapM_ translateDir asdirs
87 |
88 | main = do args <- parseArgsIO ArgsTrailing clargs
89 | let input = fromJust $ getArgString args Input
90 | let outdir = fromMaybe "hx_output/" $ getArgString args OutputDir
91 | let conf = Conf{ confArgs = args , confInput = input, confOutput = outdir, imports = Map.empty}
92 | (_, updated_conf) <- if isSuffixOf ".as" input
93 | then do dirExists <- doesDirectoryExist outdir
94 | unless dirExists ((createDirectoryIfMissing True outdir) >> putStrLn ("Created " ++ outdir))
95 | runStateT (translateFile input) conf
96 | else runStateT (translateDir input) conf
97 | if gotArg (confArgs updated_conf) CreateImports
98 | then do putStrLn $ "Creating import files in "++outdir
99 | mapM_ (\(k, v)-> createImport outdir k $ reverse v) $ Map.toList $ imports updated_conf
100 | else return ()
101 |
102 | createImport outdir packagePath packageList = do let importFileName = intercalate "_" ("Import":(splitDirectories packagePath))
103 | writeFile (outdir ++ importFileName++".hx") $ packageContent packagePath packageList
104 | where packageContent path list = foldl (\content klass -> content++ "typedef "++klass++" = "++ppath++klass++"\n") "" list
105 | where ppath = (intercalate "." $ splitDirectories path)++"."
106 |
107 |
--------------------------------------------------------------------------------
/ActionhaXe/Lexer.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | -- Turn the as3 source into Tokens for parsing
19 |
20 | module ActionhaXe.Lexer (runLexer, Token, tokenSource, tokenLine, tokenCol, tokenItem, tokenItemS, TPos(..), TokenType(..), TokenNum(..), keywords, operators) where
21 |
22 | import Text.Parsec
23 | import Text.Parsec.String (Parser)
24 | import Text.Parsec.Char
25 | import Text.Parsec.Perm
26 | import Data.Char
27 | import Data.List
28 | import Data.Generics -- not Haskell '98
29 |
30 | type Token = (TPos, TokenType)
31 |
32 | data TPos = TPos SourceName Line Column
33 | deriving (Show, Eq, Ord, Data, Typeable)
34 |
35 | tokenSource ((TPos s l c), i) = s
36 | tokenLine ((TPos s l c), i) = l
37 | tokenCol ((TPos s l c), i) = c
38 | tokenItem (s, i) = i
39 |
40 | tokenItemS (p, i) = case i of
41 | TokenWhite s -> s
42 | TokenComment s -> s
43 | TokenNum s -> case s of
44 | TokenInteger n -> n
45 | TokenDouble n -> n
46 | TokenOctal n -> n
47 | TokenHex n -> n
48 | TokenIdent s -> s
49 | TokenString s -> s
50 | TokenNl s -> s
51 | TokenEscaped s -> s
52 | TokenXml s -> s
53 | TokenKw s -> s
54 | TokenOp s -> s
55 | TokenUnknown s -> s
56 |
57 | data TokenNum = TokenInteger String
58 | | TokenDouble String
59 | | TokenOctal String
60 | | TokenHex String
61 | deriving (Show, Eq, Ord, Data, Typeable)
62 |
63 | data TokenType =
64 | TokenWhite String
65 | | TokenComment String
66 | | TokenNum TokenNum
67 | | TokenIdent String
68 | | TokenString String
69 | | TokenNl String
70 | | TokenEscaped String
71 | | TokenKw String
72 | | TokenOp String
73 | | TokenXml String
74 | | TokenUnknown String
75 | deriving (Show, Eq, Ord, Data, Typeable)
76 |
77 | keywords = [ "...", "as", "break", "case", "catch", "class", "const", "continue", "default",
78 | "delete", "do", "else", "extends", "false", "finally", "for", "function", "if",
79 | "implements", "import", "in", "instanceof", "interface", "internal", "is",
80 | "native", "new", "null", "package",
81 | "private", "protected", "public", "return", "super", "switch", "this", "throw",
82 | "true", "try", "typeof", "use", "undefined", "var", "void", "while", "with",
83 | -- syntactic keywords
84 | "each", "get", "set", "namespace", "include", "dynamic", "final", "native",
85 | "override", "static"
86 | ]
87 |
88 | operators = [ "...", ".", "[", "]", "(", ")", "@", "::", "..", "{", "}",
89 | "++", "--", "-", "~", "!", "*", "/", "%",
90 | "+", "-", "<<", ">>", ">>>", "<", "<=", ">", ">=",
91 | "==", "!=", "===", "!==", "&", "^", "|", "&&", "||",
92 | "?", "=", "+=", "-=", "*=", "/=", "%=", "<<=", ">>=",
93 | ">>>=", "&=", "^=", "|=", ",", ":", ";"
94 | ]
95 |
96 | keyword = do { x <- many1 identChar; if (elem x $ keywords) then return (TokenKw x) else unexpected "keyword" }
97 |
98 | identifier = do{ x<- (satisfy (\c -> isAlpha c || c == '_' || c == '$')); x' <- many identChar; return $ TokenIdent $ [x]++x' }
99 |
100 | identChar = satisfy (\c -> isAlphaNum c || c == '_' || c == '$')
101 |
102 | sortByLength = sortBy (\x y -> compare (length y) (length x))
103 |
104 | operator' (o:os) = try (do{ s <- string o; return $ TokenOp s })
105 | <|> operator' os
106 | operator' [] = fail " failed "
107 |
108 | operator = operator' $ sortByLength operators
109 |
110 | utf8 = do { c <- string "\239\187\191"; return $ TokenWhite c }
111 |
112 | simpleSpace = many1 (satisfy (\c -> c == ' ' || c == '\t'))
113 | whiteSpace = do{ x <- many1 ( try( simpleSpace ) <|> nl' ); return $ TokenWhite $ concat x}
114 |
115 | anyCharButNl = do{ c <- (satisfy(\c-> isPrint c && c /= '\r' && c /= '\n')); return c }
116 |
117 | escapedAnyChar = try(do{ char '\\'; c <- anyCharButNl; return $ "\\"++[c]})
118 | <|> do{ c <- anyCharButNl; return [c]}
119 |
120 | escapedCharToken = do{ char '\\'; c <- anyCharButNl; return $ TokenEscaped $ "\\"++[c]}
121 |
122 | nl' = do{ try (string "\r\n"); return "\r\n" }
123 | <|> do{ try (char '\n'); return "\n" }
124 | <|> do{ try (char '\r'); return "\r" }
125 |
126 | nl = do{ x <- nl'; return $ TokenNl x}
127 |
128 | quotedDString = do{ char '"'; s <- manyTill escapedAnyChar (char '"'); return $ TokenString $ "\"" ++ (concat s) ++ "\""}
129 | quotedSString = do{ char '\''; s <- manyTill escapedAnyChar (char '\''); return $ TokenString $ "'" ++ (concat s) ++ "'"}
130 |
131 | commentSLine = do{ string "//"; s <- manyTill anyChar (lookAhead nl); return $ TokenComment $ "//"++s}
132 | commentMLine = do{ string "/*"; s <- manyTill anyChar (try(string "*/")); return $ TokenComment $ "/*"++s++"*/" }
133 |
134 | xml = do{ char '<'; t <- many1 (satisfy (\c -> isPrint c && c /= '>')); char '>'; x <- manyTill anyChar (try (string $ "")); return $ TokenXml $ "<"++t++">"++x++""}
135 |
136 | xmlSTag = do{ char '<'; t <- manyTill (satisfy (\c -> isPrint c && c /= '/' && c /= '>')) (string "/>"); return $ TokenXml $ "<"++t++"/>"}
137 |
138 | number = try (do{ char '0'; char 'x'; x <- many1 hexDigit; return $ TokenNum $ TokenHex $ "0x"++x})
139 | <|> try (do{ char '0'; x <- many1 octDigit; return $ TokenNum $ TokenOctal $ "0"++x})
140 | <|> try (do{ x <- double; return $ TokenNum $ TokenDouble $ x })
141 | <|> do{ x <- many1 digit; return $ TokenNum $ TokenInteger $ x }
142 |
143 | double = try ( do{ h <- decimalInt; char '.'; t <- optionMaybe decimalInt; e <- optionMaybe expPart; return $ h++"."++(maybe "" id t)++(maybe "" id e) })
144 | <|> try ( do{ char '.'; t <- decimalInt; e <- optionMaybe expPart; return $ "."++t++(maybe "" id e)})
145 | <|> do{ h <- decimalInt; e <- expPart; return $ h++e}
146 |
147 | decimalInt = do{ char '0'; return "0"}
148 | <|> do{ h <- nonZeroDigit; t <- many digit; return $ h++t}
149 |
150 | nonZeroDigit = do{ x<- oneOf "123456789"; return [x]}
151 |
152 | expPart = do{ e <- oneOf "eE"; i <- signedInt; return $ [e]++i}
153 |
154 | signedInt = do{ s <- optionMaybe (oneOf "+-"); i <- many1 digit; return $ (maybe "" (\x -> [x]) s) ++ i}
155 |
156 | atoken =
157 | try (do{ x <- utf8; return x})
158 | <|> try (do{ x <- keyword; return x})
159 | <|> try (do{ x <- commentSLine; return x})
160 | <|> try (do{ x <- commentMLine; return x})
161 | <|> try (do{ x <- xmlSTag; return x})
162 | <|> try (do{ x <- xml; return x})
163 | <|> try (do{ x <- escapedCharToken; return x})
164 | <|> try (do{ x <- number; return x})
165 | <|> try (do{ x <- operator; return x})
166 | <|> try (do{ x <- identifier; return x})
167 | <|> try (do{ x <- quotedDString; return x})
168 | <|> try (do{ x <- quotedSString; return x})
169 | <|> try (do{ x <- whiteSpace; return x})
170 | <|> do{ x <- anyToken; return $ TokenUnknown $ x:[]}
171 |
172 |
173 | lexer = many1 (do { p <- getPosition; t <- atoken; return (TPos (sourceName p) (sourceLine p) (sourceColumn p), t) })
174 |
175 | runLexer :: String -> String -> [Token]
176 | runLexer filename s = case parse lexer filename s of
177 | Right l -> l
178 | Left _ -> []
179 |
--------------------------------------------------------------------------------
/samples/GridLayout.as:
--------------------------------------------------------------------------------
1 | /*
2 | Copyright aswing.org, see the LICENCE.txt.
3 | */
4 | package org.aswing{
5 |
6 | import org.aswing.Component;
7 | import org.aswing.Container;
8 | import org.aswing.EmptyLayout;
9 | import org.aswing.geom.IntDimension;
10 | import org.aswing.Insets;
11 | import org.aswing.geom.IntRectangle;
12 |
13 | /**
14 | * @author feynixs(Cai Rong)
15 | * @author iiley
16 | */
17 | public class GridLayout extends EmptyLayout{
18 | /**
19 | * This is the horizontal gap (in pixels) which specifies the space
20 | * between columns. They can be changed at any time.
21 | * This should be a non-negative integer.
22 | *
23 | * @see #getHgap()
24 | * @see #setHgap(hgap:int)
25 | */
26 | private var hgap:int;
27 | /**
28 | * This is the vertical gap (in pixels) which specifies the space
29 | * between rows. They can be changed at any time.
30 | * This should be a non negative integer.
31 | *
32 | * @see #getVgap()
33 | * @see #setVgap(vgap:int)
34 | */
35 | private var vgap:int;
36 | /**
37 | * This is the number of rows specified for the grid. The number
38 | * of rows can be changed at any time.
39 | * This should be a non negative integer, where '0' means
40 | * 'any number' meaning that the number of Rows in that
41 | * dimension depends on the other dimension.
42 | *
43 | * @see #getRows()
44 | * @see #setRows(rows:int)
45 | */
46 | private var rows:int;
47 | /**
48 | * This is the number of columns specified for the grid. The number
49 | * of columns can be changed at any time.
50 | * This should be a non negative integer, where '0' means
51 | * 'any number' meaning that the number of Columns in that
52 | * dimension depends on the other dimension.
53 | *
54 | * @see #getColumns()
55 | * @see #setColumns(cols:int)
56 | */
57 | private var cols:int;
58 |
59 |
60 |
61 | /**
62 | *
63 | * Creates a grid layout with the specified number of rows and
64 | * columns. All components in the layout are given equal size.
65 | *
66 | *
67 | * In addition, the horizontal and vertical gaps are set to the
68 | * specified values. Horizontal gaps are placed between each
69 | * of the columns. Vertical gaps are placed between each of
70 | * the rows.
71 | *
72 | *
73 | * One, but not both, of rows and cols can
74 | * be zero, which means that any number of objects can be placed in a
75 | * row or in a column.
76 | *
77 | *
78 | * All GridLayout constructors defer to this one.
79 | *
80 | * @param rows the rows, with the value zero meaning
81 | * any number of rows
82 | * @param cols the columns, with the value zero meaning
83 | * any number of columns
84 | * @param hgap (optional)the horizontal gap, default 0
85 | * @param vgap (optional)the vertical gap, default 0
86 | * @throws ArgumentError if the value of both
87 | * rows and cols is
88 | * set to zero
89 | */
90 | public function GridLayout(rows:int=1, cols:int=0, hgap:int=0, vgap:int=0) {
91 | if ((rows == 0) && (cols == 0)) {
92 | throw new ArgumentError("rows and cols cannot both be zero");
93 | }
94 |
95 | this.rows = rows;
96 | this.cols = cols;
97 | this.hgap = hgap;
98 | this.vgap = vgap;
99 | }
100 |
101 | /**
102 | * Gets the number of rows in this layout.
103 | * @return the number of rows in this layout
104 | *
105 | */
106 | public function getRows():int {
107 | return rows;
108 | }
109 |
110 | /**
111 | * Sets the number of rows in this layout to the specified value.
112 | * @param rows the number of rows in this layout
113 | */
114 | public function setRows(rows:int):void {
115 | this.rows = rows;
116 | }
117 |
118 | /**
119 | * Gets the number of columns in this layout.
120 | * @return the number of columns in this layout
121 | *
122 | */
123 | public function getColumns():int {
124 | return cols;
125 | }
126 |
127 | /**
128 | * Sets the number of columns in this layout.
129 | * Setting the number of columns has no effect on the layout
130 | * if the number of rows specified by a constructor or by
131 | * the setRows method is non-zero. In that case, the number
132 | * of columns displayed in the layout is determined by the total
133 | * number of components and the number of rows specified.
134 | * @param cols the number of columns in this layout
135 | *
136 | */
137 | public function setColumns(cols:int):void {
138 | this.cols = cols;
139 | }
140 |
141 | /**
142 | * Gets the horizontal gap between components.
143 | * @return the horizontal gap between components
144 | *
145 | */
146 | public function getHgap():int {
147 | return hgap;
148 | }
149 |
150 | /**
151 | * Sets the horizontal gap between components to the specified value.
152 | * @param hgap the horizontal gap between components
153 | *
154 | */
155 | public function setHgap(hgap:int):void {
156 | this.hgap = hgap;
157 | }
158 |
159 | /**
160 | * Gets the vertical gap between components.
161 | * @return the vertical gap between components
162 | *
163 | */
164 | public function getVgap():int {
165 | return vgap;
166 | }
167 |
168 | /**
169 | * Sets the vertical gap between components to the specified value.
170 | * @param vgap the vertical gap between components
171 | *
172 | */
173 | public function setVgap(vgap:int):void {
174 | this.vgap = vgap;
175 | }
176 |
177 | override public function preferredLayoutSize(target:Container):IntDimension{
178 | var insets:Insets = target.getInsets();
179 | var ncomponents:int = target.getComponentCount();
180 | var nrows:int = rows;
181 | var ncols:int = cols;
182 | if (nrows > 0){
183 | ncols = Math.floor(((ncomponents + nrows) - 1) / nrows);
184 | }else{
185 | nrows = Math.floor(((ncomponents + ncols) - 1) / ncols);
186 | }
187 | var w:int = 0;
188 | var h:int = 0;
189 | for (var i:int = 0; i < ncomponents; i++){
190 | var comp:Component = target.getComponent(i);
191 | var d:IntDimension = comp.getPreferredSize();
192 | if (w < d.width){
193 | w = d.width;
194 | }
195 | if (h < d.height){
196 | h = d.height;
197 | }
198 | }
199 | return new IntDimension((((insets.left + insets.right) + (ncols * w)) + ((ncols - 1) * hgap)), (((insets.top + insets.bottom) + (nrows * h)) + ((nrows - 1) * vgap)));
200 | }
201 |
202 | override public function minimumLayoutSize(target:Container):IntDimension{
203 | return target.getInsets().getOutsideSize();
204 | }
205 |
206 | /**
207 | * return new IntDimension(1000000, 1000000);
208 | */
209 | override public function maximumLayoutSize(target:Container):IntDimension{
210 | return new IntDimension(1000000, 1000000);
211 | }
212 |
213 | override public function layoutContainer(target:Container):void{
214 | var insets:Insets = target.getInsets();
215 | var ncomponents:int = target.getComponentCount();
216 | var nrows:int = rows;
217 | var ncols:int = cols;
218 | if (ncomponents == 0){
219 | return ;
220 | }
221 | if (nrows > 0){
222 | ncols = Math.floor(((ncomponents + nrows) - 1) / nrows);
223 | }else{
224 | nrows = Math.floor(((ncomponents + ncols) - 1) / ncols);
225 | }
226 | var w:int = (target.getWidth() - (insets.left + insets.right));
227 | var h:int = (target.getHeight() - (insets.top + insets.bottom));
228 | w = Math.floor((w - ((ncols - 1) * hgap)) / ncols);
229 | h = Math.floor((h - ((nrows - 1) * vgap)) / nrows);
230 | var x:int = insets.left;
231 | var y:int = insets.top;
232 | for (var c:int = 0; c < ncols; c++){
233 | y = insets.top;
234 | for (var r:int = 0; r < nrows; r++){
235 | var i:int = ((r * ncols) + c);
236 | if (i < ncomponents){
237 | target.getComponent(i).setBounds(new IntRectangle(x, y, w, h));
238 | }
239 | y += (h + vgap);
240 | }
241 | x += (w + hgap);
242 | }
243 | }
244 | public function toString():String{
245 | return ((((((((("GridLayout[hgap=") + hgap) + ",vgap=") + vgap) + ",rows=") + rows) + ",cols=") + cols) + "]");
246 | }
247 |
248 | /**
249 | * return 0.5
250 | */
251 | override public function getLayoutAlignmentX(target:Container):Number{
252 | return 0.5;
253 | }
254 |
255 | /**
256 | * return 0.5
257 | */
258 | override public function getLayoutAlignmentY(target:Container):Number{
259 | return 0.5;
260 | }
261 | }
262 | }
--------------------------------------------------------------------------------
/ActionhaXe/Data.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | module ActionhaXe.Data where
19 |
20 | import ActionhaXe.Lexer
21 | import ActionhaXe.CLArgs
22 |
23 | import Text.Parsec
24 | import Text.Parsec.Prim
25 |
26 | import Data.Char
27 | import Data.Map (Map)
28 | import qualified Data.Map as Map
29 | import Data.Tree
30 | import Data.Generics -- not Haskel 98
31 |
32 | -- data
33 | showd :: CToken -> String
34 | showd x = foldr (\t s -> (tokenItemS t) ++ s) "" (fst x)
35 |
36 | -- whitespace includes comments
37 | showw :: CToken -> String
38 | showw x = foldr (\t s -> (tokenItemS t) ++ s) "" (snd x)
39 |
40 | -- whitespace filters comments
41 | showws :: CToken -> String
42 | showws x = foldr (\t s -> (tokenItemS t) ++ s) "" (fst (span (\(s, tok) -> case tok of { TokenWhite _ -> True; TokenNl _ -> True; otherwise -> False;}) (snd x)))
43 |
44 | -- both data and whitespace
45 | showb :: CToken -> String
46 | showb x = foldr (\t s -> (tokenItemS t) ++ s) "" ((fst x)++(snd x))
47 |
48 | -- the whitespace after the first newline
49 | shown :: CToken -> String
50 | shown x = tailAtN $ snd $ break (== '\n') $ foldr (\t s -> (tokenItemS t) ++ s) "" (snd x)
51 | where tailAtN [] = ""
52 | tailAtN t = tail t
53 |
54 | showl :: [CToken] -> String
55 | showl xs = foldr (\t s -> showb t ++ s) "" xs
56 |
57 | -- splits the space from the left and right
58 | splitLR :: String -> [String]
59 | splitLR x = [l, m, r]
60 | where (l, nl) = span (\c -> isSpace c || c == '\n') x
61 | (r') = span (\c -> isSpace c || c == '\n') $ reverse nl
62 | (m, r) = (reverse $ snd r', reverse $ fst r')
63 |
64 | type Name = String
65 | type TList = [Token]
66 | type CToken = (TList, TList) -- compound token with a list for an entity, whitespace
67 |
68 | type Semi = Maybe CToken
69 |
70 | data PrimaryE = PEThis CToken -- this
71 | | PEIdent CToken -- identifier
72 | | PELit CToken -- literal: null, boolean, numeric, string, not regular expression or xml since those don't have operations on them outside of class methods
73 | | PEArray ArrayLit -- array literal
74 | | PEObject ObjectLit -- {, maybe [[property : assignE],[,]] , }
75 | | PEXml CToken
76 | | PEFunc FuncE
77 | | PEParens CToken ListE CToken -- (, List of expressions , )
78 | deriving (Show, Data, Typeable)
79 |
80 | data ListE = ListE [(AssignE, (Maybe CToken))]
81 | deriving (Show, Data, Typeable)
82 |
83 | data ArrayLit = ArrayLitC CToken (Maybe Elision) CToken -- [, maybe commas, ]
84 | | ArrayLit CToken ElementList CToken -- [, element list, ]
85 | deriving (Show, Data, Typeable)
86 |
87 | data ElementList = El (Maybe Elision) AssignE [EAE] (Maybe Elision)
88 | deriving (Show, Data, Typeable)
89 |
90 | data EAE = EAE Elision AssignE
91 | deriving (Show, Data, Typeable)
92 |
93 | data Elision = Elision [CToken] -- commas possible separated by space in a list
94 | deriving (Show, Data, Typeable)
95 |
96 | data ObjectLit = ObjectLit CToken (Maybe PropertyList) CToken deriving (Show, Data, Typeable)
97 |
98 | data PropertyList = PropertyList [(CToken, CToken, AssignE, (Maybe CToken))] deriving (Show, Data, Typeable) -- [propertyName, :, assignE, maybe ',']
99 |
100 | data FuncE = FuncE CToken (Maybe CToken) Signature BlockItem deriving (Show, Data, Typeable) -- function, maybe ident, signature, block
101 |
102 | data Arguments = Arguments CToken (Maybe ListE) CToken
103 | deriving (Show, Data, Typeable)
104 |
105 | data SuperE = SuperE CToken (Maybe Arguments)
106 | deriving (Show, Data, Typeable)
107 |
108 | data PostFixE = PFFull FullPostFixE (Maybe CToken)
109 | | PFShortNew ShortNewE (Maybe CToken)
110 | deriving (Show, Data, Typeable)
111 |
112 | data FullPostFixE = FPFPrimary PrimaryE [FullPostFixSubE]
113 | | FPFFullNew FullNewE [FullPostFixSubE]
114 | | FPFSuper SuperE PropertyOp [FullPostFixSubE]
115 | | FPFInc PostFixE CToken
116 | | FPFDec PostFixE CToken
117 | deriving (Show, Data, Typeable)
118 |
119 | data FullPostFixSubE = FPSProperty PropertyOp
120 | | FPSArgs Arguments
121 | | FPSQuery QueryOp
122 | deriving (Show, Data, Typeable)
123 |
124 | data FullNewE = FN CToken FullNewE Arguments
125 | | FNPrimary PrimaryE [PropertyOp]
126 | | FNSuper SuperE [PropertyOp]
127 | deriving (Show, Data, Typeable)
128 |
129 | data ShortNewE = SN CToken ShortNewSubE
130 | deriving (Show, Data, Typeable)
131 |
132 | data ShortNewSubE = SNSFull FullNewE
133 | | SNSShort ShortNewE
134 | deriving (Show, Data, Typeable)
135 |
136 | data PropertyOp = PropertyOp CToken CToken -- . , identifier
137 | | PropertyB CToken ListE CToken -- [ list expression ]
138 | deriving (Show, Data, Typeable)
139 |
140 | data QueryOp = QueryOpDD CToken CToken
141 | | QueryOpD CToken CToken ListE CToken
142 | deriving (Show, Data, Typeable)
143 |
144 | data UnaryE = UEPrimary PostFixE
145 | | UEDelete CToken PostFixE
146 | | UEVoid CToken PostFixE
147 | | UETypeof CToken PostFixE
148 | | UEInc CToken PostFixE
149 | | UEDec CToken PostFixE
150 | | UEPlus CToken UnaryE
151 | | UEMinus CToken UnaryE
152 | | UEBitNot CToken UnaryE
153 | | UENot CToken UnaryE
154 | deriving (Show, Data, Typeable)
155 |
156 | data AritE = AEUnary UnaryE
157 | | AEBinary CToken AritE AritE
158 | deriving (Show, Data, Typeable)
159 |
160 | data RegE = RegE CToken [CToken] CToken (Maybe CToken)
161 | deriving (Show, Data, Typeable)
162 |
163 | data CondE = CondE AritE (Maybe (CToken, AssignE, CToken, AssignE))
164 | | CondRE RegE
165 | deriving (Show, Data, Typeable)
166 |
167 | data NAssignE = NAssignE AritE (Maybe (CToken, NAssignE, CToken, NAssignE))
168 | deriving (Show, Data, Typeable)
169 |
170 | data AssignE = ACond CondE
171 | | AAssign PostFixE CToken AssignE
172 | | ACompound PostFixE CToken AssignE
173 | | ALogical PostFixE CToken AssignE
174 | deriving (Show, Data, Typeable)
175 |
176 | data BlockItem = Tok CToken
177 | | Expr AssignE
178 | | Block CToken [BlockItem] CToken
179 | | ImportDecl CToken CToken Semi -- import identifier ;
180 | | ClassDecl [CToken] CToken CToken (Maybe (CToken, CToken)) (Maybe (CToken, [(CToken, Maybe CToken)])) BlockItem -- attributes, class, identifier, maybe (extends, idn), maybe (implements [(idn, maybe',')]), body
181 | | Interface [CToken] CToken CToken (Maybe (CToken, [(CToken, Maybe CToken)])) BlockItem -- public | internal, interface, identifier, maybe (extends [(idn, maybe ',')], body
182 | | MethodDecl [CToken] CToken (Maybe CToken) CToken Signature (Maybe BlockItem) -- attributes, function, maybe get/set, identifier, Signature, body
183 | | VarS [CToken] CToken VarBinding [(CToken, VarBinding)] -- maybe attributes, var, varbinding, [(',', varbinding)]
184 | | ForS CToken CToken (Maybe ForInit) CToken (Maybe ListE) CToken (Maybe ListE) CToken BlockItem -- for( ? ; ? ; ?) {}
185 | | ForInS CToken (Maybe CToken) CToken ForInBinding CToken ListE CToken BlockItem -- for, maybe each, ( forinbinding in listE ) {}
186 | | Metadata Metadata
187 | deriving (Show, Data, Typeable)
188 |
189 | data Metadata = MDSwf [(CToken, CToken)]
190 | | MD CToken CToken [CToken] CToken
191 | deriving (Show, Data, Typeable)
192 |
193 | data ForInit = FIListE ListE
194 | | FIVarS BlockItem
195 | deriving (Show, Data, Typeable)
196 |
197 | data ForInBinding = FIBPostE PostFixE
198 | | FIBVar CToken VarBinding -- var | const , varbinding
199 | deriving (Show, Data, Typeable)
200 |
201 | data VarBinding = VarBinding CToken (Maybe (CToken, AsType)) (Maybe (CToken, AssignE)) --varbinding with Type-- identifier, (maybe (:, datatype)), (maybe (=, assignE))
202 | deriving (Show, Data, Typeable)
203 |
204 | data Signature = Signature CToken [Arg] CToken (Maybe (CToken, AsType)) -- left paren, arguments, right paren, :, return type
205 | deriving (Show, Data, Typeable)
206 |
207 | data Arg = Arg CToken CToken AsType (Maybe (CToken, AssignE)) (Maybe CToken) -- arg name, :, type, maybe default value, maybe comma
208 | | RestArg CToken CToken (Maybe (CToken, AsType)) -- ..., name
209 | deriving (Show, Data, Typeable)
210 |
211 | data Package = Package CToken CToken (Maybe CToken) BlockItem -- whitespace, package, maybe name, block
212 | deriving (Show, Data, Typeable)
213 |
214 | data Ast = AS3Program Package AsState
215 | | AS3Directives [BlockItem] AsState
216 | deriving (Show, Data, Typeable)
217 |
218 | type AsParser = Parsec TList AsState
219 |
220 | --- type and state structures
221 |
222 | data AsType = AsType CToken
223 | | AsTypeRest
224 | | AsTypeUser CToken
225 | | AsTypeUnknown
226 | deriving (Show, Eq, Ord, Data, Typeable)
227 |
228 | -- Symbol Lookup key
229 | data AsDef = DefPackage Name
230 | | DefClass Name
231 | | DefInterface Name
232 | | DefFunction Name -- anonymous functions are not referenced
233 | | DefVar Name -- can be for constants too
234 | | DefNamespace Name
235 | | DefNone
236 | deriving (Show, Eq, Ord, Data, Typeable)
237 |
238 | type Attribute = String
239 | -- Symbol Lookup value
240 | data AsDefInfo = DiNone --
241 | | DiClass [Attribute] (Maybe AsDef) (Maybe [AsDef]) -- attributes, extends, implements
242 | | DiFunction [Attribute]
243 | | DiVar AsType
244 | deriving (Show, Eq, Ord, Data, Typeable)
245 |
246 | type AsDefTuple = (AsDef, AsDefInfo)
247 |
248 | data AsStateEl = AsStateEl { sid::Int, scope::Map AsDef AsDefInfo }
249 | deriving (Show, Data, Typeable)
250 |
251 | data AsState = AsState{ conf::Conf, filename::String, outfile::String, curId::Int, flags::Map String String, accessors::Map String (AsType, Bool, Bool), initMembers::[String], path::[Int], scopes::Tree AsStateEl }
252 | deriving (Show, Data, Typeable)
253 |
254 | initState :: AsState
255 | initState = AsState{ conf = ConfNone, filename = "", outfile = "", curId = 0, path = [0], flags = Map.empty, accessors = Map.empty, initMembers = [], scopes = newScope 0}
256 |
257 | getProperty name =
258 | do x <- getState
259 | let a = accessors x
260 | let def = (AsTypeUnknown, False, False)
261 | case Map.lookup name a of
262 | Nothing -> do let a' = Map.insert name def a
263 | let x' = x{ accessors = a' }
264 | setState x'
265 | return def
266 | Just prop -> return prop
267 |
268 | setProperty name prop =
269 | do x <- getState
270 | let a = accessors x
271 | let a' = Map.insert name prop a
272 | let x' = x{accessors = a'}
273 | setState x'
274 |
275 | addGetter name astype =
276 | do prop@(t, g, s) <- getProperty name
277 | setProperty name (astype, True, s)
278 |
279 | addSetter name astype =
280 | do prop@(t, g, s) <- getProperty name
281 | setProperty name (astype, g, True)
282 |
283 | enterScope :: AsParser ()
284 | enterScope = do x <- getState
285 | let c = (1 +) $ curId x
286 | let p = (c:) $ path x
287 | let s = scopes x
288 | let s' = addScope (reverse p) s
289 | let x' = x{ curId = c, path = p, scopes = s'}
290 | setState x'
291 | return ()
292 |
293 | newScope :: Int -> Tree AsStateEl
294 | newScope i = Node{ rootLabel = AsStateEl{ sid = i, scope = Map.empty}, subForest = []}
295 |
296 | addScope :: [Int] -> Tree AsStateEl -> Tree AsStateEl
297 | addScope (p:ps) t = t{ subForest = addScope' ps (subForest t)}
298 |
299 | addScope' :: [Int] -> Forest AsStateEl -> Forest AsStateEl
300 | addScope' (p:[]) [] = [newScope p]
301 | addScope' path@(p:ps) (t:ts) = if p == (sid $ rootLabel t) then ((addScope path t):ts) else (t:(addScope' path ts))
302 |
303 | exitScope :: AsParser ()
304 | exitScope = do x <- getState
305 | let p = tail $ path x
306 | let x' = x{path = p}
307 | setState x'
308 | return ()
309 |
310 | lookupSymbol :: AsParser AsDef
311 | lookupSymbol = return DefNone
312 |
313 | updateSymbol :: AsDefTuple -> AsParser ()
314 | updateSymbol d = do x <- getState
315 | x' <- updateS d x
316 | setState x'
317 |
318 | updateS :: AsDefTuple -> AsState -> AsParser AsState
319 | updateS d x = do let p = path x
320 | let s = scopes x
321 | let s' = traverseS (reverse p) s d
322 | return x{scopes = s'}
323 |
324 | traverseS :: [Int] -> Tree AsStateEl -> AsDefTuple -> Tree AsStateEl
325 | traverseS (p:[]) t (d, di) = if p == (sid $ rootLabel t) then t{ rootLabel = AsStateEl { sid = (sid $ rootLabel t), scope = (Map.insert d di (scope $ rootLabel t))}} else fail $ "\n\n--Error: in updating state "++(show p)++" "++(show t)
326 | traverseS (p:ps) t dt = if p == (sid $ rootLabel t) then t{ subForest = traverseS' ps (subForest t) dt } else t
327 |
328 | -- check the subtrees
329 | traverseS' :: [Int] -> Forest AsStateEl -> AsDefTuple -> Forest AsStateEl
330 | traverseS' path@(p:[]) [t] dt = [traverseS path t dt]
331 | traverseS' path@(p:ps) (t:ts) dt = if p == (sid $ rootLabel t) then ((traverseS path t dt):ts) else (t:(traverseS' path ts dt))
332 |
333 | storePackage :: Maybe CToken -> AsParser ()
334 | storePackage p = case p of
335 | Just x -> updateSymbol (DefPackage (showd x), DiNone)
336 | Nothing -> updateSymbol (DefPackage "//noname", DiNone)
337 |
338 | storeClass :: CToken -> AsParser ()
339 | storeClass c = updateSymbol (DefClass (showd c), DiNone)
340 |
341 | storeProperty name (Just acc) s@(Signature l a r o) =
342 | do{ case showd acc of
343 | "get" -> addGetter (showd name) $ ret o
344 | "set" -> addSetter (showd name) $ arg $ head a
345 | }
346 | where ret (Just (_, t)) = t
347 | arg (Arg _ _ t _ _) = t
348 |
349 | storeProperty name Nothing s = return ()
350 |
351 | storeVar :: CToken -> AsType -> AsParser ()
352 | storeVar v t = updateSymbol (DefVar (showd v), DiVar t)
353 |
--------------------------------------------------------------------------------
/ActionhaXe/Parser.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | -- Parse the tokens generated by Lexer
19 | -- TODO:
20 | -- updating Array parameter type,
21 | -- for
22 | -- while/do
23 | -- if
24 | -- case
25 |
26 | module ActionhaXe.Parser(parseTokens) where
27 |
28 | import ActionhaXe.Lexer
29 | import ActionhaXe.Prim
30 | import ActionhaXe.Data
31 | import Text.Parsec
32 | import Text.Parsec.Combinator
33 | import Text.Parsec.Perm
34 | import Text.Parsec.Expr
35 |
36 | emptyctok = ([],[])
37 |
38 | parseTokens :: String -> [Token] -> Either ParseError Ast
39 | parseTokens fname ts = do let st = initState
40 | let st' = st{filename = fname}
41 | runParser program st' fname ts
42 |
43 | program :: AsParser Ast
44 | program = try(do{ x <- package; a <-getState; return $ AS3Program x a})
45 | <|> do{ x <- directives; a <- getState; return $ AS3Directives x a }
46 |
47 |
48 | package = do{ ws <- startWs; p <- kw "package"; i <- optionMaybe(ident); storePackage i; b <- packageBlock; return $ Package ws p i b }
49 |
50 | packageBlock = do{ l <- op "{"; enterScope; x <- inPackageBlock; r <- op "}"; exitScope; return $ Block l x r }
51 |
52 | inPackageBlock = try(do{ lookAhead( op "}"); return [] })
53 | <|> try(do{ x <- metadata; i <- inPackageBlock; return $ [x] ++ i})
54 | <|> try(do{ x <- importDecl; i <- inPackageBlock; return $ [x] ++ i})
55 | <|> try(do{ x <- classDecl; i <- inPackageBlock; return $ [x] ++ i})
56 | <|> try(do{ x <- interface; i <- inPackageBlock; return $ [x] ++ i})
57 | <|> (do{ x <- anytok; i <- inPackageBlock; return $ [(Tok x)] ++ i})
58 |
59 | directives = do{ ws <- startWs; x <- many1 (choice[metadata, importDecl, methodDecl, varS, do{ x <- anytok; return $ Tok x}]); return $ (Tok ws):x}
60 |
61 | classBlock = do{ l <- op "{"; enterScope; x <- inClassBlock; r <- op "}"; exitScope; return $ Block l x r }
62 |
63 | inClassBlock = try(do{ lookAhead( op "}"); return [] })
64 | <|> try(do{ x <- metadata; i <- inClassBlock; return $ [x] ++ i})
65 | <|> try(do{ x <- methodDecl; i <- inClassBlock; return $ [x] ++ i})
66 | <|> try(do{ x <- varS; i <- inClassBlock; return $ [x] ++ i})
67 | <|> try(do{ x <- block; i <- inClassBlock; return $ [x] ++ i }) -- there can be blocks in classes for static initializations
68 | <|> (do{ x <- anytok; i <- inClassBlock; return $ [(Tok x)] ++ i})
69 |
70 | interfaceBlock = do{ l <- op "{"; enterScope; x <- inInterfaceBlock; r <- op "}"; exitScope; return $ Block l x r }
71 |
72 | inInterfaceBlock = try(do{ lookAhead( op "}"); return [] })
73 | <|> try(do{ x <- metadata; i <- inInterfaceBlock; return $ [x] ++ i})
74 | <|> try(do{ x <- methodDecl; i <- inInterfaceBlock; return $ [x] ++ i})
75 | <|> (do{ x <- anytok; i <- inInterfaceBlock; return $ [(Tok x)] ++ i})
76 |
77 | funcBlock = do{ l <- op "{"; enterScope; x <- inMethodBlock; r <- op "}"; exitScope; return $ Block l x r }
78 |
79 | inMethodBlock = try(do{ lookAhead( op "}"); return [] })
80 | <|> try(do{ x <- metadata; i <- inMethodBlock; return $ [x] ++ i})
81 | <|> try(do{ x <- expr; i <- inMethodBlock; return $ [x] ++ i})
82 | <|> try(do{ b <- block; i <- inMethodBlock; return $ [b] ++ i })
83 | <|> try(do{ x <- statement; i <- inMethodBlock; return $ [x]++i})
84 | <|> (do{ x <- anytok; i <- inMethodBlock; return $ [(Tok x)] ++ i})
85 |
86 | block = do{ l <- op "{"; enterScope; x <- inBlock; r <- op "}"; exitScope; return $ Block l x r }
87 |
88 | inBlock = try(do{ lookAhead( op "}"); return [] })
89 | <|> try(do{ x <- metadata; i <- inBlock; return $ [x] ++ i})
90 | <|> try(do{ x <- expr; i <- inBlock; return $ [x] ++ i})
91 | <|> try(do{ b <- block; i <- inBlock; return $ [b] ++ i })
92 | <|> try(do{ x <- statement; i <- inBlock; return $ [x]++i})
93 | <|> (do{ x <- anytok; i <- inBlock; return $ [(Tok x)] ++ i})
94 |
95 | metadata = do{ l <- op "["
96 | ; try(do{ t <- mid "SWF";
97 | ; lp <- op "("
98 | ; m <- metadataSwf
99 | ; rp <- op ")"
100 | ; r <- op "]"
101 | ; return $ Metadata $ MDSwf m
102 | }
103 | )
104 | <|> try(do{ t <- choice[mid "ArrayElementType"
105 | , mid "Bindable"
106 | , mid "DefaultProperty" , mid "Deprecated"
107 | , mid "Effect" , mid "Embed" , mid "Event" , mid "Exclude" , mid "ExcludeClass"
108 | , mid "IconFile" , mid "Inspectable" , mid "InstanceType"
109 | , mid "NonCommittingChangeEvent"
110 | , mid "RemoteClass"
111 | , mid "Style"
112 | , mid "Transient"
113 | ]
114 | ; x <- manyTill anytok (lookAhead(op "]"))
115 | ; r <- op "]"
116 | ; return $ Metadata $ MD l t x r
117 | }
118 | )
119 | }
120 |
121 | metadataSwf =
122 | permute $ mlist <$?> (missing, item "width") <|?> (missing, item "height") <|?> (missing, item "backgroundColor") <|?> (missing, item "frameRate")
123 | where mlist w h b f = filter (\a -> (fst a) /= emptyctok) [w, h, b, f]
124 | item i = do{ x <- mid i; op "="; s <- str; optionMaybe (op ","); return (x, s)}
125 | missing = (emptyctok, emptyctok)
126 |
127 | importDecl = do{ k <- kw "import"; s <- sident; o <- maybeSemi; return $ ImportDecl k s o}
128 |
129 | interface = do{ a <- classAttributes; k <- kw "interface"; i <- ident; e <- optionMaybe(interfaceExtends); b <- classBlock; return $ Interface a k i e b}
130 |
131 | interfaceExtends = do{ k <- kw "extends"; s <- many1 (do{n <- nident; c <- optionMaybe (op ","); return (n,c)}); return $ (k,s) }
132 |
133 | classDecl = do{ a <- classAttributes; k <- kw "class"; i <- ident; e <- optionMaybe(classExtends); im <- optionMaybe(classImplements); storeClass i; b <- classBlock; return $ ClassDecl a k i e im b}
134 |
135 | classAttributes = permute $ list <$?> (emptyctok, (choice[kw "public", kw "internal"])) <|?> (emptyctok, kw "static") <|?> (emptyctok, kw "dynamic")
136 | where list v s d = filter (\a -> fst a /= []) [v,s,d]
137 |
138 | classExtends = do{ k <- kw "extends"; s <- nident; return $ (k, s)}
139 |
140 | classImplements = do{ k <- kw "implements"; s <- many1 (do{n <- nident; c <- optionMaybe (op ","); return (n,c)}); return $ (k,s) }
141 |
142 | methodDecl = try(do{ attr <- methodAttributes
143 | ; k <- kw "function"
144 | ; acc <- optionMaybe(try(do{ k <- (kw "get" <|> kw "set"); try(do{ o <- op "("; unexpected (showb o)} <|> return ()); return k}))
145 | ; n <- choice[ nident, kw "each", kw "get", kw "set", kw "include", kw "override"]
146 | ; enterScope
147 | ; sig <- signature
148 | ; b <- optionMaybe funcBlock
149 | ; exitScope
150 | ; storeProperty n acc sig
151 | ; return $ MethodDecl attr k acc n sig b})
152 |
153 | methodAttributes = permute $ list <$?> (emptyctok, (choice[kw "public", kw "private", kw "protected", kw "internal"])) <|?> (emptyctok, ident) <|?> (emptyctok, kw "internal") <|?> (emptyctok, kw "override") <|?> (emptyctok, kw "static") <|?> (emptyctok, kw "final") <|?> (emptyctok, kw "native")
154 | where list v ns i o s f n = filter (\a -> fst a /= []) [v,ns,i,o,s,f,n]
155 |
156 | 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
157 |
158 | sigargs = do{ s <- many sigarg; return s}
159 | sigarg = try(do{ a <- idn; o <- op ":";
160 | try(do{ 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})
161 | <|> try(do{ d <- op "*=" -- special case where no space between *= is parsed as an operator
162 | ; let (d', eq) = extractDynamicType d
163 | ; e <- assignE;
164 | ; c <- optionMaybe(op ",")
165 | ; let t = AsType d'
166 | ; storeVar a t;
167 | ; return $ Arg a o t (Just (eq, e)) c
168 | })
169 | })
170 | <|> do{ d <- op "..."; i <- idn; t <- optionMaybe (do{ o <- op ":"; t <- datatype; return (o, t)}); storeVar i AsTypeRest; return $ RestArg d i t }
171 |
172 | -- extractDynamicType used by sigarg to split TokenOp *= into the * datatype and = for assignment
173 | extractDynamicType ([t], s) = (([dt], []), ([eq], s))
174 | where sourceName = tokenSource t
175 | sourceLine = tokenLine t
176 | sourceCol = tokenCol t
177 | dt = (TPos sourceName sourceLine sourceCol, TokenOp "*")
178 | eq = (TPos sourceName sourceLine (sourceCol+1), TokenOp "=")
179 |
180 | varS = try(do{ ns <- varAttributes
181 | ; k <- choice[kw "var", kw "const"]
182 | ; v <- varBinding
183 | ; vs <- many (do{ s <- op ","; v <- varBinding; return (s, v)})
184 | ; return $ VarS ns k v vs
185 | }
186 | )
187 |
188 | varAttributes = permute $ list <$?> (emptyctok, (choice[kw "public", kw "private", kw "protected", kw "internal"])) <|?> (emptyctok, ident) <|?> (emptyctok, kw "static") <|?> (emptyctok, kw "native")
189 | where list v ns s n = filter (\a -> fst a /= []) [v,ns,s,n]
190 |
191 | varBinding = try(do{ n <- idn
192 | ; t <- optionMaybe(do{c <- op ":"; dt <- datatype; return (c, dt)})
193 | ; i <- optionMaybe (do{ o <- op "="; e <- assignE; return $ (o, e)})
194 | ; return $ VarBinding n t i
195 | }
196 | )
197 |
198 |
199 | datatype = try(do{ t <- kw "void"; return $ AsType t})
200 | <|> try(do{ t <- mid "int"; return $ AsType t})
201 | <|> try(do{ t <- mid "uint"; return $ AsType t})
202 | <|> try(do{ t <- mid "Number"; return $ AsType t})
203 | <|> try(do{ t <- mid "Boolean"; return $ AsType t})
204 | <|> try(do{ t <- mid "String"; return $ AsType t})
205 | <|> try(do{ t <- mid "Object"; return $ AsType t})
206 | <|> try(do{ t <- op "*"; return $ AsType t})
207 | <|> try(do{ t <- mid "Array"; return $ AsType t})
208 | <|> try(do{ t <- mid "Function"; return $ AsType t})
209 | <|> try(do{ t <- mid "RegExp"; return $ AsType t})
210 | <|> try(do{ t <- mid "XML"; return $ AsType t})
211 | <|> try(do{ t <- mid "Class"; return $ AsType t})
212 | -- Vector.<*> new in flash 10
213 | <|> do{ i <- ident; return $ AsTypeUser i}
214 |
215 | primaryE = try(do{ x <- kw "this"; return $ PEThis x})
216 | <|> try(do{ x <- idn; return $ PEIdent x})
217 | <|> try(do{ x <- choice[kw "null", kw "true", kw "false", kw "public", kw "private", kw "protected", kw "internal"]; return $ PELit x})
218 | <|> try(do{ x <- str; return $ PELit x})
219 | <|> try(do{ x <- num; return $ PELit x})
220 | <|> try(do{ x <- arrayLit; return $ PEArray x})
221 | <|> try(do{ x <- objectLit; return $ PEObject x})
222 | -- <|> try(do{ x <- reg; return $ PERegex x})
223 | <|> try(do{ x <- xml; return $ PEXml x})
224 | <|> try(do{ x <- funcE; return $ PEFunc x})
225 | <|> try(do{ x <- kw "get"; return $ PEIdent x})
226 | <|> try(do{ x <- kw "set"; return $ PEIdent x})
227 | <|> do{ x <- parenE; return $ x}
228 |
229 | arrayLit = try(do{ l <- op "["; e <- elementList; r <- op "]"; return $ ArrayLit l e r})
230 | <|> do{ l <- op "["; e <- optionMaybe elision; r <- op "]"; return $ ArrayLitC l e r}
231 |
232 | elementList = do
233 | l <- optionMaybe elision
234 | e <- assignE
235 | el <- many (try(do{ c <- elision; p <- assignE; return $ EAE c p}))
236 | r <- optionMaybe elision
237 | return $ El l e el r
238 |
239 | elision = do{ x <- many1 (op ","); return $ Elision x}
240 |
241 | objectLit = do{ l <- op "{"; x <- optionMaybe propertyNameAndValueList; r <- op "}"; return $ ObjectLit l x r}
242 |
243 | propertyNameAndValueList = do{ x <- many1 (do{ p <- propertyName; c <- op ":"; e <- assignE; s <- optionMaybe (op ","); return (p, c, e, s)}); return $ PropertyList x}
244 |
245 | propertyName = do{ x <- choice [ident, str, num]; return x}
246 |
247 | funcE = do{ f <- kw "function"; i <- optionMaybe ident; enterScope; s <- signature; b <- funcBlock; exitScope; return $ FuncE f i s b}
248 |
249 | parenE = do{ l <- op "("; e <- listE; r <- op ")"; return $ PEParens l e r}
250 |
251 | listE = do{ e <- many1 (do{x <- assignE; c <- optionMaybe (op ","); return (x, c)}); return $ ListE e}
252 |
253 | listENoIn = do{ e <- many1 (do{x <- assignENoIn; c <- optionMaybe (op ","); return (x, c)}); return $ ListE e}
254 |
255 | postFixE = try(do{ x <- fullPostFixE; o <- postFixUp; return $ PFFull x o})
256 | <|> do{ x <- shortNewE; o <- postFixUp; return $ PFShortNew x o}
257 | where postFixUp = optionMaybe (do{ o <- choice [op "++", op "--"]; return o})
258 |
259 | fullPostFixE = try(do{ x <- primaryE; s <- many fullPostFixSubE; return $ FPFPrimary x s})
260 | <|> try(do{ x <- fullNewE; s <- many fullPostFixSubE; return $ FPFFullNew x s})
261 | <|> (do{ x <- superE; p <- propertyOp; s <- many fullPostFixSubE; return $ FPFSuper x p s})
262 |
263 | fullPostFixSubE = try(do{ p <- propertyOp; return $ FPSProperty p})
264 | <|> try(do{ a <- args; return $ FPSArgs a}) -- call expression
265 | <|> do{ q <- queryOp; return $ FPSQuery q}
266 |
267 | fullNewE = do{ k <- kw "new"; e <- fullNewSubE; a <- args; return $ FN k e a}
268 |
269 | fullNewSubE = try(do{ e <- fullNewE; return e})
270 | <|> try(do{ e <- primaryE; p <- many propertyOp; return $ FNPrimary e p})
271 | <|> do{ e <- superE; p <- many1 propertyOp; return $ FNSuper e p}
272 |
273 | shortNewE = do{ k <- kw "new"; s <- shortNewSubE; return $ SN k s}
274 |
275 | shortNewSubE = try(do{ e <- fullNewSubE; return $ SNSFull e})
276 | <|> do{ e <- shortNewE; return $ SNSShort e}
277 |
278 | superE = do{ k <- kw "super"; p <- optionMaybe args; return $ SuperE k p}
279 |
280 | args = do{ l <- op "("; e <- optionMaybe listE; r <- op ")"; return $ Arguments l e r}
281 |
282 | propertyOp = try(do{ o <- op "."; n <- choice[idn, kw "get", kw "set"]; return $ PropertyOp o n})
283 | <|> do{ l <- op "["; e <- listE; r <- op "]"; return $ PropertyB l e r}
284 |
285 | queryOp = try(do{ o <- op ".."; n <- nident; return $ QueryOpDD o n})
286 | <|> do{ o <- op "."; l <- op "("; e <- listE; r <- op ")"; return $ QueryOpD o l e r}
287 |
288 | unaryE = try(do{ k <- kw "delete"; p <- postFixE; return $ UEDelete k p})
289 | <|> try(do{ k <- kw "void"; p <- postFixE; return $ UEVoid k p})
290 | <|> try(do{ k <- kw "typeof"; p <- postFixE; return $ UETypeof k p})
291 | <|> try(do{ o <- op "++"; p <- postFixE; return $ UEInc o p})
292 | <|> try(do{ o <- op "--"; p <- postFixE; return $ UEDec o p})
293 | <|> try(do{ o <- op "+"; p <- unaryE; return $ UEPlus o p})
294 | <|> try(do{ o <- op "-"; p <- unaryE; return $ UEMinus o p})
295 | <|> try(do{ o <- op "~"; p <- unaryE; return $ UEBitNot o p})
296 | <|> try(do{ o <- op "!"; p <- unaryE; return $ UENot o p})
297 | <|> do{ p <- postFixE; return $ UEPrimary p }
298 |
299 | aeUnary = do{ x <- unaryE; return $ AEUnary x}
300 |
301 | aritE = buildExpressionParser (aritOpTable True) aeUnary
302 |
303 | aritENoIn = buildExpressionParser (aritOpTable False) aeUnary
304 |
305 | aritOpTable allowIn =
306 | [
307 | [o "*", o "/", o "%"], -- multiplicative
308 | [o "+", o "-"], -- additive
309 | [o "<<", o ">>", o ">>>"], -- shift
310 | [o "<", o ">", o "<=", o ">="]
311 | ++ (if allowIn == True then [ok "in"] else [])
312 | ++ [ ok "instanceof", ok "is", ok "as"], -- relational
313 | [o "==", o "!=", o "===", o "!=="], -- equality
314 | [o "&"], [o "^"], [o "|"], -- bitwise
315 | [o "&&"], [o "||"] -- logical
316 | ]
317 | where o opr = Infix (do{ o' <- op opr; return (\x y -> AEBinary o' x y)}) AssocLeft
318 | ok kop = Infix (do{ k <- kw kop; return (\x y -> AEBinary k x y)}) AssocLeft
319 |
320 | regE = do{ l <- op "/"; x <- manyTill anytok (try(lookAhead(op "/"))); r <- op "/"; o <- optionMaybe idn; return $ RegE l x r o}
321 |
322 | condE = try(do{ r <- regE; return $ CondRE r})
323 | <|> do{ e <- aritE; o <- optionMaybe (do{ q <- op "?"; e1 <- assignE; c <- op ":"; e2 <- assignE; return $ (q, e1, c, e2)}); return $ CondE e o}
324 |
325 | condENoIn = try(do{ r <- regE; return $ CondRE r})
326 | <|> do{ e <- aritENoIn; o <- optionMaybe (do{ q <- op "?"; e1 <- assignENoIn; c <- op ":"; e2 <- assignENoIn; return $ (q, e1, c, e2)}); return $ CondE e o}
327 |
328 | nonAssignE = do{ e <- aritE; o <- optionMaybe (do{ q <- op "?"; e1 <- nonAssignE; c <- op ":"; e2 <- nonAssignE; return $ (q, e1, c, e2)}); return $ NAssignE e o}
329 |
330 | nonAssignENoIn = do{ e <- aritENoIn; o <- optionMaybe (do{ q <- op "?"; e1 <- nonAssignENoIn; c <- op ":"; e2 <- nonAssignENoIn; return $ (q, e1, c, e2)}); return $ NAssignE e o}
331 |
332 | typeE = nonAssignE
333 |
334 | typeENoIn = nonAssignENoIn
335 |
336 | assignE = try(do{ p <- postFixE;
337 | try(do{o <- choice [op "&&=", op "^^=", op "||="]; a <- assignE; return $ ALogical p o a})
338 | <|> try(do{o <- choice [op "*=", op "/=", op "%=", op "+=", op "-=", op "<<=", op ">>=", op ">>>=", op "&=", op "^=", op "|="]; a <- assignE; return $ ACompound p o a})
339 | <|> do{o <- op "="; a <- assignE; return $ AAssign p o a}
340 | }
341 | )
342 | <|> do{ e <- condE; return $ ACond e}
343 |
344 | assignENoIn = try(do{ p <- postFixE;
345 | try(do{o <- choice [op "&&=", op "^^=", op "||="]; a <- assignENoIn; return $ ALogical p o a})
346 | <|> try(do{o <- choice [op "*=", op "/=", op "%=", op "+=", op "-=", op "<<=", op ">>=", op ">>>=", op "&=", op "^=", op "|="]; a <- assignENoIn; return $ ACompound p o a})
347 | <|> do{o <- op "="; a <- assignENoIn; return $ AAssign p o a}
348 | }
349 | )
350 | <|> do{ e <- condE; return $ ACond e}
351 |
352 | expr = do{ x <- assignE; return $ Expr x}
353 |
354 | exprNoIn = do{ x <- assignENoIn; return $ Expr x}
355 |
356 | statement = try(do{ x <- varS; return x})
357 | <|> try(do{ x <- forS; return x})
358 | <|> do{ x <- forInS; return x}
359 |
360 | forS = do k <- kw "for"
361 | l <- op "("
362 | init <- optionMaybe forInit
363 | s <- op ";"
364 | e <- optionMaybe listE
365 | s1 <- op ";"
366 | e1 <- optionMaybe listE
367 | r <- op ")"
368 | b <- block
369 | return $ ForS k l init s e s1 e1 r b
370 | where forInit = try(do{ l <- listENoIn; return $ FIListE l})
371 | <|> do{ x <- varS; return $ FIVarS x}
372 |
373 | forInS = do k <- kw "for"
374 | me <- optionMaybe (kw "each")
375 | l <- op "("
376 | fb <- fbind
377 | i <- kw "in"
378 | e <- listE
379 | r <- op ")"
380 | b <- block
381 | return $ ForInS k me l fb i e r b
382 | where fbind = try(do{ p <- postFixE; return $ FIBPostE p})
383 | <|> do{ v <- choice [kw "var", kw "const"]; b <- varBinding; return $ FIBVar v b}
384 |
--------------------------------------------------------------------------------
/System/Console/ParseArgs.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE FlexibleInstances #-}
2 | -- Full-featured argument parsing library for Haskell programs
3 | -- Bart Massey
4 |
5 | -- Copyright (C) 2007 Bart Massey
6 | -- ALL RIGHTS RESERVED
7 |
8 | -- You can redistribute and/or modify this library under the
9 | -- terms of the "3-clause BSD LICENSE", as stated in the file
10 | -- COPYING in the top-level directory of this distribution.
11 | --
12 | -- This library is distributed in the hope that it will be
13 | -- useful, but WITHOUT ANY WARRANTY; without even the
14 | -- implied warranty of MERCHANTABILITY or FITNESS FOR A
15 | -- PARTICULAR PURPOSE.
16 |
17 | -- |This module supplies an argument parser.
18 | -- Given a description of type [`Arg`] of the legal
19 | -- arguments to the program, a list of argument strings,
20 | -- and a bit of extra information, the `parseArgs` function
21 | -- in this module returns an
22 | -- `Args` data structure suitable for querying using the
23 | -- provided functions `gotArg`, `getArg`, etc.
24 | module System.Console.ParseArgs (
25 | -- * Describing allowed arguments
26 | -- |The argument parser requires a description of
27 | -- the arguments that will be parsed. This is
28 | -- supplied as a list of `Arg` records, built up
29 | -- using the functions described here.
30 | Arg(..),
31 | Argtype(..),
32 | ArgsComplete(..),
33 | -- ** DataArg and its pseudo-constructors
34 | DataArg,
35 | argDataRequired, argDataOptional, argDataDefaulted,
36 | -- * Argument processing
37 | -- |The argument descriptions are used to parse
38 | -- the command line arguments, and the results
39 | -- of the parse can later be (efficiently) queried
40 | -- to determine program behavior.
41 |
42 | -- ** Getting parse results
43 | -- |The argument parser returns an opaque map
44 | -- from argument index to parsed argument data
45 | -- (plus some convenience information).
46 | ArgRecord, Args(..),
47 | parseArgs, parseArgsIO,
48 | -- ** Using parse results
49 | -- |Query functions permit checking for the existence
50 | -- and values of command-line arguments.
51 | gotArg, ArgType(..),
52 | getArgString, getArgFile, getArgStdio,
53 | getArgInteger, getArgInt,
54 | getArgDouble, getArgFloat,
55 | ArgFileOpener(..),
56 | -- * Misc
57 | baseName, usageError,
58 | System.IO.IOMode(ReadMode, WriteMode, AppendMode))
59 | where
60 |
61 | import Data.List
62 | import qualified Data.Map as Map
63 | import Control.Monad
64 | import Data.Maybe
65 | import System.Environment
66 | import Control.Monad.ST
67 | import System.IO
68 | import Control.Exception
69 | import Data.Generics
70 |
71 | -- The main job of this module is to provide parseArgs.
72 | -- See below for its contract.
73 |
74 | --
75 | -- Provided datatypes.
76 | --
77 |
78 | -- |The description of an argument, suitable for
79 | -- messages and for parsing. The `argData` field
80 | -- is used both for flags with a data argument, and
81 | -- for positional data arguments.
82 | --
83 | -- There are two cases:
84 | --
85 | -- (1) The argument is a flag, in which case at least
86 | -- one of `argAbbr` and `argName` is provided;
87 | --
88 | -- (2) The argument is positional, in which case neither
89 | -- `argAbbr` nor `argName` are provided, but `argData` is.
90 | --
91 | -- If none of `argAbbr`, `argName`, or `argData` are
92 | -- provided, this is an error. See also the
93 | -- `argDataRequired`, `argDataOptional`, and
94 | -- `argDataDefaulted` functions below, which are used to
95 | -- generate `argData`.
96 | data (Ord a) => Arg a =
97 | Arg { argIndex :: a -- ^Connects the input description
98 | -- to the output argument.
99 | , argAbbr :: Maybe Char -- ^One-character flag name.
100 | , argName :: Maybe String -- ^\"Long name\" of flag.
101 | , argData :: Maybe DataArg -- ^Datum description.
102 | , argDesc :: String -- ^Documentation for the argument.
103 | }
104 | deriving (Show, Data, Typeable)
105 |
106 | -- |The types of an argument carrying data. The constructor
107 | -- argument is used to carry a default value.
108 | --
109 | -- The constructor argument should really be hidden.
110 | -- Values of this type are normally constructed within
111 | -- the pseudo-constructors pseudo-constructors
112 | -- `argDataRequired`, `argDataOptional`, and
113 | -- `argDataDefaulted`, to which only the constructor
114 | -- function itself is passed.
115 | data Argtype = ArgtypeString (Maybe String)
116 | | ArgtypeInteger (Maybe Integer)
117 | | ArgtypeInt (Maybe Int)
118 | | ArgtypeDouble (Maybe Double)
119 | | ArgtypeFloat (Maybe Float)
120 | deriving (Show, Data, Typeable)
121 |
122 | -- |Information specific to an argument carrying a datum. This
123 | -- is an opaque type, whose instances are constructed using the
124 | -- pseudo-constructors `argDataRequired`, `argDataOptional`,
125 | -- and `argDataDefaulted`.
126 | data DataArg = DataArg { dataArgName :: String -- ^Print name of datum.
127 | , dataArgArgtype :: Argtype -- ^Type of datum.
128 | , dataArgOptional :: Bool -- ^Datum is not required.
129 | }
130 | deriving (Show, Data, Typeable)
131 |
132 | -- |Generate the `argData` for the given non-optional argument.
133 | argDataRequired :: String -- ^Datum print name.
134 | -> (Maybe a -> Argtype) -- ^Type constructor for datum.
135 | -> Maybe DataArg -- ^Result is `argData`-ready.
136 | argDataRequired s c = Just (DataArg { dataArgName = s,
137 | dataArgArgtype = c Nothing,
138 | dataArgOptional = False })
139 |
140 | -- |Generate the `argData` for the given optional argument with no default.
141 | argDataOptional :: String -- ^Datum print name.
142 | -> (Maybe a -> Argtype) -- ^Type constructor for datum.
143 | -> Maybe DataArg -- ^Result is `argData`-ready.
144 | argDataOptional s c = Just (DataArg { dataArgName = s,
145 | dataArgArgtype = c Nothing,
146 | dataArgOptional = True })
147 |
148 | -- |Generate the `argData` for the given optional argument with the
149 | -- given default.
150 | argDataDefaulted :: String -- ^Datum print name.
151 | -> (Maybe a -> Argtype) -- ^Type constructor for datum.
152 | -> a -- ^Datum default value.
153 | -> Maybe DataArg -- ^Result is `argData`-ready.
154 | argDataDefaulted s c d = Just (DataArg { dataArgName = s,
155 | dataArgArgtype = c (Just d),
156 | dataArgOptional = True })
157 | --
158 | -- Returned datatypes.
159 | --
160 |
161 | -- |The \"kinds of values\" an argument can have.
162 | data Argval = ArgvalFlag -- ^For simple present vs not-present flags.
163 | | ArgvalString String
164 | | ArgvalInteger Integer
165 | | ArgvalInt Int
166 | | ArgvalDouble Double
167 | | ArgvalFloat Float
168 | deriving (Show, Data, Typeable)
169 |
170 | -- |The type of the mapping from argument index to value.
171 | newtype ArgRecord a = ArgRecord (Map.Map a Argval)
172 | deriving (Show, Data, Typeable)
173 |
174 | -- |The data structure `parseArgs` produces. The key
175 | -- element is the `ArgRecord` `args`.
176 | data (Ord a) => Args a =
177 | Args { args :: ArgRecord a -- ^The argument map.
178 | , argsProgName :: String -- ^Basename of 0th argument.
179 | , argsUsage :: String -- ^Full usage string.
180 | , argsRest :: [ String ] -- ^Remaining unprocessed arguments.
181 | }
182 | deriving (Show, Data, Typeable)
183 | --
184 | -- Implementation.
185 | --
186 |
187 | -- |True if the described argument is positional.
188 | arg_posn :: (Ord a) =>
189 | Arg a -- ^Argument.
190 | -> Bool -- ^True if argument is positional.
191 | arg_posn (Arg { argAbbr = Nothing,
192 | argName = Nothing }) = True
193 | arg_posn _ = False
194 |
195 | -- |True if the described argument is a flag.
196 | arg_flag :: (Ord a) =>
197 | Arg a -- ^Argument.
198 | -> Bool -- ^True if argument is a flag.
199 | arg_flag a = not (arg_posn a)
200 |
201 | -- |True if the described argument is optional.
202 | arg_optional :: (Ord a) =>
203 | Arg a -- ^Argument.
204 | -> Bool -- ^False if argument is required to be present.
205 | arg_optional (Arg { argData = Just (DataArg { dataArgOptional = b }) }) = b
206 | arg_optional _ = True
207 |
208 | -- |Return the value of a defaulted argument.
209 | arg_default_value :: (Ord a)
210 | => Arg a -- ^Argument.
211 | -> Maybe Argval -- ^Optional default value.
212 | arg_default_value arg@(Arg { argData = Just
213 | (DataArg { dataArgArgtype = da }) }) |
214 | arg_optional arg =
215 | defval da
216 | where
217 | defval (ArgtypeString (Just v)) = Just (ArgvalString v)
218 | defval (ArgtypeInteger (Just v)) = Just (ArgvalInteger v)
219 | defval (ArgtypeInt (Just v)) = Just (ArgvalInt v)
220 | defval (ArgtypeDouble (Just v)) = Just (ArgvalDouble v)
221 | defval (ArgtypeFloat (Just v)) = Just (ArgvalFloat v)
222 | defval _ = Nothing
223 | arg_default_value _ = Nothing
224 |
225 | -- |There's probably a better way to do this.
226 | perhaps b s = if b then s else ""
227 |
228 | -- |Format the described argument as a string.
229 | arg_string :: (Ord a) =>
230 | Arg a -- ^Argument to be described.
231 | -> String -- ^String describing argument.
232 | arg_string a@(Arg { argAbbr = abbr,
233 | argName = name,
234 | argData = arg }) =
235 | (optionally "[") ++
236 | (sometimes flag_abbr abbr) ++
237 | (perhaps ((isJust abbr) && (isJust name)) ",") ++
238 | (sometimes flag_name name) ++
239 | (perhaps ((arg_flag a) && (isJust arg)) " ") ++
240 | (sometimes data_arg arg) ++
241 | (optionally "]")
242 | where
243 | sometimes = maybe ""
244 | optionally s = perhaps (arg_optional a) s
245 | flag_name s = "--" ++ s
246 | flag_abbr c = [ '-', c ]
247 | data_arg (DataArg {dataArgName = s}) = "<" ++ s ++ ">"
248 |
249 | -- |Filter out the empty keys for a hash.
250 | filter_keys :: [ (Maybe a, b) ] -- ^List of (optional key, value) pairs.
251 | -> [ (a, b) ] -- ^Pairs with actual keys.
252 | filter_keys l =
253 | foldr check_key [] l
254 | where
255 | check_key (Nothing, _) rest = rest
256 | check_key (Just k, v) rest = (k, v) : rest
257 |
258 | -- |Fail with an error if the argument description is bad
259 | -- for some reason.
260 | argdesc_error :: String -- ^Error message.
261 | -> a -- ^Bogus polymorphic result.
262 | argdesc_error msg =
263 | error ("internal error: argument description: " ++ msg)
264 |
265 | -- |Make a keymap.
266 | keymap_from_list :: (Ord k, Show k) =>
267 | [ (k, a) ] -- ^List of key-value pairs.
268 | -- Will be checked for duplicate keys.
269 | -> Map.Map k a -- ^Key-value map.
270 | keymap_from_list l =
271 | foldl add_entry Map.empty l
272 | where
273 | add_entry m (k, a) =
274 | case Map.member k m of
275 | False -> Map.insert k a m
276 | True -> argdesc_error ("duplicate argument description name " ++
277 | (show k))
278 |
279 | -- |Make a keymap for looking up a flag argument.
280 | make_keymap :: (Ord a, Ord k, Show k) =>
281 | ((Arg a) -> Maybe k) -- ^Mapping from argdesc to flag key.
282 | -> [ Arg a ] -- ^List of argdesc.
283 | -> (Map.Map k (Arg a)) -- ^Map from key to argdesc.
284 | make_keymap f_field args =
285 | (keymap_from_list .
286 | filter_keys .
287 | map (\arg -> (f_field arg, arg))) args
288 |
289 | -- |How \"sloppy\" the parse is.
290 | data ArgsComplete = ArgsComplete -- ^Any extraneous arguments
291 | -- (unparseable from description)
292 | -- will cause the parser to fail.
293 | | ArgsTrailing -- ^Trailing extraneous arguments are
294 | -- permitted, and will be skipped,
295 | -- saved, and returned.
296 | | ArgsInterspersed -- ^All extraneous arguments are
297 | -- permitted, and will be skipped,
298 | -- saved, and returned.
299 | deriving (Show, Data, Typeable)
300 |
301 | -- |The iteration function is given a state and a list, and
302 | -- expected to produce a new state and list. The function
303 | -- is again invoked with the resulting state and list.
304 | -- When the function returns the empty list, `exhaust` returns
305 | -- the final state produced.
306 | exhaust :: (s -> [e] -> ([e], s)) -- ^Function to iterate.
307 | -> s -- ^Initial state.
308 | -> [e] -- ^Initial list.
309 | -> s -- ^Final state.
310 | exhaust f s [] = s
311 | exhaust f s l =
312 | let (l', s') = f s l
313 | in exhaust f s' l'
314 |
315 | -- |Print an error message during parsing.
316 | parse_error :: String -- ^Usage message.
317 | -> String -- ^Specific error message.
318 | -> a -- ^Bogus polymorphic result.
319 | parse_error usage msg = error $ usage ++ "\n" ++ msg
320 |
321 | -- |Given a description of the arguments, `parseArgs` produces
322 | -- a map from the arguments to their \"values\" and some other
323 | -- useful byproducts. `parseArgs` requires that the argument
324 | -- descriptions occur in the order 1) flag arguments, 2) required
325 | -- positional arguments, 3) optional positional arguments; otherwise
326 | -- a runtime error will be thrown.
327 | parseArgs :: (Show a, Ord a) =>
328 | ArgsComplete -- ^Degree of completeness of parse.
329 | -> [ Arg a ] -- ^Argument descriptions.
330 | -> String -- ^Full program pathname.
331 | -> [ String ] -- ^Incoming program argument list.
332 | -> Args a -- ^Outgoing argument parse results.
333 | parseArgs acomplete argd pathname argv =
334 | runST (do
335 | check_argd
336 | let flag_args = takeWhile arg_flag argd
337 | let posn_args = dropWhile arg_flag argd
338 | let name_hash = make_keymap argName flag_args
339 | let abbr_hash = make_keymap argAbbr flag_args
340 | let prog_name = baseName pathname
341 | let usage = make_usage_string prog_name
342 | let (am, posn, rest) = exhaust (parse usage name_hash abbr_hash)
343 | (Map.empty, posn_args, [])
344 | argv
345 | let required_args = filter (not . arg_optional) argd
346 | unless (and (map (check_present usage am) required_args))
347 | (error "internal error")
348 | let am' = foldl supply_defaults am argd
349 | return (Args { args = ArgRecord am',
350 | argsProgName = prog_name,
351 | argsUsage = usage,
352 | argsRest = rest }))
353 | where
354 | supply_defaults am ad@(Arg { argIndex = k }) =
355 | case Map.lookup k am of
356 | Just _ -> am
357 | Nothing -> case arg_default_value ad of
358 | Just v -> Map.insert k v am
359 | Nothing -> am
360 | check_present usage am ad@(Arg { argIndex = k }) =
361 | case Map.lookup k am of
362 | Just _ -> True
363 | Nothing -> parse_error usage ("missing required argument " ++ (arg_string ad))
364 | --- Check for various possible misuses.
365 | check_argd :: ST s ()
366 | check_argd = do
367 | --- Order must be flags, posn args, optional posn args
368 | let residue = dropWhile arg_flag argd
369 | let residue' = dropWhile arg_fixed_posn residue
370 | let residue'' = dropWhile arg_opt_posn residue'
371 | unless (null residue'')
372 | (argdesc_error "argument description in wrong order")
373 | --- No argument may be "nullary".
374 | when (or (map arg_nullary argd))
375 | (argdesc_error "bogus 'nothing' argument")
376 | return ()
377 | where
378 | arg_fixed_posn a = (arg_posn a) && (not (arg_optional a))
379 | arg_opt_posn a = (arg_posn a) && (arg_optional a)
380 | arg_nullary (Arg { argName = Nothing,
381 | argAbbr = Nothing,
382 | argData = Nothing }) = True
383 | arg_nullary _ = False
384 | --- Generate a usage message string
385 | make_usage_string prog_name =
386 | --- top (summary) line
387 | ("usage: " ++ prog_name) ++
388 | (perhaps (not (null flag_args))
389 | " [options]") ++
390 | (perhaps (not (null posn_args))
391 | (" " ++ (unwords (map arg_string posn_args)))) ++
392 | (case acomplete of
393 | ArgsComplete -> ""
394 | _ -> " [--] ...") ++
395 | "\n" ++
396 | --- argument lines
397 | (concatMap (arg_line n) argd)
398 | where
399 | flag_args = filter arg_flag argd
400 | posn_args = filter arg_posn argd
401 | n = maximum (map (length . arg_string) argd)
402 | arg_line n a =
403 | let s = arg_string a in
404 | " " ++ s ++
405 | (replicate (n - (length s)) ' ') ++
406 | " " ++ (argDesc a) ++ "\n"
407 | --- simple recursive-descent parser
408 | parse _ _ _ av@(_, _, []) [] = ([], av)
409 | parse usage _ _ av [] =
410 | case acomplete of
411 | ArgsComplete -> parse_error usage "unexpected extra arguments"
412 | _ -> ([], av)
413 | parse usage name_hash abbr_hash (am, posn, rest) av@(aa : aas) =
414 | case aa of
415 | "--" -> case acomplete of
416 | ArgsComplete -> parse_error usage ("unexpected -- " ++ "(extra arguments not allowed)")
417 | _ -> ([], (am, posn, (rest ++ aas)))
418 | s@('-' : '-' : name) ->
419 | case Map.lookup name name_hash of
420 | Just ad -> peel s ad aas
421 | Nothing ->
422 | case acomplete of
423 | ArgsInterspersed ->
424 | (aas, (am, posn, rest ++ ["--" ++ name]))
425 | _ -> parse_error usage ("unknown argument --" ++ name)
426 | ('-' : abbr : abbrs) ->
427 | case Map.lookup abbr abbr_hash of
428 | Just ad ->
429 | let p@(args', state') = peel ['-', abbr] ad aas
430 | in case abbrs of
431 | [] -> p
432 | ('-' : _) -> parse_error usage ("bad internal '-' in argument " ++ aa)
433 | _ -> (['-' : abbrs] ++ args', state')
434 | Nothing ->
435 | case acomplete of
436 | ArgsInterspersed ->
437 | (['-' : abbrs] ++ aas,
438 | (am, posn, rest ++ [['-', abbr]]))
439 | _ -> parse_error usage ("unknown argument -" ++ [abbr])
440 | aa -> case posn of
441 | (ad@(Arg { argData = Just adata }) : ps) ->
442 | let (argl', (am', _, rest')) =
443 | peel_process (dataArgName adata) ad av
444 | in (argl', (am', ps, rest'))
445 | [] -> case acomplete of
446 | ArgsComplete -> parse_error usage ("unexpected argument " ++ aa)
447 | _ -> (aas, (am, [], rest ++ [aa]))
448 | where
449 | add_entry s m (k, a) =
450 | case Map.member k m of
451 | False -> Map.insert k a m
452 | True -> parse_error usage ("duplicate argument " ++ s)
453 | peel name ad@(Arg { argData = Nothing, argIndex = index }) argl =
454 | let am' = add_entry name am (index, ArgvalFlag)
455 | in (argl, (am', posn, rest))
456 | peel name (Arg { argData = Just (DataArg {}) }) [] =
457 | parse_error usage (name ++ " is missing its argument")
458 | peel name ad argl = peel_process name ad argl
459 | peel_process name
460 | ad@(Arg { argData = Just (DataArg {
461 | dataArgArgtype = atype }),
462 | argIndex = index })
463 | (a : argl) =
464 | let v = case atype of
465 | ArgtypeString _ -> ArgvalString a
466 | ArgtypeInteger _ -> ArgvalInteger (read a)
467 | ArgtypeInt _ -> ArgvalInt (read a)
468 | ArgtypeDouble _ -> ArgvalDouble (read a)
469 | ArgtypeFloat _ -> ArgvalFloat (read a)
470 | am' = add_entry name am (index, v)
471 | in (argl, (am', posn, rest))
472 |
473 |
474 | -- |Most of the time, you just want the environment's
475 | -- arguments and are willing to live in the IO monad.
476 | -- This version of `parseArgs` digs the pathname and arguments
477 | -- out of the system directly.
478 | parseArgsIO :: (Show a, Ord a) =>
479 | ArgsComplete -- ^Degree of completeness of parse.
480 | -> [ Arg a ] -- ^Argument descriptions.
481 | -> IO (Args a) -- ^Argument parse results.
482 | parseArgsIO acomplete argd = do
483 | argv <- getArgs
484 | pathname <- getProgName
485 | return (parseArgs acomplete argd pathname argv)
486 |
487 |
488 | -- |Check whether a given optional argument was supplied. Works on all types.
489 | gotArg :: (Ord a) =>
490 | Args a -- ^Parsed arguments.
491 | -> a -- ^Index of argument to be checked for.
492 | -> Bool -- ^True if the arg was present.
493 | gotArg (Args { args = ArgRecord am }) k =
494 | case Map.lookup k am of
495 | Just _ -> True
496 | Nothing -> False
497 |
498 | -- |Type of values that can be parsed by the argument parser.
499 | class ArgType b where
500 | -- |Fetch an argument's value if it is present.
501 | getArg :: (Show a, Ord a)
502 | => Args a -- ^Parsed arguments.
503 | -> a -- ^Index of argument to be retrieved.
504 | -> Maybe b -- ^Argument value if present.
505 | -- |Fetch the value of a required argument.
506 | getRequiredArg :: (Show a, Ord a)
507 | => Args a -- ^Parsed arguments.
508 | -> a -- ^Index of argument to be retrieved.
509 | -> b -- ^Argument value.
510 | getRequiredArg args index =
511 | case getArg args index of
512 | Just v -> v
513 | Nothing -> error ("internal error: required argument "
514 | ++ show index ++ "not supplied")
515 |
516 | getArgPrimitive decons (Args { args = ArgRecord am }) k =
517 | case Map.lookup k am of
518 | Just v -> Just (decons v)
519 | Nothing -> Nothing
520 |
521 | instance ArgType ([] Char) where
522 | getArg = getArgPrimitive (\(ArgvalString s) -> s)
523 |
524 | -- |[Deprecated] Return the `String` value, if any, of the given argument.
525 | getArgString :: (Show a, Ord a) =>
526 | Args a -- ^Parsed arguments.
527 | -> a -- ^Index of argument to be retrieved.
528 | -> Maybe String -- ^Argument value if present.
529 | getArgString = getArg
530 |
531 | instance ArgType Integer where
532 | getArg = getArgPrimitive (\(ArgvalInteger i) -> i)
533 |
534 | -- |[Deprecated] Return the `Integer` value, if any, of the given argument.
535 | getArgInteger :: (Show a, Ord a) =>
536 | Args a -- ^Parsed arguments.
537 | -> a -- ^Index of argument to be retrieved.
538 | -> Maybe Integer -- ^Argument value if present.
539 | getArgInteger = getArg
540 |
541 | instance ArgType Int where
542 | getArg = getArgPrimitive (\(ArgvalInt i) -> i)
543 |
544 | -- |[Deprecated] Return the `Int` value, if any, of the given argument.
545 | getArgInt :: (Show a, Ord a) =>
546 | Args a -- ^Parsed arguments.
547 | -> a -- ^Index of argument to be retrieved.
548 | -> Maybe Int -- ^Argument value if present.
549 | getArgInt = getArg
550 |
551 | instance ArgType Double where
552 | getArg = getArgPrimitive (\(ArgvalDouble i) -> i)
553 |
554 | -- |[Deprecated] Return the `Double` value, if any, of the given argument.
555 | getArgDouble :: (Show a, Ord a) =>
556 | Args a -- ^Parsed arguments.
557 | -> a -- ^Index of argument to be retrieved.
558 | -> Maybe Double -- ^Argument value if present.
559 | getArgDouble = getArg
560 |
561 | instance ArgType Float where
562 | getArg = getArgPrimitive (\(ArgvalFloat i) -> i)
563 |
564 | -- |[Deprecated] Return the `Float` value, if any, of the given argument.
565 | getArgFloat :: (Show a, Ord a) =>
566 | Args a -- ^Parsed arguments.
567 | -> a -- ^Index of argument to be retrieved.
568 | -> Maybe Float -- ^Argument value if present.
569 | getArgFloat = getArg
570 |
571 | -- |`ArgType` instance for opening a file from its string name.
572 | newtype ArgFileOpener = ArgFileOpener {
573 | argFileOpener :: IOMode -> IO Handle -- ^Function to open the file
574 | }
575 |
576 | instance ArgType ArgFileOpener where
577 | getArg args index =
578 | case getArg args index of
579 | Nothing -> Nothing
580 | Just s -> Just (ArgFileOpener { argFileOpener = openFile s })
581 |
582 | -- |[Deprecated] Treat the `String` value, if any, of the given argument as
583 | -- a file handle and try to open it as requested.
584 | getArgFile :: (Show a, Ord a) =>
585 | Args a -- ^Parsed arguments.
586 | -> a -- ^Index of argument to be retrieved.
587 | -> IOMode -- ^IO mode the file should be opened in.
588 | -> IO (Maybe Handle) -- ^Handle of opened file, if the argument
589 | -- was present.
590 | getArgFile args k m =
591 | case getArg args k of
592 | Just fo -> (do h <- argFileOpener fo m; return (Just h))
593 | Nothing -> return Nothing
594 |
595 |
596 | -- |Treat the `String` value, if any, of the given argument as a
597 | -- file handle and try to open it as requested. If not
598 | -- present, substitute the appropriate one of stdin or
599 | -- stdout as indicated by `IOMode`.
600 | getArgStdio :: (Show a, Ord a) =>
601 | Args a -- ^Parsed arguments.
602 | -> a -- ^Index of argument to be retrieved.
603 | -> IOMode -- ^IO mode the file should be opened in.
604 | -- Must not be `ReadWriteMode`.
605 | -> IO Handle -- ^Appropriate file handle.
606 | getArgStdio args k m =
607 | case getArg args k of
608 | Just s -> openFile s m
609 | Nothing ->
610 | case m of
611 | ReadMode -> return stdin
612 | WriteMode -> return stdout
613 | AppendMode -> return stdout
614 | ReadWriteMode ->
615 | error ("internal error: tried to open stdio "
616 | ++ "in ReadWriteMode")
617 |
618 | ---
619 | --- Misc
620 | ---
621 |
622 | -- |Return the filename part of a pathname.
623 | -- Unnecessarily efficient implementation does a single
624 | -- tail-call traversal with no construction.
625 | baseName :: String -- ^Pathname.
626 | -> String -- ^Rightmost component of pathname.
627 | baseName s =
628 | let s' = dropWhile (/= '/') s in
629 | if null s' then s else baseName (tail s')
630 |
631 |
632 | -- |Generate a usage error with the given supplementary message string.
633 | usageError :: (Ord a) => Args a -> String -> b
634 | usageError args msg = error (argsUsage args ++ "\n" ++ msg)
635 |
--------------------------------------------------------------------------------
/ActionhaXe/Translator.hs:
--------------------------------------------------------------------------------
1 | {-
2 | as3tohaxe - An Actionscript 3 to haXe source file translator
3 | Copyright (C) 2008 Don-Duong Quach
4 |
5 | This program is free software: you can redistribute it and/or modify
6 | it under the terms of the GNU General Public License as published by
7 | the Free Software Foundation, either version 3 of the License, or
8 | (at your option) any later version.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | GNU General Public License for more details.
14 |
15 | You should have received a copy of the GNU General Public License
16 | along with this program. If not, see .
17 | -}
18 | -- Translate an Actionscript 3 AST to haXe and hxml for Flash 10
19 |
20 | module ActionhaXe.Translator where
21 |
22 | import ActionhaXe.Lexer
23 | import ActionhaXe.Data
24 | import ActionhaXe.Prim
25 | import ActionhaXe.Parser
26 | import ActionhaXe.CLArgs
27 | import qualified System.Console.ParseArgs as PA
28 |
29 | import Data.Map (Map)
30 | import qualified Data.Map as Map
31 | import Control.Monad.State
32 | import Data.Foldable (foldlM, foldrM)
33 | import Data.List (intercalate)
34 | import Data.Char (toUpper, isUpper, isAlphaNum)
35 | import Data.Generics -- not Haskell 98
36 | import Data.Maybe (isJust)
37 |
38 | -- subRegex, mkRegex used for text replacement
39 | import Text.Regex
40 |
41 | -- flags
42 | mainPackage = "mainPackage"
43 | fpackage = "packageName"
44 | fclass = "className"
45 | fclassAttr = "classAttr"
46 | hasConstructor = "hasConstructor"
47 |
48 | updateFlag flag val = do st <- get
49 | put st{flags = Map.insert flag val (flags st)}
50 |
51 | deleteFlag flag = do st <- get
52 | put st{flags = Map.delete flag (flags st)}
53 |
54 | getFlag :: String -> StateT AsState IO String
55 | getFlag flag = do st <- get
56 | case Map.lookup flag $ flags st of
57 | Just mval -> return mval
58 | Nothing -> return ""
59 | {- if Map.member flag $ flags st
60 | then do mval <- Map.lookup flag $ flags st
61 | return mval
62 | else return ""
63 | -}
64 |
65 | insertInitMember output = do st <- get
66 | put st{initMembers = (output:(initMembers st))}
67 | st' <- get
68 | return ()
69 |
70 | getMembers = do st <- get
71 | let ret = reverse $ initMembers st
72 | return ret
73 |
74 | getCLArg f = do st <- get
75 | return $ PA.gotArg (confArgs (conf st)) f
76 |
77 | maybeEl f i = maybe "" (\m -> f m) i
78 |
79 | cleanup s = subRegex (mkRegex "\\$") s "_S_"
80 |
81 | --translateAs3Ast :: Ast -> StateT AsState IO String
82 | translateAs3Ast p =
83 | case p of
84 | AS3Program x st -> program x >>= return
85 | AS3Directives x st -> directives x >>= return
86 |
87 | directives ds = foldlM (\str i -> do{s <- directive i; return $ str++s}) "" ds
88 | where directive d = case d of
89 | Tok t -> do{ t' <- tok t; return $ cleanup t'}
90 | ImportDecl _ _ _ -> do{ d' <- importDecl d; return $ cleanup $ d'}
91 | Metadata m -> do{ m' <- metadata m; return $ cleanup m'}
92 | MethodDecl _ _ _ _ _ _ -> do{ d' <- methodDecl d; return $ cleanup d'}
93 | VarS _ _ _ _ -> do{ d' <- memberVarS d; return $ cleanup d'}
94 | _ -> return "--unexpected directive--"
95 |
96 | --program :: Package -> StateT AsState IO String
97 | program (Package w p n b) = do case n of
98 | Just ntok -> do{ updateFlag fpackage $ showd ntok ; x <- packageBlock b; return $ cleanup $ showb w ++ showd p ++" "++ showd ntok ++ ";" ++ showw ntok ++ x}
99 | Nothing -> do{ updateFlag fpackage mainPackage; x <-packageBlock b; return $ cleanup $ showb w ++ showw p ++ x}
100 |
101 | packageBlock (Block l bs r) = do
102 | bi <- foldlM (\s b -> do{ x <- packageBlockItem b; return $ s ++ x} ) "" bs
103 | return $ showw l ++ bi
104 |
105 | classBlock (Block l bs r) = do
106 | x <- get
107 | let a = accessors x
108 | let al = Map.toList a
109 | props <- foldlM (\str (k, (t, g, s)) -> do{ t' <- datatype t
110 | ; return $ str ++ showws l ++ "public var " ++ k ++ "("
111 | ++ (if g then "get"++ [toUpper $ head k] ++ tail k else "null") ++ ", "
112 | ++ (if s then "set"++ [toUpper $ head k] ++ tail k else "null")
113 | ++ ") : " ++ t' ++ ";"
114 | }
115 | ) "" al
116 | bi <- foldlM (\s b -> do{ x <- classBlockItem b; return $ s ++ x} ) "" bs
117 | nc <- checkConstructor l
118 | return $ showd l ++ showw l ++ nc ++ props ++ showw l ++ bi ++ showb r
119 |
120 | checkConstructor l = do
121 | con <- getFlag hasConstructor
122 | x <- getMembers
123 | if con == ""
124 | then do let (nl, i) = getNlIndent l
125 | initM <- getInitMembers l
126 | return $ "public function new() { " ++ initM ++ "}"++ nl ++ i
127 | else return ""
128 |
129 | interfaceBlock (Block l bs r) = do
130 | bi <- foldlM (\s b -> do{ x <- interfaceBlockItem b; return $ s ++ x} ) "" bs
131 | return $ showb l ++ bi ++ showb r
132 |
133 | blockItemFold bs = foldlM (\s b -> do{ x <- blockItem b; return $ s ++ x} ) "" bs
134 |
135 | block (Block l bs r) = do
136 | bi <- blockItemFold bs
137 | return $ showb l ++ bi ++ showb r
138 |
139 | constructorBlock (Block l bs r) = do
140 | bi <- blockItemFold bs
141 | initM <- getInitMembers l
142 | return $ showb l ++ initM ++ bi ++ showb r
143 |
144 | getNlIndent l =
145 | let spacebreak = break (\c -> c == '\n') ( reverse $ showw l)
146 | i = reverse $ fst spacebreak
147 | nl = if length (snd spacebreak) > 1 && (snd spacebreak)!!1 == '\r' then "\r\n" else "\n"
148 | in (nl, i)
149 |
150 | getInitMembers l =
151 | do let (nl, i) = getNlIndent l
152 | x <- getMembers
153 | if length x > 0
154 | then return $ nl++i++ intercalate (nl++i) x ++ nl ++ i
155 | else return $ ""
156 |
157 |
158 | packageBlockItem b =
159 | do x <- case b of
160 | Tok t -> tok t >>= return
161 | ImportDecl _ _ _ -> importDecl b >>= return
162 | ClassDecl _ _ _ _ _ _ -> classDecl b >>= return
163 | Interface _ _ _ _ _ -> interface b >>= return
164 | Metadata m -> metadata m >>= return
165 | _ -> return ""
166 | return x
167 |
168 | classBlockItem b =
169 | do x <- case b of
170 | Tok t -> tok t >>= return
171 | MethodDecl _ _ _ _ _ _ -> methodDecl b >>= return
172 | VarS _ _ _ _ -> memberVarS b >>= return
173 | Metadata m -> metadata m >>= return
174 | Block _ _ _ -> block b >>= return
175 | _ -> return $ show b
176 | return x
177 |
178 | interfaceBlockItem b =
179 | do x <- case b of
180 | Tok t -> tok t >>= return
181 | MethodDecl _ _ _ _ _ _ -> imethodDecl b >>= return
182 | Metadata m -> metadata m >>= return
183 | _ -> return $ show b
184 | return x
185 |
186 | blockItem b =
187 | do x <- case b of
188 | Tok t -> tok t >>= return
189 | Block _ _ _ -> block b >>= return
190 | VarS _ _ _ _ -> varS b >>= return
191 | ForS _ _ _ _ _ _ _ _ _ -> forS b >>= return
192 | ForInS _ _ _ _ _ _ _ _ -> forInS b >>= return
193 | Expr _ -> expr b >>= return
194 | Metadata m -> metadata m >>= return
195 | _ -> return ""
196 | return x
197 |
198 | tok t = do let x = showb t
199 | f <- getFlag fpackage
200 | return x
201 |
202 | metadata m = case m of
203 | MD l t x r -> do{ return $ "/*" ++ showb l ++ showb t ++ showl x++ showd r ++ "*/" ++ showw r}
204 | MDSwf attr -> do{ o <- swfheader attr ["400", "300", "30", "FFFFFF"]
205 | ; st <- get
206 | ; let outclass = reverse $ drop 3 $ reverse $ filename st
207 | ; liftIO $ writeFile ((outfile st) ++ "ml") ("-swf "++outclass++".swf\n-main "++outclass++"\n-swf-version 10\n-swf-header " ++ o)
208 | ; return ""
209 | }
210 | where swfheader ((k, v):as) [w, h, f, b] =
211 | case showd k of
212 | "width" -> swfheader as [init.tail $ showd v, h, f, b]
213 | "height" -> swfheader as [w, init.tail $ showd v, f, b]
214 | "frameRate" -> swfheader as [w, h, init.tail $ showd v, b]
215 | "backgroundColor" -> swfheader as [w, h, f, tail.init.tail $ showd v]
216 | swfheader [] header = return $ intercalate ":" header
217 |
218 | importDecl (ImportDecl i n s) = do
219 | ci <- getCLArg CreateImports
220 | let show_n = showd n
221 | let n' = if ci && elem '*' show_n
222 | then (\(h, t) -> init h ++ tail t) $ break (== '*') $ subRegex (mkRegex "\\.") ("Import_" ++ show_n) "_"
223 | else show_n
224 | return $ showb i ++ n' ++ maybeEl showb s
225 |
226 |
227 | classDecl (ClassDecl a c n e i b) = do
228 | updateFlag fclass $ showd n
229 | updateFlag fclassAttr $ publicAttr a
230 | x <- classBlock b
231 | let e' = maybe [] (\(k, c) -> if showd c == "Object" then [] else [showb k ++ showd c] ) e
232 | let i' = maybe [] (\(ic, cs) -> map (\(x, co) -> showb ic ++ showd x) cs ) i
233 | let i'' = i' ++ if "dynamic" `elem` map (\a' -> showd a') a then ["implements Dynamic"] else [""]
234 | let ei = intercalate ", " $ filter (\x -> length x > 0) $ e'++i''
235 | return $ showb c ++ showb n ++ ei ++ " " ++ x
236 | where publicAttr as = if "public" `elem` map (\a -> showd a) as then "public" else "private"
237 |
238 | interface (Interface a i n e b) = do
239 | x <- interfaceBlock b
240 | let e' = maybe [] (\(ic, cs) -> map (\(x, co) -> "implements " ++ showd x) cs ) e
241 | let i' = intercalate ", " e'
242 | return $ showb i ++ showb n ++ i' ++ x
243 |
244 | methodDecl (MethodDecl a f ac n s b) = do
245 | packageName <- getFlag fpackage
246 | className <- getFlag fclass
247 | classAttr <- getFlag fclassAttr
248 | if packageName == mainPackage && className == (showd n) && classAttr == "public"
249 | then do{ x <- maybe (return "") block b; return $ "static " ++ showb f ++ "main() "++ x }
250 | else if className == (showd n)
251 | then do{ updateFlag hasConstructor "true"; x <- maybe (return "") constructorBlock b; s' <- signatureArgs s; return $ namespace a ++ showb f ++ "new"++showw n ++ s' ++ x }
252 | else do st <- get
253 | let accMap = accessors st
254 | case Map.lookup (showd n) accMap of
255 | Just (t, _, _) -> do let arg = getArg s
256 | x <- maybe (return "" ) (accblock arg ac) b
257 | acc' <- accessor ac n s t
258 | return $ namespace a ++ showb f ++ acc' ++ x
259 | Nothing -> do x <- maybe (return "") block b
260 | s' <- signature s
261 | return $ namespace a ++ showb f ++ showb n ++ s' ++ x
262 | where accessor ac name s@(Signature l args r ret) t =
263 | case ac of
264 | Just x -> do{ a <- showArgs args
265 | ; t' <- datatypet t
266 | ; return $ showd x ++ [toUpper $ head $ showd name] ++ tail (showb name) ++ showb l ++ a ++ showd r ++ ":"
267 | ++ fst t' ++ (case ret of { Just (c, t) -> snd t'; Nothing -> showw r})
268 | }
269 | Nothing -> do{ s' <- signature s; return $ showb name ++ s'}
270 | accblock arg ac (Block l bs r) =
271 | do let ts = case ac of { Just x -> if showd x == "set" then "\treturn "++arg++";"++ initl l else ""; Nothing -> ""}
272 | bi <- blockItemFold bs
273 | return $ showb l ++ bi ++ ts ++ showb r
274 | initl l = if length (showw l) > 0
275 | then init $ showw l
276 | else ""
277 | getArg (Signature l (a@(Arg n c t md mc):as) r ret) = showd n
278 | getArg (Signature l [] r ret) = ""
279 |
280 |
281 | imethodDecl (MethodDecl a f ac n s b) = do
282 | s' <- signature s
283 | return $ attr a ++ showb f ++ showb n ++ s'
284 | where attr as = concat $ map (\attr -> case (showd attr) of { "internal" -> "public" ++ showw attr; x -> showb attr }) as
285 |
286 |
287 | signatureArgs (Signature l args r ret) = do{ a <- showArgs args
288 | ; return $ showb l ++ a ++ showb r
289 | }
290 |
291 | rettype ret = case ret of
292 | Just (c, t) -> do{ t' <- datatype t; return $ showb c ++ t'}
293 | Nothing -> return ""
294 |
295 | signature (Signature l args r ret) = do{ a <- showArgs args
296 | ; ret' <- rettype ret
297 | ; return $ showb l ++ a ++ showb r ++ ret'
298 | }
299 |
300 | showArgs as = do{ as' <- mapM showArg as; return $ concat as'}
301 | where showArg (Arg n c t i mc) = do{ i' <- maybe (return "") (\(o, e) -> do{ e' <- assignE e; return $ showb o ++ e'}) i
302 | ; t' <- datatypeiM t i
303 | ; return $ (case i of{ Just d -> "?"; Nothing -> ""}) ++ showb n ++ showb c ++ t' ++ i' ++ maybeEl showb mc
304 | }
305 | showArg (RestArg o n t) = do{ return $ showd n ++ ":Array"}
306 |
307 | memberVarS (VarS ns k v@(VarBinding n d _) vs) = do
308 | if elem "static" (map (\n -> showd n) ns)
309 | then do v' <- varBinding v
310 | vs' <- foldlM (\s (c, x) -> do{ x' <- varBinding x; return $ s ++ showb c ++ x'}) "" vs
311 | -- let inl = if hasPrimitive v && length vs == length (filter (\(c, v) -> hasPrimitive v) vs) && foldr (\x s -> isUpper x && s ) True (showd n) then "inline " else ""
312 | -- return $ inl ++ namespace ns ++ "var" ++ showw k ++ v' ++ vs'
313 | return $ namespace ns ++ "var" ++ showw k ++ v' ++ vs'
314 | else do{ v' <- varBindingInitMember v; vs' <- foldlM (\s (c, x) -> do{ x' <- varBindingInitMember x; return $ s ++ showb c ++ x'}) "" vs; return $ namespace ns ++ "var" ++ showw k ++ v' ++ vs'}
315 |
316 | {-
317 | hasPrimitive = everything (||) (False `mkQ` hasPrimitive')
318 |
319 | hasPrimitive' (TokenNum _) = True
320 | hasPrimitive' (TokenString _) = True
321 | hasPrimitive' (TokenKw "true") = True
322 | hasPrimitive' (TokenKw "false") = True
323 | hasPrimitive' _ = False
324 | -}
325 |
326 | varS (VarS ns k v vs) = do{ v' <- varBinding v; vs' <- foldlM (\s (c, x) -> do{ x' <- varBinding x; return $ s++ showb c ++x' }) "" vs; return $ namespace ns ++ "var" ++ showw k ++ v' ++ vs'}
327 |
328 |
329 | varBinding' (VarBinding n dt i) =
330 | do{ d' <- case dt of
331 | Just (c, t) -> do{ d <- datatypeiM t i; return $ showb c ++ d}
332 | Nothing -> case i of -- try to determine type from initializer
333 | Just (o, e) -> do let e' = getType e
334 | case e' of
335 | Just t -> return $ ":" ++ t ++ showw n -- set type to initializer's type
336 | Nothing -> return $ ":Dynamic" ++ showw n -- can't determine type
337 | Nothing -> return $ ":Dynamic" ++ showw n -- no datatype, no initializer
338 | ; i' <- maybe (return "") (\(o, e) -> do{ e' <- assignE e; return $ showb o ++ e'}) i;
339 | ; return (d', i')
340 | }
341 |
342 | --varBinding :: VarBinding -> StateT AsState IO String
343 | varBinding (VarBinding n dt i) =
344 | do (d', i') <- varBinding' (VarBinding n dt i)
345 | return $ showd n ++ d' ++ i'
346 |
347 | varBindingInitMember (VarBinding n dt i) =
348 | do (d', i') <- varBinding' (VarBinding n dt i)
349 | if i' /= ""
350 | then do insertInitMember $ showb n ++ (if last(showb n) == ' ' then "" else " ") ++ i' ++ ";"
351 | return $ showd n ++ d'
352 | else return $ showd n ++ d' ++ i'
353 |
354 |
355 |
356 |
357 | getType = everything orElse ((Nothing `mkQ` getTypeTokenNum) `extQ` getTypeTokenType)
358 |
359 | getTypeTokenNum (TokenDouble x) = Just "Float"
360 | getTypeTokenNum (TokenInteger x) = Just "Int"
361 | getTypeTokenNum (TokenHex x) = Just "Int"
362 | getTypeTokenNum (TokenOctal x) = Just "Int"
363 | getTypeTokenType (TokenString x) = Just "String"
364 | getTypeTokenType (TokenKw "true") = Just "Bool"
365 | getTypeTokenType (TokenKw "false") = Just "Bool"
366 | getTypeTokenType _ = Nothing
367 |
368 | namespace ns = concat $ map (\attr -> (case showd attr of { "private" -> "" -- all fields by default are private
369 | ; "protected" -> "" -- in haXe private fields are accessible by subclasses
370 | ; "internal" -> "public" ++ showw attr -- internal fields are used by different packages in as3
371 | ; "dynamic" -> "dynamic /*class must implement Dynamic*/" ++ showw attr
372 | ; "final" -> ""
373 | ; _ -> showb attr
374 | }
375 | ) ) ns
376 |
377 | datatypet d = do{ d' <- datatype d; return $ span (\c -> isAlphaNum c || c =='>' || c == '<') d'}
378 |
379 | datatype :: AsType -> StateT AsState IO String
380 | datatype d =
381 | case d of
382 | AsType n -> do d' <- (case (showd n) of
383 | "void" -> return "Void"
384 | "Boolean" -> return "Bool"
385 | "uint" -> return "UInt"
386 | "int" -> return "Int"
387 | "Number" -> do ni <- getCLArg NumberToInt
388 | if ni
389 | then return "Int"
390 | else return "Float"
391 | "String" -> return "String"
392 | "*" -> return "Dynamic"
393 | "Object" -> return "Dynamic"
394 | "Function"-> return "Dynamic"
395 | "Array" -> return "Array"
396 | "XML" -> return "XML"
397 | "RegExp" -> return "EReg"
398 | "Class" -> return "Class"
399 | )
400 | return $ d' ++ showw n
401 | AsTypeRest -> return "Array"
402 | AsTypeUser n -> return $ showb n
403 |
404 | -- Changes type based on initializer value
405 | datatypeiM d Nothing = datatype d
406 | datatypeiM d i =
407 | case d of
408 | AsType n -> do{ r <- case (showd n) of
409 | "void" -> return "Void"
410 | "Boolean" -> return "Bool"
411 | "uint" -> return "UInt"
412 | "int" -> return "Int"
413 | "Number" -> do case i of
414 | Just (o, e) -> do{ if hasIntegerInit e
415 | then return "Int"
416 | else return "Float"
417 | }
418 | Nothing -> do ni <- getCLArg NumberToInt
419 | if ni
420 | then return "Int"
421 | else return "Float"
422 |
423 | "String" -> return "String"
424 | "*" -> return "Dynamic"
425 | "Object" -> return "Dynamic"
426 | "Function"-> return "Dynamic"
427 | "Array" -> return "Array"
428 | "XML" -> return "XML"
429 | "RegExp" -> return "EReg"
430 | "Class" -> return "Class"
431 | ; return $ r ++ showw n
432 | }
433 | AsTypeRest -> return $ "Array"
434 | AsTypeUser n -> return $ showb n
435 |
436 | hasIntegerInit = everything (||) (False `mkQ` isIntegerInit)
437 |
438 | isIntegerInit (TokenInteger x) = True
439 | isIntegerInit _ = False
440 |
441 | {-
442 | hasFloat = everything (||) (False `mkQ` isFloat)
443 |
444 | isFloat (TokenDouble x) = True
445 | isFloat _ = False
446 | -}
447 |
448 | primaryE x = case x of
449 | PEThis x -> do{ return $ showb x}
450 | PEIdent x -> do{ return $ showb x}
451 | PELit x -> do{ return $ showb x}
452 | PEArray x -> do{ r <- arrayLit x; return r}
453 | PEObject x -> do{ r <- objectLit x; return r}
454 | PEXml x -> do{ return $ "Xml.parse(\""++ showd x ++ "\")" ++ showw x}
455 | PEFunc x -> do{ r <- funcE x; return r}
456 | PEParens l x r -> do{ v <- listE x; return $ showb l ++ v ++ showd r ++ showw r}
457 |
458 | arrayLit (ArrayLitC l x r) = do{ return $ showb l ++ maybe "" elision x ++ showb r }
459 |
460 | arrayLit (ArrayLit l x r) = do{ e <- elementList x; return $ showb l ++ e ++ showb r}
461 |
462 | elementList (El l e el r) = do{ es <- assignE e; els <- foldrM (\(EAE c p) s -> do{ ps <- assignE p; return $ elision c ++ ps ++ s}) "" el; return $ maybeEl elision l ++ es ++ els ++ maybeEl elision r }
463 |
464 | elision (Elision x) = showl x
465 |
466 | objectLit (ObjectLit l x r) = do{ p <- maybe (return "") propertyNameAndValueList x; return $ showb l ++ p ++ showb r}
467 |
468 | propertyNameAndValueList (PropertyList x) = do
469 | p <- foldrM (\(p, c, e, s) str -> do{ ex <- assignE e; return $ showb p ++ showb c ++ ex ++ maybe "" showb s ++ str}) "" x
470 | return p
471 |
472 | funcE (FuncE f i s b) = do{ x <- block b; s' <- signature s; return $ showb f ++ s' ++ x}
473 |
474 | listE (ListE l) = do{ x <- foldrM (\(e, c) s -> do{es <- assignE e; return $ es ++ maybe "" showb c ++ s} ) "" l; return x}
475 |
476 | listENoIn = listE
477 |
478 | postFixE x = case x of
479 | PFFull p o -> do{ p' <- fullPostFixE p; o' <- postFixUp o; return $ p' ++ o'}
480 | PFShortNew p o -> do{ p' <- shortNewE p; o' <- postFixUp o; return $ p' ++ o'}
481 | where postFixUp o = return $ maybe "" showb o
482 |
483 | fullPostFixE x = case x of
484 | FPFPrimary p sb -> do{ e <- primaryE p; sub <- foldsub sb; return $ e ++ sub}
485 | FPFFullNew f sb -> do{ e <- fullNewE f; sub <- foldsub sb; return $ e ++ sub}
486 | FPFSuper s p sb -> do{ e <- superE s; p' <- propertyOp p; sub <- foldsub sb; return $ e ++ p' ++ sub}
487 | where foldsub sb = foldrM (\a b -> do{c <- fullPostFixSubE a; return $ c ++ b}) "" sb
488 |
489 | fullPostFixSubE x = case x of
490 | FPSProperty p -> propertyOp p >>= return
491 | FPSArgs a -> args a >>= return
492 | FPSQuery q -> queryOp q >>= return
493 |
494 | fullNewE (FN k e a) = do{ e' <- fullNewSubE e; a' <- args a; return $ showb k ++ e' ++ a'}
495 |
496 | fullNewSubE x = case x of
497 | FN _ _ _ -> do{ e <- fullNewE x; return e}
498 | FNPrimary e p -> do{ e' <- primaryE e; p' <- foldprop p; return $ e' ++ p'}
499 | FNSuper e p -> do{ e' <- superE e; p' <- foldprop p; return $ e' ++ p'}
500 | where foldprop p = foldrM (\a b -> do{ a' <- propertyOp a; return $ a' ++ b}) "" p
501 |
502 | shortNewE (SN k s) = do{ s' <- shortNewSubE s; return $ showb k ++ s'}
503 |
504 | shortNewSubE x = case x of
505 | SNSFull e -> fullNewSubE e >>= return
506 | SNSShort e -> shortNewE e >>= return
507 |
508 | superE (SuperE k p) = do{ p' <- maybe (return "") args p; return $ showb k ++ p'}
509 |
510 | propertyOp x = case x of
511 | PropertyOp o n -> return $ showb o ++ showb n
512 | PropertyB l e r -> do{ e' <- listE e; return $ showb l ++ e' ++ showb r }
513 |
514 | args (Arguments l e r) = do{ e' <- maybe (return "") listE e; return $ showb l ++ e' ++ showb r}
515 |
516 | queryOp x = case x of
517 | QueryOpDD o n -> return $ showb o ++ showb n
518 | QueryOpD o l e r -> do{ e' <- listE e; return $ showb o ++ showb l ++ e' ++ showb r}
519 |
520 | unaryE x = case x of
521 | UEDelete k p -> do if checkDelete p
522 | then deleteField p >>= return
523 | else do{ p' <- postFixE p ; return $ showb k ++ p'}
524 | UEVoid k p -> do{ p' <- postFixE p; return $ showb k ++ p'}
525 | UETypeof k p -> do{ p' <- postFixE p; return $ showb k ++ p'}
526 | UEInc o p -> do{ p' <- postFixE p; return $ showb o ++ p'}
527 | UEDec o p -> do{ p' <- postFixE p; return $ showb o ++ p'}
528 | UEPlus o p -> do{ p' <- unaryE p; return $ showb o ++ p'}
529 | UEMinus o p -> do{ p' <- unaryE p; return $ showb o ++ p'}
530 | UEBitNot o p -> do{ p' <- unaryE p; return $ showb o ++ p'}
531 | UENot o p -> do{ p' <- unaryE p; return $ showb o ++ p'}
532 | UEPrimary p -> postFixE p >>= return
533 | where checkDelete (PFFull (FPFPrimary (PEIdent i) [(FPSProperty (PropertyB _ _ _ ))]) _) = True
534 | checkDelete _ = False
535 | deleteField (PFFull (FPFPrimary (PEIdent i) [(FPSProperty (PropertyB l e r ))]) _) =
536 | do e' <- listE e
537 | return $ "Reflect.deleteField("++showd i++", "++e'++")"
538 |
539 | aritE x = case x of
540 | AEUnary u -> unaryE u >>= return
541 | AEBinary _ _ _ -> binaryE x >>= return
542 |
543 | aritENoIn = aritE
544 |
545 | binaryE (AEBinary o x y)
546 | | 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) }
547 | | 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) }
548 | | showd o == "===" = do{ x' <- aritE x; y' <- aritE y; return $ x' ++"=="++showw o ++ y' }
549 | | showd o == "!==" = do{ x' <- aritE x; y' <- aritE y; return $ x' ++"!="++showw o ++ y' }
550 | | otherwise = do{ x' <- aritE x; y' <- aritE y; return $ x' ++ showb o ++ y'}
551 |
552 |
553 | regE (RegE l x r o) = do{ return $ "~"++ showb l ++ showl x ++ showb r ++ maybeEl showb o}
554 |
555 | condE (CondRE r) = do{ e <- regE r; return $ e}
556 | condE (CondE e o) = do{ e' <- aritE e; o' <- maybe (return "") (\(q, e1, c, e2) -> do{ e1' <- assignE e1; e2' <- assignE e2; return $ showb q ++ e1' ++ showb c ++ e2'}) o; return $ e' ++ o'}
557 |
558 | condENoIn = condE
559 |
560 | nonAssignE (NAssignE e o) = do{ e' <- aritE e; o' <- maybe (return "") (\(q, e1, c, e2) -> do{ e1' <- nonAssignE e1; e2' <- nonAssignE e2; return $ showb q ++ e1' ++ showb c ++ e2'}) o; return $ e' ++ o'}
561 |
562 | nonAssignENoIn = nonAssignE
563 |
564 | assignE x = case x of
565 | ALogical p o a -> do{ p' <- postFixE p; a' <- assignE a; return $ p' ++ showb o ++ a' }
566 | ACompound p o a -> do{ p' <- postFixE p; a' <- assignE a; return $ p' ++ showb o ++ a' }
567 | AAssign p o a -> do{ p' <- postFixE p; a' <- assignE a; return $ p' ++ showb o ++ a' }
568 | ACond e -> condE e >>= return
569 |
570 | assignENoIn = assignE
571 |
572 | typeE = nonAssignE
573 | typeENoIn = nonAssignENoIn
574 |
575 | expr (Expr x) = assignE x
576 |
577 | forS (ForS k l finit s e s1 e1 r b) =
578 | do if isIterator finit e e1
579 | then do let var = findVar finit
580 | start = findInt finit
581 | rop = findROperand e
582 | bound <- maybe (return "") (\r -> do{ r' <- aritE r; return r' }) rop
583 | fblock <- block b
584 | -- convert to iterator
585 | return $ showb k ++ showb l ++ maybeEl showd var ++ " in " ++ maybeEl id start ++ "..." ++ bound ++ showb r ++ fblock
586 | else do fheader <- maybe (return "") cforInit finit
587 | ftest <- maybe (return "") listE e
588 | ftail <- maybe (return "") listE e1
589 | fblock <- cforBlock b ftail
590 | ws <- wsBlock b
591 | -- convert to while
592 | return $ fheader ++ ";" ++ init ws ++ "while " ++ showb l ++ ftest ++ showb r ++ fblock
593 | where cforInit i = do case i of
594 | FIListE l -> listE l >>= return
595 | FIVarS v -> varS v >>= return
596 | cforBlock (Block l bs r) tail = do bi <- blockItemFold bs
597 | return $ showb l ++ bi ++ "\t" ++ tail ++ ";" ++ init (showw l) ++ showb r
598 | wsBlock (Block l bs r) = return $ showw l
599 |
600 | isIterator fi e e1 = hasInteger fi && hasLessThan e && hasPlusPlus e1
601 |
602 | hasInteger = everything (||) (False `mkQ` isInteger)
603 |
604 | isInteger (TokenInteger x) = True
605 | isInteger _ = False
606 |
607 | hasLessThan = everything (||) (False `mkQ` isLessThan)
608 |
609 | isLessThan (TokenOp x) = x == "<"
610 | isLessThan _ = False
611 |
612 | hasPlusPlus = everything (||) (False `mkQ` isPlusPlus)
613 |
614 | isPlusPlus (TokenOp x) = x == "++"
615 | isPlusPlus _ = False
616 |
617 | findVar = everything orElse ((Nothing `mkQ` findVB) `extQ` findVA)
618 | findVB (VarBinding n _ _) = Just n
619 | findVA (PEIdent n) = Just n
620 | findVA _ = Nothing
621 |
622 | findInt = everything orElse (Nothing `mkQ` findI)
623 | findI (TokenInteger x) = Just x
624 | findI _ = Nothing
625 |
626 | findROperand = everything orElse (Nothing `mkQ` findROp)
627 | findROp (AEBinary op l r) = Just r
628 | findROp _ = Nothing
629 |
630 | forInS (ForInS k me l fb i e r b) =
631 | do if isJust me -- for each in?
632 | then do fb' <- eachBinding fb
633 | e' <- listE e
634 | b' <- block b
635 | return $ showb k ++ showb l ++ fb' ++ showb i ++ e' ++ showb r ++ b'
636 | else do fb' <- elseBinding fb
637 | e' <- listE e
638 | b' <- block b
639 | return $ showb k ++ showb l ++ fb' ++ showb i ++ e' ++ showb r ++ b'
640 | where eachBinding (FIBVar _ (VarBinding i _ _)) = return $ showd i ++ " "
641 | eachBinding (FIBPostE p) = do{ p' <- postFixE p; return $ p'}
642 | elseBinding (FIBVar v b) = do{ b' <- varBinding b; return $ showb v ++ b'}
643 | elseBinding (FIBPostE p) = do{ p' <- postFixE p; return $ p'}
644 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | GNU GENERAL PUBLIC LICENSE
2 | Version 3, 29 June 2007
3 |
4 | Copyright (C) 2007 Free Software Foundation, Inc.
5 | Everyone is permitted to copy and distribute verbatim copies
6 | of this license document, but changing it is not allowed.
7 |
8 | Preamble
9 |
10 | The GNU General Public License is a free, copyleft license for
11 | software and other kinds of works.
12 |
13 | The licenses for most software and other practical works are designed
14 | to take away your freedom to share and change the works. By contrast,
15 | the GNU General Public License is intended to guarantee your freedom to
16 | share and change all versions of a program--to make sure it remains free
17 | software for all its users. We, the Free Software Foundation, use the
18 | GNU General Public License for most of our software; it applies also to
19 | any other work released this way by its authors. You can apply it to
20 | your programs, too.
21 |
22 | When we speak of free software, we are referring to freedom, not
23 | price. Our General Public Licenses are designed to make sure that you
24 | have the freedom to distribute copies of free software (and charge for
25 | them if you wish), that you receive source code or can get it if you
26 | want it, that you can change the software or use pieces of it in new
27 | free programs, and that you know you can do these things.
28 |
29 | To protect your rights, we need to prevent others from denying you
30 | these rights or asking you to surrender the rights. Therefore, you have
31 | certain responsibilities if you distribute copies of the software, or if
32 | you modify it: responsibilities to respect the freedom of others.
33 |
34 | For example, if you distribute copies of such a program, whether
35 | gratis or for a fee, you must pass on to the recipients the same
36 | freedoms that you received. You must make sure that they, too, receive
37 | or can get the source code. And you must show them these terms so they
38 | know their rights.
39 |
40 | Developers that use the GNU GPL protect your rights with two steps:
41 | (1) assert copyright on the software, and (2) offer you this License
42 | giving you legal permission to copy, distribute and/or modify it.
43 |
44 | For the developers' and authors' protection, the GPL clearly explains
45 | that there is no warranty for this free software. For both users' and
46 | authors' sake, the GPL requires that modified versions be marked as
47 | changed, so that their problems will not be attributed erroneously to
48 | authors of previous versions.
49 |
50 | Some devices are designed to deny users access to install or run
51 | modified versions of the software inside them, although the manufacturer
52 | can do so. This is fundamentally incompatible with the aim of
53 | protecting users' freedom to change the software. The systematic
54 | pattern of such abuse occurs in the area of products for individuals to
55 | use, which is precisely where it is most unacceptable. Therefore, we
56 | have designed this version of the GPL to prohibit the practice for those
57 | products. If such problems arise substantially in other domains, we
58 | stand ready to extend this provision to those domains in future versions
59 | of the GPL, as needed to protect the freedom of users.
60 |
61 | Finally, every program is threatened constantly by software patents.
62 | States should not allow patents to restrict development and use of
63 | software on general-purpose computers, but in those that do, we wish to
64 | avoid the special danger that patents applied to a free program could
65 | make it effectively proprietary. To prevent this, the GPL assures that
66 | patents cannot be used to render the program non-free.
67 |
68 | The precise terms and conditions for copying, distribution and
69 | modification follow.
70 |
71 | TERMS AND CONDITIONS
72 |
73 | 0. Definitions.
74 |
75 | "This License" refers to version 3 of the GNU General Public License.
76 |
77 | "Copyright" also means copyright-like laws that apply to other kinds of
78 | works, such as semiconductor masks.
79 |
80 | "The Program" refers to any copyrightable work licensed under this
81 | License. Each licensee is addressed as "you". "Licensees" and
82 | "recipients" may be individuals or organizations.
83 |
84 | To "modify" a work means to copy from or adapt all or part of the work
85 | in a fashion requiring copyright permission, other than the making of an
86 | exact copy. The resulting work is called a "modified version" of the
87 | earlier work or a work "based on" the earlier work.
88 |
89 | A "covered work" means either the unmodified Program or a work based
90 | on the Program.
91 |
92 | To "propagate" a work means to do anything with it that, without
93 | permission, would make you directly or secondarily liable for
94 | infringement under applicable copyright law, except executing it on a
95 | computer or modifying a private copy. Propagation includes copying,
96 | distribution (with or without modification), making available to the
97 | public, and in some countries other activities as well.
98 |
99 | To "convey" a work means any kind of propagation that enables other
100 | parties to make or receive copies. Mere interaction with a user through
101 | a computer network, with no transfer of a copy, is not conveying.
102 |
103 | An interactive user interface displays "Appropriate Legal Notices"
104 | to the extent that it includes a convenient and prominently visible
105 | feature that (1) displays an appropriate copyright notice, and (2)
106 | tells the user that there is no warranty for the work (except to the
107 | extent that warranties are provided), that licensees may convey the
108 | work under this License, and how to view a copy of this License. If
109 | the interface presents a list of user commands or options, such as a
110 | menu, a prominent item in the list meets this criterion.
111 |
112 | 1. Source Code.
113 |
114 | The "source code" for a work means the preferred form of the work
115 | for making modifications to it. "Object code" means any non-source
116 | form of a work.
117 |
118 | A "Standard Interface" means an interface that either is an official
119 | standard defined by a recognized standards body, or, in the case of
120 | interfaces specified for a particular programming language, one that
121 | is widely used among developers working in that language.
122 |
123 | The "System Libraries" of an executable work include anything, other
124 | than the work as a whole, that (a) is included in the normal form of
125 | packaging a Major Component, but which is not part of that Major
126 | Component, and (b) serves only to enable use of the work with that
127 | Major Component, or to implement a Standard Interface for which an
128 | implementation is available to the public in source code form. A
129 | "Major Component", in this context, means a major essential component
130 | (kernel, window system, and so on) of the specific operating system
131 | (if any) on which the executable work runs, or a compiler used to
132 | produce the work, or an object code interpreter used to run it.
133 |
134 | The "Corresponding Source" for a work in object code form means all
135 | the source code needed to generate, install, and (for an executable
136 | work) run the object code and to modify the work, including scripts to
137 | control those activities. However, it does not include the work's
138 | System Libraries, or general-purpose tools or generally available free
139 | programs which are used unmodified in performing those activities but
140 | which are not part of the work. For example, Corresponding Source
141 | includes interface definition files associated with source files for
142 | the work, and the source code for shared libraries and dynamically
143 | linked subprograms that the work is specifically designed to require,
144 | such as by intimate data communication or control flow between those
145 | subprograms and other parts of the work.
146 |
147 | The Corresponding Source need not include anything that users
148 | can regenerate automatically from other parts of the Corresponding
149 | Source.
150 |
151 | The Corresponding Source for a work in source code form is that
152 | same work.
153 |
154 | 2. Basic Permissions.
155 |
156 | All rights granted under this License are granted for the term of
157 | copyright on the Program, and are irrevocable provided the stated
158 | conditions are met. This License explicitly affirms your unlimited
159 | permission to run the unmodified Program. The output from running a
160 | covered work is covered by this License only if the output, given its
161 | content, constitutes a covered work. This License acknowledges your
162 | rights of fair use or other equivalent, as provided by copyright law.
163 |
164 | You may make, run and propagate covered works that you do not
165 | convey, without conditions so long as your license otherwise remains
166 | in force. You may convey covered works to others for the sole purpose
167 | of having them make modifications exclusively for you, or provide you
168 | with facilities for running those works, provided that you comply with
169 | the terms of this License in conveying all material for which you do
170 | not control copyright. Those thus making or running the covered works
171 | for you must do so exclusively on your behalf, under your direction
172 | and control, on terms that prohibit them from making any copies of
173 | your copyrighted material outside their relationship with you.
174 |
175 | Conveying under any other circumstances is permitted solely under
176 | the conditions stated below. Sublicensing is not allowed; section 10
177 | makes it unnecessary.
178 |
179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
180 |
181 | No covered work shall be deemed part of an effective technological
182 | measure under any applicable law fulfilling obligations under article
183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or
184 | similar laws prohibiting or restricting circumvention of such
185 | measures.
186 |
187 | When you convey a covered work, you waive any legal power to forbid
188 | circumvention of technological measures to the extent such circumvention
189 | is effected by exercising rights under this License with respect to
190 | the covered work, and you disclaim any intention to limit operation or
191 | modification of the work as a means of enforcing, against the work's
192 | users, your or third parties' legal rights to forbid circumvention of
193 | technological measures.
194 |
195 | 4. Conveying Verbatim Copies.
196 |
197 | You may convey verbatim copies of the Program's source code as you
198 | receive it, in any medium, provided that you conspicuously and
199 | appropriately publish on each copy an appropriate copyright notice;
200 | keep intact all notices stating that this License and any
201 | non-permissive terms added in accord with section 7 apply to the code;
202 | keep intact all notices of the absence of any warranty; and give all
203 | recipients a copy of this License along with the Program.
204 |
205 | You may charge any price or no price for each copy that you convey,
206 | and you may offer support or warranty protection for a fee.
207 |
208 | 5. Conveying Modified Source Versions.
209 |
210 | You may convey a work based on the Program, or the modifications to
211 | produce it from the Program, in the form of source code under the
212 | terms of section 4, provided that you also meet all of these conditions:
213 |
214 | a) The work must carry prominent notices stating that you modified
215 | it, and giving a relevant date.
216 |
217 | b) The work must carry prominent notices stating that it is
218 | released under this License and any conditions added under section
219 | 7. This requirement modifies the requirement in section 4 to
220 | "keep intact all notices".
221 |
222 | c) You must license the entire work, as a whole, under this
223 | License to anyone who comes into possession of a copy. This
224 | License will therefore apply, along with any applicable section 7
225 | additional terms, to the whole of the work, and all its parts,
226 | regardless of how they are packaged. This License gives no
227 | permission to license the work in any other way, but it does not
228 | invalidate such permission if you have separately received it.
229 |
230 | d) If the work has interactive user interfaces, each must display
231 | Appropriate Legal Notices; however, if the Program has interactive
232 | interfaces that do not display Appropriate Legal Notices, your
233 | work need not make them do so.
234 |
235 | A compilation of a covered work with other separate and independent
236 | works, which are not by their nature extensions of the covered work,
237 | and which are not combined with it such as to form a larger program,
238 | in or on a volume of a storage or distribution medium, is called an
239 | "aggregate" if the compilation and its resulting copyright are not
240 | used to limit the access or legal rights of the compilation's users
241 | beyond what the individual works permit. Inclusion of a covered work
242 | in an aggregate does not cause this License to apply to the other
243 | parts of the aggregate.
244 |
245 | 6. Conveying Non-Source Forms.
246 |
247 | You may convey a covered work in object code form under the terms
248 | of sections 4 and 5, provided that you also convey the
249 | machine-readable Corresponding Source under the terms of this License,
250 | in one of these ways:
251 |
252 | a) Convey the object code in, or embodied in, a physical product
253 | (including a physical distribution medium), accompanied by the
254 | Corresponding Source fixed on a durable physical medium
255 | customarily used for software interchange.
256 |
257 | b) Convey the object code in, or embodied in, a physical product
258 | (including a physical distribution medium), accompanied by a
259 | written offer, valid for at least three years and valid for as
260 | long as you offer spare parts or customer support for that product
261 | model, to give anyone who possesses the object code either (1) a
262 | copy of the Corresponding Source for all the software in the
263 | product that is covered by this License, on a durable physical
264 | medium customarily used for software interchange, for a price no
265 | more than your reasonable cost of physically performing this
266 | conveying of source, or (2) access to copy the
267 | Corresponding Source from a network server at no charge.
268 |
269 | c) Convey individual copies of the object code with a copy of the
270 | written offer to provide the Corresponding Source. This
271 | alternative is allowed only occasionally and noncommercially, and
272 | only if you received the object code with such an offer, in accord
273 | with subsection 6b.
274 |
275 | d) Convey the object code by offering access from a designated
276 | place (gratis or for a charge), and offer equivalent access to the
277 | Corresponding Source in the same way through the same place at no
278 | further charge. You need not require recipients to copy the
279 | Corresponding Source along with the object code. If the place to
280 | copy the object code is a network server, the Corresponding Source
281 | may be on a different server (operated by you or a third party)
282 | that supports equivalent copying facilities, provided you maintain
283 | clear directions next to the object code saying where to find the
284 | Corresponding Source. Regardless of what server hosts the
285 | Corresponding Source, you remain obligated to ensure that it is
286 | available for as long as needed to satisfy these requirements.
287 |
288 | e) Convey the object code using peer-to-peer transmission, provided
289 | you inform other peers where the object code and Corresponding
290 | Source of the work are being offered to the general public at no
291 | charge under subsection 6d.
292 |
293 | A separable portion of the object code, whose source code is excluded
294 | from the Corresponding Source as a System Library, need not be
295 | included in conveying the object code work.
296 |
297 | A "User Product" is either (1) a "consumer product", which means any
298 | tangible personal property which is normally used for personal, family,
299 | or household purposes, or (2) anything designed or sold for incorporation
300 | into a dwelling. In determining whether a product is a consumer product,
301 | doubtful cases shall be resolved in favor of coverage. For a particular
302 | product received by a particular user, "normally used" refers to a
303 | typical or common use of that class of product, regardless of the status
304 | of the particular user or of the way in which the particular user
305 | actually uses, or expects or is expected to use, the product. A product
306 | is a consumer product regardless of whether the product has substantial
307 | commercial, industrial or non-consumer uses, unless such uses represent
308 | the only significant mode of use of the product.
309 |
310 | "Installation Information" for a User Product means any methods,
311 | procedures, authorization keys, or other information required to install
312 | and execute modified versions of a covered work in that User Product from
313 | a modified version of its Corresponding Source. The information must
314 | suffice to ensure that the continued functioning of the modified object
315 | code is in no case prevented or interfered with solely because
316 | modification has been made.
317 |
318 | If you convey an object code work under this section in, or with, or
319 | specifically for use in, a User Product, and the conveying occurs as
320 | part of a transaction in which the right of possession and use of the
321 | User Product is transferred to the recipient in perpetuity or for a
322 | fixed term (regardless of how the transaction is characterized), the
323 | Corresponding Source conveyed under this section must be accompanied
324 | by the Installation Information. But this requirement does not apply
325 | if neither you nor any third party retains the ability to install
326 | modified object code on the User Product (for example, the work has
327 | been installed in ROM).
328 |
329 | The requirement to provide Installation Information does not include a
330 | requirement to continue to provide support service, warranty, or updates
331 | for a work that has been modified or installed by the recipient, or for
332 | the User Product in which it has been modified or installed. Access to a
333 | network may be denied when the modification itself materially and
334 | adversely affects the operation of the network or violates the rules and
335 | protocols for communication across the network.
336 |
337 | Corresponding Source conveyed, and Installation Information provided,
338 | in accord with this section must be in a format that is publicly
339 | documented (and with an implementation available to the public in
340 | source code form), and must require no special password or key for
341 | unpacking, reading or copying.
342 |
343 | 7. Additional Terms.
344 |
345 | "Additional permissions" are terms that supplement the terms of this
346 | License by making exceptions from one or more of its conditions.
347 | Additional permissions that are applicable to the entire Program shall
348 | be treated as though they were included in this License, to the extent
349 | that they are valid under applicable law. If additional permissions
350 | apply only to part of the Program, that part may be used separately
351 | under those permissions, but the entire Program remains governed by
352 | this License without regard to the additional permissions.
353 |
354 | When you convey a copy of a covered work, you may at your option
355 | remove any additional permissions from that copy, or from any part of
356 | it. (Additional permissions may be written to require their own
357 | removal in certain cases when you modify the work.) You may place
358 | additional permissions on material, added by you to a covered work,
359 | for which you have or can give appropriate copyright permission.
360 |
361 | Notwithstanding any other provision of this License, for material you
362 | add to a covered work, you may (if authorized by the copyright holders of
363 | that material) supplement the terms of this License with terms:
364 |
365 | a) Disclaiming warranty or limiting liability differently from the
366 | terms of sections 15 and 16 of this License; or
367 |
368 | b) Requiring preservation of specified reasonable legal notices or
369 | author attributions in that material or in the Appropriate Legal
370 | Notices displayed by works containing it; or
371 |
372 | c) Prohibiting misrepresentation of the origin of that material, or
373 | requiring that modified versions of such material be marked in
374 | reasonable ways as different from the original version; or
375 |
376 | d) Limiting the use for publicity purposes of names of licensors or
377 | authors of the material; or
378 |
379 | e) Declining to grant rights under trademark law for use of some
380 | trade names, trademarks, or service marks; or
381 |
382 | f) Requiring indemnification of licensors and authors of that
383 | material by anyone who conveys the material (or modified versions of
384 | it) with contractual assumptions of liability to the recipient, for
385 | any liability that these contractual assumptions directly impose on
386 | those licensors and authors.
387 |
388 | All other non-permissive additional terms are considered "further
389 | restrictions" within the meaning of section 10. If the Program as you
390 | received it, or any part of it, contains a notice stating that it is
391 | governed by this License along with a term that is a further
392 | restriction, you may remove that term. If a license document contains
393 | a further restriction but permits relicensing or conveying under this
394 | License, you may add to a covered work material governed by the terms
395 | of that license document, provided that the further restriction does
396 | not survive such relicensing or conveying.
397 |
398 | If you add terms to a covered work in accord with this section, you
399 | must place, in the relevant source files, a statement of the
400 | additional terms that apply to those files, or a notice indicating
401 | where to find the applicable terms.
402 |
403 | Additional terms, permissive or non-permissive, may be stated in the
404 | form of a separately written license, or stated as exceptions;
405 | the above requirements apply either way.
406 |
407 | 8. Termination.
408 |
409 | You may not propagate or modify a covered work except as expressly
410 | provided under this License. Any attempt otherwise to propagate or
411 | modify it is void, and will automatically terminate your rights under
412 | this License (including any patent licenses granted under the third
413 | paragraph of section 11).
414 |
415 | However, if you cease all violation of this License, then your
416 | license from a particular copyright holder is reinstated (a)
417 | provisionally, unless and until the copyright holder explicitly and
418 | finally terminates your license, and (b) permanently, if the copyright
419 | holder fails to notify you of the violation by some reasonable means
420 | prior to 60 days after the cessation.
421 |
422 | Moreover, your license from a particular copyright holder is
423 | reinstated permanently if the copyright holder notifies you of the
424 | violation by some reasonable means, this is the first time you have
425 | received notice of violation of this License (for any work) from that
426 | copyright holder, and you cure the violation prior to 30 days after
427 | your receipt of the notice.
428 |
429 | Termination of your rights under this section does not terminate the
430 | licenses of parties who have received copies or rights from you under
431 | this License. If your rights have been terminated and not permanently
432 | reinstated, you do not qualify to receive new licenses for the same
433 | material under section 10.
434 |
435 | 9. Acceptance Not Required for Having Copies.
436 |
437 | You are not required to accept this License in order to receive or
438 | run a copy of the Program. Ancillary propagation of a covered work
439 | occurring solely as a consequence of using peer-to-peer transmission
440 | to receive a copy likewise does not require acceptance. However,
441 | nothing other than this License grants you permission to propagate or
442 | modify any covered work. These actions infringe copyright if you do
443 | not accept this License. Therefore, by modifying or propagating a
444 | covered work, you indicate your acceptance of this License to do so.
445 |
446 | 10. Automatic Licensing of Downstream Recipients.
447 |
448 | Each time you convey a covered work, the recipient automatically
449 | receives a license from the original licensors, to run, modify and
450 | propagate that work, subject to this License. You are not responsible
451 | for enforcing compliance by third parties with this License.
452 |
453 | An "entity transaction" is a transaction transferring control of an
454 | organization, or substantially all assets of one, or subdividing an
455 | organization, or merging organizations. If propagation of a covered
456 | work results from an entity transaction, each party to that
457 | transaction who receives a copy of the work also receives whatever
458 | licenses to the work the party's predecessor in interest had or could
459 | give under the previous paragraph, plus a right to possession of the
460 | Corresponding Source of the work from the predecessor in interest, if
461 | the predecessor has it or can get it with reasonable efforts.
462 |
463 | You may not impose any further restrictions on the exercise of the
464 | rights granted or affirmed under this License. For example, you may
465 | not impose a license fee, royalty, or other charge for exercise of
466 | rights granted under this License, and you may not initiate litigation
467 | (including a cross-claim or counterclaim in a lawsuit) alleging that
468 | any patent claim is infringed by making, using, selling, offering for
469 | sale, or importing the Program or any portion of it.
470 |
471 | 11. Patents.
472 |
473 | A "contributor" is a copyright holder who authorizes use under this
474 | License of the Program or a work on which the Program is based. The
475 | work thus licensed is called the contributor's "contributor version".
476 |
477 | A contributor's "essential patent claims" are all patent claims
478 | owned or controlled by the contributor, whether already acquired or
479 | hereafter acquired, that would be infringed by some manner, permitted
480 | by this License, of making, using, or selling its contributor version,
481 | but do not include claims that would be infringed only as a
482 | consequence of further modification of the contributor version. For
483 | purposes of this definition, "control" includes the right to grant
484 | patent sublicenses in a manner consistent with the requirements of
485 | this License.
486 |
487 | Each contributor grants you a non-exclusive, worldwide, royalty-free
488 | patent license under the contributor's essential patent claims, to
489 | make, use, sell, offer for sale, import and otherwise run, modify and
490 | propagate the contents of its contributor version.
491 |
492 | In the following three paragraphs, a "patent license" is any express
493 | agreement or commitment, however denominated, not to enforce a patent
494 | (such as an express permission to practice a patent or covenant not to
495 | sue for patent infringement). To "grant" such a patent license to a
496 | party means to make such an agreement or commitment not to enforce a
497 | patent against the party.
498 |
499 | If you convey a covered work, knowingly relying on a patent license,
500 | and the Corresponding Source of the work is not available for anyone
501 | to copy, free of charge and under the terms of this License, through a
502 | publicly available network server or other readily accessible means,
503 | then you must either (1) cause the Corresponding Source to be so
504 | available, or (2) arrange to deprive yourself of the benefit of the
505 | patent license for this particular work, or (3) arrange, in a manner
506 | consistent with the requirements of this License, to extend the patent
507 | license to downstream recipients. "Knowingly relying" means you have
508 | actual knowledge that, but for the patent license, your conveying the
509 | covered work in a country, or your recipient's use of the covered work
510 | in a country, would infringe one or more identifiable patents in that
511 | country that you have reason to believe are valid.
512 |
513 | If, pursuant to or in connection with a single transaction or
514 | arrangement, you convey, or propagate by procuring conveyance of, a
515 | covered work, and grant a patent license to some of the parties
516 | receiving the covered work authorizing them to use, propagate, modify
517 | or convey a specific copy of the covered work, then the patent license
518 | you grant is automatically extended to all recipients of the covered
519 | work and works based on it.
520 |
521 | A patent license is "discriminatory" if it does not include within
522 | the scope of its coverage, prohibits the exercise of, or is
523 | conditioned on the non-exercise of one or more of the rights that are
524 | specifically granted under this License. You may not convey a covered
525 | work if you are a party to an arrangement with a third party that is
526 | in the business of distributing software, under which you make payment
527 | to the third party based on the extent of your activity of conveying
528 | the work, and under which the third party grants, to any of the
529 | parties who would receive the covered work from you, a discriminatory
530 | patent license (a) in connection with copies of the covered work
531 | conveyed by you (or copies made from those copies), or (b) primarily
532 | for and in connection with specific products or compilations that
533 | contain the covered work, unless you entered into that arrangement,
534 | or that patent license was granted, prior to 28 March 2007.
535 |
536 | Nothing in this License shall be construed as excluding or limiting
537 | any implied license or other defenses to infringement that may
538 | otherwise be available to you under applicable patent law.
539 |
540 | 12. No Surrender of Others' Freedom.
541 |
542 | If conditions are imposed on you (whether by court order, agreement or
543 | otherwise) that contradict the conditions of this License, they do not
544 | excuse you from the conditions of this License. If you cannot convey a
545 | covered work so as to satisfy simultaneously your obligations under this
546 | License and any other pertinent obligations, then as a consequence you may
547 | not convey it at all. For example, if you agree to terms that obligate you
548 | to collect a royalty for further conveying from those to whom you convey
549 | the Program, the only way you could satisfy both those terms and this
550 | License would be to refrain entirely from conveying the Program.
551 |
552 | 13. Use with the GNU Affero General Public License.
553 |
554 | Notwithstanding any other provision of this License, you have
555 | permission to link or combine any covered work with a work licensed
556 | under version 3 of the GNU Affero General Public License into a single
557 | combined work, and to convey the resulting work. The terms of this
558 | License will continue to apply to the part which is the covered work,
559 | but the special requirements of the GNU Affero General Public License,
560 | section 13, concerning interaction through a network will apply to the
561 | combination as such.
562 |
563 | 14. Revised Versions of this License.
564 |
565 | The Free Software Foundation may publish revised and/or new versions of
566 | the GNU General Public License from time to time. Such new versions will
567 | be similar in spirit to the present version, but may differ in detail to
568 | address new problems or concerns.
569 |
570 | Each version is given a distinguishing version number. If the
571 | Program specifies that a certain numbered version of the GNU General
572 | Public License "or any later version" applies to it, you have the
573 | option of following the terms and conditions either of that numbered
574 | version or of any later version published by the Free Software
575 | Foundation. If the Program does not specify a version number of the
576 | GNU General Public License, you may choose any version ever published
577 | by the Free Software Foundation.
578 |
579 | If the Program specifies that a proxy can decide which future
580 | versions of the GNU General Public License can be used, that proxy's
581 | public statement of acceptance of a version permanently authorizes you
582 | to choose that version for the Program.
583 |
584 | Later license versions may give you additional or different
585 | permissions. However, no additional obligations are imposed on any
586 | author or copyright holder as a result of your choosing to follow a
587 | later version.
588 |
589 | 15. Disclaimer of Warranty.
590 |
591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
599 |
600 | 16. Limitation of Liability.
601 |
602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
610 | SUCH DAMAGES.
611 |
612 | 17. Interpretation of Sections 15 and 16.
613 |
614 | If the disclaimer of warranty and limitation of liability provided
615 | above cannot be given local legal effect according to their terms,
616 | reviewing courts shall apply local law that most closely approximates
617 | an absolute waiver of all civil liability in connection with the
618 | Program, unless a warranty or assumption of liability accompanies a
619 | copy of the Program in return for a fee.
620 |
621 | END OF TERMS AND CONDITIONS
622 |
623 |
--------------------------------------------------------------------------------