From 1786dded6476f116c5dee89195b5df63fc6b12a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ola=20Holmstr=C3=B6m?= Date: Fri, 6 Mar 2015 12:09:04 +0100 Subject: [PATCH] Javascript backend using jison --- source/src/BNFC/Backend/Javascript.hs | 31 +++++ source/src/BNFC/Backend/Javascript/CFtoJS.hs | 27 +++++ .../src/BNFC/Backend/Javascript/CFtoJSLex.hs | 80 ++++++++++++ .../BNFC/Backend/Javascript/CFtoJSPrinter.hs | 114 ++++++++++++++++++ .../BNFC/Backend/Javascript/CFtoJSSkeleton.hs | 37 ++++++ .../src/BNFC/Backend/Javascript/CFtoJison.hs | 111 +++++++++++++++++ .../src/BNFC/Backend/Javascript/RegToJSLex.hs | 79 ++++++++++++ source/src/BNFC/Options.hs | 6 +- source/src/Main.hs | 2 + 9 files changed, 486 insertions(+), 1 deletion(-) create mode 100644 source/src/BNFC/Backend/Javascript.hs create mode 100644 source/src/BNFC/Backend/Javascript/CFtoJS.hs create mode 100644 source/src/BNFC/Backend/Javascript/CFtoJSLex.hs create mode 100644 source/src/BNFC/Backend/Javascript/CFtoJSPrinter.hs create mode 100644 source/src/BNFC/Backend/Javascript/CFtoJSSkeleton.hs create mode 100644 source/src/BNFC/Backend/Javascript/CFtoJison.hs create mode 100644 source/src/BNFC/Backend/Javascript/RegToJSLex.hs diff --git a/source/src/BNFC/Backend/Javascript.hs b/source/src/BNFC/Backend/Javascript.hs new file mode 100644 index 000000000..7678ff267 --- /dev/null +++ b/source/src/BNFC/Backend/Javascript.hs @@ -0,0 +1,31 @@ +module BNFC.Backend.Javascript (makeJavascript) where + +import Text.Printf + +import BNFC.CF +import BNFC.Options + +import BNFC.Backend.Base +import BNFC.Backend.Javascript.CFtoJSLex +import BNFC.Backend.Javascript.CFtoJison +import BNFC.Backend.Javascript.CFtoJSPrinter +import BNFC.Backend.Javascript.CFtoJSSkeleton +import BNFC.Backend.Javascript.CFtoJS +import qualified BNFC.Backend.Common.Makefile as Makefile + +makeJavascript :: SharedOptions -> CF -> MkFiles () +makeJavascript opts cf = do + let (lex, env) = cf2jsLex cf + mkfile (name ++ ".jisonlex") lex + mkfile (name ++ ".jison") (cf2Jison name cf env) + mkfile ("Printer" ++ name ++ ".js") (jSPrinter cf env) + mkfile ("Skeleton" ++ name ++ ".js") (jSSkeleton cf env) + mkfile ("Test" ++ name ++ ".js") (jSTest name) + Makefile.mkMakefile opts (makefile name) + where name = lang opts + +makefile :: String -> String +makefile name = unlines $ [ + printf "Parser%s.js: %s.jison %s.jisonlex" name name name + , printf "\tjison %s.jison %s.jisonlex -o Parser%s.js" name name name + ] diff --git a/source/src/BNFC/Backend/Javascript/CFtoJS.hs b/source/src/BNFC/Backend/Javascript/CFtoJS.hs new file mode 100644 index 000000000..59359e30a --- /dev/null +++ b/source/src/BNFC/Backend/Javascript/CFtoJS.hs @@ -0,0 +1,27 @@ +module BNFC.Backend.Javascript.CFtoJS (jSTest) where + +import Text.Printf + +jSTest :: String -> String +jSTest name = unlines $ [ + printf "var parser = require('./Parser%s').parser;" name + , "var fs = require('fs');" + , printf "var Printer = require('./Printer%s').Visitor;\n" name + , "function abstractTree(file) {" + , "\tvar input = fs.readFileSync(file, 'utf-8');" + , "\tvar tree = parser.parse(input);" + , "\tconsole.log(JSON.stringify(tree));" + , "}\n" + , "function normalizedTree(file) {" + , "\tvar input = fs.readFileSync(file, 'utf-8');" + , "\tvar tree = parser.parse(input);" + , "\tvar printer = new Printer()" + , "\tprinter.visit(tree);" + , "\tconsole.log(printer.text);" + , "}\n" + , "console.log('[Abstract Tree]\\n');" + , "abstractTree(process.argv[2]);" + , "console.log('\\n');" + , "console.log('[Linearized Tree]\\n');" + , "normalizedTree(process.argv[2]);" + ] diff --git a/source/src/BNFC/Backend/Javascript/CFtoJSLex.hs b/source/src/BNFC/Backend/Javascript/CFtoJSLex.hs new file mode 100644 index 000000000..f93659a22 --- /dev/null +++ b/source/src/BNFC/Backend/Javascript/CFtoJSLex.hs @@ -0,0 +1,80 @@ +module BNFC.Backend.Javascript.CFtoJSLex (cf2jsLex) where + +import Data.List +import Text.Printf +import Data.Maybe + +import BNFC.CF +import BNFC.Backend.Common.NamedVariables + +import BNFC.Backend.Javascript.RegToJSLex + +cf2jsLex :: CF -> (String, SymEnv) +cf2jsLex cf = (unlines [ + macros + , jsLex $ (userComments cf) + ++ (userSymbols env) + ++ (userTokens env' cf) + ++ defaultTokens cf + ], env') + where + env = makeSymEnv tokens (0 :: Int) + env' = env ++ (makeSymEnv pragmas (length env)) + pragmas = map show $ fst (unzip (tokenPragmas cf)) + makeSymEnv [] _ = [] + makeSymEnv (s:symbs) n = (s, "SYMB" ++ (show n)) : (makeSymEnv symbs (n+1)) + -- The longest tokens first + tokens = sortBy (\a b -> compare (length b) (length a)) (map fst $ cfTokens cf) + +macros :: String +macros = unlines [ + "letter [a-zA-Z]" + , "capital [A-Z]" + , "small [a-z]" + , "digit [0-9]" + , "ident [a-zA-Z0-9\"_\"]" + ] + +jsLex :: [(Int, String -> String)] -> String +jsLex s = unlines [ + "/* Lexical grammar generated by BNFC */" + , "%%" + , concatMap (\(i, f) -> f $ spaces (maxDef - i)) s + ] + where maxDef = 1 + (maximum $ map fst s) + spaces i = replicate i ' ' + +userComments :: CF -> [(Int, String -> String)] +userComments cf = (map (indent . single) s) ++ (map (indent . multi) m) + where (m, s) = comments cf + single a = printf "\"%s\"[^\\n]*" a + multi (a, b) = printf "\"%s\"(.|\\n|\\r)*?\"%s\"" a b + indent a = (length a, \t -> printf (a ++ "%s/* comment */\n") t) + +userSymbols :: SymEnv -> [(Int, String -> String)] +userSymbols se = map userSymbol se + where + userSymbol (s, r) = let e = quote s in (length e, \t -> printf "%s%sreturn '%s'\n" e t r) + quote s = "\"" ++ (concatMap escape s) ++ "\"" + escape c = if c == '\\' then '\\':[c] else [c] + +userTokens :: SymEnv -> CF -> [(Int, String -> String)] +userTokens se cf = map userToken $ tokenPragmas cf + where userToken (name, exp) = let s = (printRegJSLex exp) in + (length s, \t -> printf "%s%sreturn '%s'\n" + s t (symb $ show name)) + symb name = fromJust $ lookup name se + +defaultTokens :: CF -> [(Int, String -> String)] +defaultTokens cf = special ++ [ + (3, \t -> printf "\\s+%s/* skip whitespace */\n" t) + , (7, \t -> printf "<>%sreturn 'EOF'\n" t) + , (1, \t -> printf ".%sreturn 'INVALID'\n" t) + ] + where special = + ifC "Double" "{digit}+\".\"{digit}+" "return 'DOUBLE'" + ++ ifC "Ident" "{letter}{ident}*" "return 'IDENT'" + ++ ifC "Integer" "{digit}+" "return 'INTEGER'" + ++ ifC "Char" "\\'(?:[^'\\\\]|\\\\.)*\\'" "yytext = yytext.substr(1,yyleng-2); return 'CHAR'" + ++ ifC "String" "\\\"(?:[^\"\\\\]|\\\\.)*\\\"" "yytext = yytext.substr(1,yyleng-2); return 'STRING'" + ifC cat s r = if isUsedCat cf (TokenCat cat) then [(length s, \t -> printf (s++"%s"++r++"\n") t)] else [] diff --git a/source/src/BNFC/Backend/Javascript/CFtoJSPrinter.hs b/source/src/BNFC/Backend/Javascript/CFtoJSPrinter.hs new file mode 100644 index 000000000..778e81334 --- /dev/null +++ b/source/src/BNFC/Backend/Javascript/CFtoJSPrinter.hs @@ -0,0 +1,114 @@ +module BNFC.Backend.Javascript.CFtoJSPrinter (jSPrinter) where + +import Data.List +import Data.Either +import Text.Printf + +import BNFC.CF +import BNFC.Backend.Common.NamedVariables + +jSPrinter :: CF -> SymEnv -> String +jSPrinter cf _ = unlines [ + "var Visitor = exports.Visitor = function () {" + , "\tthis.text = '';" + , "\tthis.indent = 0;" + , "};\n" + , "Visitor.prototype.visit = function (node) {" + , "\treturn this[node.type](node);" + , "};\n" + , "Visitor.prototype.addIndent = function () {" + , "\tthis.text += Array(this.indent + 1).join('\\t');" + , "};\n" + , "Visitor.prototype.removeIndent = function () {" + , "\tif (this.text.substr(-1) == '\\t') this.text = this.text.slice(0, -1);" + , "};\n" + , "Visitor.prototype.visitPrec = function (node1, node2) {" + , printf "\tvar levels = { %s };" $ jSLevels $ jSNames cf + , "\tif (levels[node1.type] > levels[node2.type]) this.text += '(';" + , "\tthis.visit(node2);" + , "\tif (levels[node1.type] > levels[node2.type]) {" + , "\t\tif (this.text.substr(-1) == ' ') this.text = this.text.slice(0, -1);" + , "\t\tthis.text += ')';" + , "\t}" + , "};\n" + , intercalate "\n\n" $ jSMethods $ jSNames cf + ] + + +jSLevels :: [Either String Rule] -> String +jSLevels = intercalate ", " . (map level) . rights + where level r = printf "\"%s\": %d" (funRule r) (precRule r) + +jSNames :: CF -> [Either String Rule] +jSNames cf = rules ++ tokens + where rules = map Right $ filter remove $ concatMap snd $ ruleGroups cf + tokens = map (Left . show . fst) $ tokenPragmas cf + remove r = let x = funRule r in not $ isCoercion x + +jSMethods :: [Either String Rule] -> [String] +jSMethods rs = map method rs + where + method r = printf "Visitor.prototype.%s = function (node) {\n%s\n};" + (name r) (jSAction r) + name = either id ruleName + +ruleName :: Rule -> String +ruleName r + | isNilFun (funRule r) = (cat r) ++ "Nil" + | isOneFun (funRule r) = (cat r) ++ "One" + | isConsFun (funRule r) = (cat r) ++ "Cons" + | otherwise = funRule r + where cat = identCat . valCat + +jSAction :: Either String Rule -> String +jSAction (Left _) = "\tthis.text += node.args[0] + ' ';" -- Tokens +jSAction (Right r) -- Rules + | isList (valCat r) = intercalate "\n" $ map f ts + | otherwise = intercalate "\n" $ map f cs + where cs = jSArgs 0 $ rhsRule r + ts = map (\l -> (0, Right l)) $ rights $ rhsRule r + f = uncurry (jSRhs $ precCat (valCat r)) + +-- Arguments numbers, skip tokens as they are not in the argument array +jSArgs :: Integer -> [Either Cat String] -> [(Integer, Either Cat String)] +jSArgs _ [] = [] +jSArgs i (Left c:xs) = (i, Left c):jSArgs (i+1) xs +jSArgs i (Right s:xs) = (0, Right s):jSArgs i xs + +jSRhs :: Integer -> Integer -> Either Cat String -> String +jSRhs _ 0 (Right s) -- User tokens + | s `elem` norspace = printf "\tthis.text += '%s';" (escape s) + | s `elem` nolspace = pop ++ (printf "\tthis.text += '%s '" (escape s)) + | s == ";" = "\tthis.text += ';\\n'; this.addIndent();" + | s == "{" = "\tthis.text += '{\\n'; this.indent++; this.addIndent();" + | s == "}" = "\tthis.indent--; this.removeIndent(); this.text += '}\\n'; this.addIndent();" + | otherwise = printf "\tthis.text += '%s ';" (escape s) + where norspace = ["[", "("] + nolspace = ["]", ")", ","] + pop = unlines $ [ + "\tif (this.text.substr(-1) === ' ')" + , "\t\tthis.text = this.text.slice(0, -1);" + ] +jSRhs _ i (Left c) -- Cats + | isList c = printf listStr i i cat i cat cat i cat -- so many arguments ... + | (show c) `elem` specialCatsP = case (show c) of + "String" -> printf "\tthis.text += '\"' + node.args[%d] + '\" '" i + "Char" -> printf "\tthis.text += '\\'' + node.args[%d] + '\\' '" i + _ -> printf "\tthis.text += node.args[%d] + ' '" i + | otherwise = printf "\tthis.visitPrec(node, node.args[%d]);" i + where listStr = unlines $ [ + "\tfor (var i=0; i < node.args[%d].length; i++) {" + , "\t\t" ++ action + , "\t\tif (this.%sCons && i+1 < node.args[%d].length) this.%sCons();" + , "\t\tif (!this.%sOne && i+1 == node.args[%d].length) this.%sCons();" + , "\t}" + ] + action = if (show $ catOfList c) `elem` specialCatsP + then "\tthis.text += node.args[%d][i] + ' ';" + else "\tthis.visitPrec(node, node.args[%d][i]);" + cat = identCat c +jSRhs _ _ _ = error "unknown rhs" + +-- | Helpers +escape s = concatMap (\c -> if c `elem` chars then '\\':[c] else [c]) s + where chars = "'" diff --git a/source/src/BNFC/Backend/Javascript/CFtoJSSkeleton.hs b/source/src/BNFC/Backend/Javascript/CFtoJSSkeleton.hs new file mode 100644 index 000000000..60a1601db --- /dev/null +++ b/source/src/BNFC/Backend/Javascript/CFtoJSSkeleton.hs @@ -0,0 +1,37 @@ +module BNFC.Backend.Javascript.CFtoJSSkeleton (jSSkeleton) where + +import Data.List +import Data.Either +import Text.Printf + +import BNFC.CF +import BNFC.Backend.Common.NamedVariables + +jSSkeleton :: CF -> SymEnv -> String +jSSkeleton cf _ = unlines [ + "var Visitor = exports.Visitor = function () {" + , "};\n" + , "Visitor.prototype.visit = function (node) {" + , "\treturn this[node.type](node);" + , "};\n" + , intercalate "\n\n" $ jSMethods $ jSNames cf + ] + +jSNames :: CF -> [Either String Rule] +jSNames cf = rules ++ tokens + where rules = map Right $ filter remove $ concatMap snd $ ruleGroups cf + tokens = map (Left . show . fst) $ tokenPragmas cf + remove r = let x = funRule r + in not $ isCoercion x || isConsFun x + || isOneFun x || isNilFun x + +jSMethods :: [Either String Rule] -> [String] +jSMethods rs = map method rs + where method r = printf "Visitor.prototype.%s = function (node) {\n%s\n};" + (name r) (jSAction r) + name = either id funRule + +jSAction :: Either String Rule -> String +jSAction (Left _) = "return new Error(\"failure\");" +jSAction (Right r) = printf "\t// args: %s\n\treturn new Error(\"failure\")" + (intercalate ", " $ map show $ lefts $ rhsRule r) diff --git a/source/src/BNFC/Backend/Javascript/CFtoJison.hs b/source/src/BNFC/Backend/Javascript/CFtoJison.hs new file mode 100644 index 000000000..0ad8ed658 --- /dev/null +++ b/source/src/BNFC/Backend/Javascript/CFtoJison.hs @@ -0,0 +1,111 @@ +module BNFC.Backend.Javascript.CFtoJison (cf2Jison) where + +import Data.List +import Data.Char +import Data.Maybe +import Text.Printf +import Control.Monad.Reader + +import BNFC.CF +import BNFC.Backend.Common.NamedVariables + +type Group = (Cat, [Rule]) +type JisonEnv = (CF, SymEnv) + +cf2Jison :: String -> CF -> SymEnv -> String +cf2Jison _ cf env = runReader jison (cf, env) + +jison :: Reader JisonEnv String +jison = do + entry <- jisonEntry + rules <- asks fst >>= jisonGroups . ruleGroups + tokens <- asks fst >>= jisonTokens . map show . (map fst) . tokenPragmas + return $ "%%\n\n" ++ entry ++ "\n\n" ++ rules ++ "\n\n" ++ tokens + +jisonEntry :: Reader JisonEnv String +jisonEntry = do + cs <- asks fst >>= return . cf2Entry + let entries = intercalate ("\n\t| " :: String) $ map (\c -> printf "%s EOF\n\t\t{{ $$ = $1; return $$ }}" (show c)) cs + return $ printf "_Entry\n\t: %s \n\t;" entries + where cf2Entry cf = case (allCats cf) == (allEntryPoints cf) of + True -> [firstEntry cf] -- Only use the first entry point, jison isnt playing nice otherwise. + False -> allEntryPoints cf + +jisonGroups :: [Group] -> Reader JisonEnv String +jisonGroups gs = interMapM "\n\n" jisonGroup gs + +jisonGroup :: Group -> Reader JisonEnv String +jisonGroup (cat, rs) = do + s <- interMapM "\n\t| " jisonRule rs + return $ printf "%s\n\t: %s\n\t;" (identCat cat) s + +jisonRule :: Rule -> Reader JisonEnv String +jisonRule r = do + b <- isRev r + let r' = if b then revSepListRule r else r + let (_, (_, cs')) = unRule r' + rule <- unwordsMapM jisonSymbol cs' + action <- jisonAction r' + return $ printf "%s\n\t\t%s" rule action + +jisonAction :: Rule -> Reader JisonEnv String +jisonAction r + | isList cat = jisonActionList r + | isCoercion fun = jisonActionCoercion r + | otherwise = jisonActionNormal r + where (fun, (cat, _)) = unRule r + +jisonActionNormal :: Rule -> Reader JisonEnv String +jisonActionNormal r = do + return $ printf "{{ $$ = { type : '%s', loc: %s, args : [%s] }; }}" + fun jisonLoc (formatArgs cs 1) + where (fun, (_, cs)) = unRule r + +jisonActionCoercion :: Rule -> Reader JisonEnv String +jisonActionCoercion r = return $ printf "{{ $$ = %s; }}" (formatArgs cs 1) + where (_, (_, cs)) = unRule r + +jisonActionList :: Rule -> Reader JisonEnv String +jisonActionList r + | isNilFun fun = return "{{ $$ = []; }}" + | isOneFun fun = return "{{ $$ = [$1]; }}" + | isConsFun fun = isRev r >>= \b -> case b of + True -> return $ printf "{{ $$ = $1.concat([%s]); }}" (formatArgs (tail cs) 2) + False -> return $ printf "{{ $$ = [$1].concat(%s); }}" (formatArgs (tail cs) 2) + | otherwise = error "unknown rule" + where (fun, (_, cs)) = unRule r + +jisonSymbol :: Either Cat String -> Reader JisonEnv String +jisonSymbol (Left cat) + | (show cat) `elem` specialCatsP = return $ map toUpper (show cat) + | otherwise = return $ identCat cat +jisonSymbol (Right s) = asks ((lookup s) . snd) >>= return . fromJust + +jisonTokens :: [String] -> Reader JisonEnv String +jisonTokens ts = interMapM "\n\n" jisonToken ts + +jisonToken :: String -> Reader JisonEnv String +jisonToken t = do + env <- asks snd + let s = fromJust $ lookup t env + return $ printf + "%s\n\t: %s\n\t\t{{ $$ = { type : '%s', loc: %s, args : [$1] }; }}\n\t;" + t s t jisonLoc + +jisonLoc :: String +jisonLoc = printf "{ start: %s, end: %s }" (l "first") (l "last") + where l s = (printf "{ line: @$.%s_line, column: @$.%s_column }" (s :: String) s) :: String + +-- Helpers +isRev r = do + cf <- asks fst + return $ (isConsFun fun) && cat `elem` (reversibleCats cf) + where (fun, (cat, _)) = unRule r +unwordsMapM f l = mapM f l >>= return . unwords +interMapM j f l = mapM f l >>= \s -> return $ intercalate j s +unRule r = (funRule r, (valCat r, rhsRule r)) +formatArgs cs n = intercalate ", " args + where argString arg = "$" ++ (show arg) + args = filter ((/=) "0") + $ map (\(n, e) -> either (const (argString n)) (const "0") e) + $ zip [n..] cs diff --git a/source/src/BNFC/Backend/Javascript/RegToJSLex.hs b/source/src/BNFC/Backend/Javascript/RegToJSLex.hs new file mode 100644 index 000000000..26e0a09cf --- /dev/null +++ b/source/src/BNFC/Backend/Javascript/RegToJSLex.hs @@ -0,0 +1,79 @@ +module BNFC.Backend.Javascript.RegToJSLex (printRegJSLex) where + +-- modified from pretty-printer generated by the BNF converter + +import AbsBNF + +-- the top-level printing method +printRegJSLex :: Reg -> String +printRegJSLex = render . prt 0 + +-- you may want to change render and parenth + +render :: [String] -> String +render = rend (0 :: Int) where + rend i ss = case ss of + "[" :ts -> cons "[" $ rend i ts + "(" :ts -> cons "(" $ rend i ts + t : "," :ts -> cons t $ space "," $ rend i ts + t : ")" :ts -> cons t $ cons ")" $ rend i ts + t : "]" :ts -> cons t $ cons "]" $ rend i ts + t :ts -> space t $ rend i ts + _ -> "" + cons s t = s ++ t + space t s = if null s then t else t ++ s + +parenth :: [String] -> [String] +parenth ss = ["("] ++ ss ++ [")"] + +quote :: String -> String +quote s = "\"" ++ (concatMap escapeChar s) ++ "\"" + +-- the printer class does the job +class Print a where + prt :: Int -> a -> [String] + prtList :: [a] -> [String] + prtList = concat . map (prt 0) + +instance Print a => Print [a] where + prt _ = prtList + +instance Print Char where + prt _ c = [c:""] + prtList s = map (concat . prt 0) s + +escapeChar :: Char -> String +escapeChar '^' = "\\x5E" -- special case, since \^ is a control character escape +escapeChar x | x `elem` jlexReserved = '\\' : [x] +escapeChar x = [x] + +-- Characters that must be escaped in JLex regular expressions +jlexReserved :: [Char] +jlexReserved = ['?', '*', '+', '|', '(', ')', '^', '$', '.', '[', ']', '{', '}', '"', '\\'] + +prPrec :: Int -> Int -> [String] -> [String] +prPrec i j = if j prPrec i 2 (concat [prt 2 reg0 , prt 3 reg]) + RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg]) + RMinus reg0 REps -> prt i reg0 + RMinus RAny reg@(RChar _) -> prPrec i 3 (concat [["[^"],prt 0 reg,["]"]]) + RMinus RAny (RAlts str) -> prPrec i 3 (concat [["[^"],prt 0 str,["]"]]) + RMinus _ _ -> error $ "JLex does not support general set difference" + RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]]) + RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]]) + ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]]) + REps -> prPrec i 3 (["[^.]"]) + RChar c -> prPrec i 3 (concat [prt 0 (quote $ c:"")]) + RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]]) + RSeqs str -> prPrec i 2 (concat (map (prt 0) str)) + RDigit -> prPrec i 3 (concat [["{digit}"]]) + RLetter -> prPrec i 3 (concat [["{letter}"]]) + RUpper -> prPrec i 3 (concat [["{capital}"]]) + RLower -> prPrec i 3 (concat [["{small}"]]) + RAny -> prPrec i 3 (concat [["."]]) diff --git a/source/src/BNFC/Options.hs b/source/src/BNFC/Options.hs index 35cd098f0..99fb4dfcf 100644 --- a/source/src/BNFC/Options.hs +++ b/source/src/BNFC/Options.hs @@ -28,6 +28,7 @@ data Mode data Target = TargetC | TargetCpp | TargetCppNoStl | TargetCSharp | TargetHaskell | TargetHaskellGadt | TargetLatex | TargetJava | TargetOCaml | TargetProfile | TargetPygments + | TargetJavascript deriving (Eq,Bounded, Enum,Ord) -- Create a list of all target using the enum and bounded classes @@ -46,6 +47,7 @@ instance Show Target where show TargetOCaml = "OCaml" show TargetProfile = "Haskell (with permutation profiles)" show TargetPygments = "Pygments" + show TargetJavascript = "Javascript" -- | Which version of Alex is targeted? data AlexVersion = Alex1 | Alex2 | Alex3 @@ -120,7 +122,7 @@ globalOptions = [ -- | Options for the target languages -- targetOptions :: [ OptDescr Target ] targetOptions :: [ OptDescr (SharedOptions -> SharedOptions)] -targetOptions = +targetOptions = [ Option "" ["java"] (NoArg (\o -> o {target = TargetJava})) "Output Java code for use with JLex and CUP" , Option "" ["haskell"] (NoArg (\o -> o {target = TargetHaskell})) @@ -143,6 +145,8 @@ targetOptions = "Output Haskell code for rules with permutation profiles" , Option "" ["pygments"] (NoArg (\o -> o {target = TargetPygments})) "Output a Python lexer for Pygments" + , Option "" ["js"] (NoArg (\o -> o {target = TargetJavascript})) + "Output Javascript code for use with jison" ] -- | A list of the options and for each of them, the target language diff --git a/source/src/Main.hs b/source/src/Main.hs index 72fc9a6df..5dd88b024 100644 --- a/source/src/Main.hs +++ b/source/src/Main.hs @@ -40,6 +40,7 @@ import BNFC.Backend.Java import BNFC.Backend.Latex import BNFC.Backend.OCaml import BNFC.Backend.Pygments +import BNFC.Backend.Javascript import BNFC.GetCF import BNFC.Options hiding (make) @@ -83,3 +84,4 @@ maketarget t = case t of TargetOCaml -> makeOCaml TargetProfile -> error "Not implemented" TargetPygments -> makePygments + TargetJavascript -> makeJavascript