From: adam Date: Sat, 24 Feb 2007 23:02:22 +0000 (-0500) Subject: removed TibDoc/Haskell stuff X-Git-Url: http://git.megacz.com/?p=sbp.git;a=commitdiff_plain;h=eee310fc34d114be6b366f1a94fe6fe49da8b99b removed TibDoc/Haskell stuff darcs-hash:20070224230222-5007d-41e2d19150e9539492bf7e6a8b8d74549807aaa1.gz --- diff --git a/src/Main.lhs b/src/Main.lhs index d9d862f..bcac25b 100644 --- a/src/Main.lhs +++ b/src/Main.lhs @@ -2,9 +2,178 @@ module Main where import SBP -main = do t <- parseFile "../fleeterpreter/fleet.g" "../fleeterpreter/demo.fleet" - putStrLn $ "hi" - putStrLn $ show (prettyPrintTree t) +main = do t <- parseFile "../wix/wix.g" "../wix/lasik.wix" + putStrLn $ toHtml $ ((fromTree $ coalesceFlatHeadlessNodes t) :: Doc) + +-- url crap +-- ul/ol +-- glyphs + +------------------------------------------------------------------------------ +data Doc = Doc Header [Section] +data Section = Section [Text] [Paragraph] +data Paragraph = Blockquote [Text] + | HR + | OL + | P [Text] +data Text = WS + | Chars String + | Symbol String + | Quotes [Text] + | Block [Text] + | Command String [Text] + | Verbatim String + | Link [Text] URL + | Underline [Text] + | Footnote [Text] + | TT [Text] + | Citation [Text] + | Strikethrough [Text] + | Superscript [Text] + | Subscript [Text] + | Smallcap [Text] + | Bold [Text] + | Keyword [Text] + | Italic [Text] +data Header = Header +data URL = URL + deriving Show + +{- +glyph = euro:: "(e)" + | r:: "(r)" + | c:: "(c)" + | tm:: "(tm)" + | emdash:: "--" + | ellipses:: "..." + | cent:: "\\cent" +-} + +------------------------------------------------------------------------------ +class FromTree a where + fromTree :: Tree -> a +class FromTrees a where + fromTrees :: [Tree] -> a +instance FromTree a => FromTree [a] where + fromTree (Tree _ c _) = map fromTree c + +instance FromTree Doc where + fromTree (Tree "Doc" [a,b] _) = Doc Header $ fromTree b + fromTree (Tree "Doc" [b] _) = Doc Header $ fromTree b + fromTree _ = error "top level must be Doc" + +instance FromTree Section where + fromTree (Tree "Section" [(Tree _ c _),(Tree _ paragraphs _)] _) = + Section (map fromTree c) $ map fromTree paragraphs + +instance FromTree Paragraph where + fromTree (Tree "P" [Tree _ text _] _) = P $ map fromTree text + fromTree (Tree "HR" _ _) = HR + +instance FromTree Text where + fromTree (Tree "Chars" chars _) = Chars $ fromTrees chars + fromTree (Tree "WS" _ _) = WS + fromTree (Tree "Symbol" sym _) = Symbol $ fromTrees sym + fromTree (Tree "Quotes" x _) = Quotes $ map fromTree x + fromTree (Tree "Block" x _) = Block $ map fromTree x + fromTree (Tree "Command" [x,y] _) = Command (fromTree x) (fromTree y) + fromTree (Tree "Verbatim" x _) = Verbatim $ fromTrees x + fromTree (Tree "Link" [word,link] _) = Link (fromTree word) (fromTree link) + fromTree (Tree "Underline" x _) = Underline $ map fromTree x + fromTree (Tree "Footnote" x _) = Footnote $ map fromTree x + fromTree (Tree "TT" x _) = TT $ map fromTree x + fromTree (Tree "Citation" x _) = Citation $ map fromTree x + fromTree (Tree "Strikethrough" x _) = Strikethrough $ map fromTree x + fromTree (Tree "Superscript" x _) = Superscript $ map fromTree x + fromTree (Tree "Subscript" x _) = Subscript $ map fromTree x + fromTree (Tree "Smallcap" x _) = Smallcap $ map fromTree x + fromTree (Tree "Bold" x _) = Bold $ map fromTree x + fromTree (Tree "Keyword" x _) = Keyword $ map fromTree x + fromTree (Tree "Italic" x _) = Italic $ map fromTree x + fromTree (Tree x _ _) = Chars $ x + +instance FromTree URL where + fromTree x = URL + +instance FromTree String where + fromTree (Tree h c _) = h++(concatMap fromTree c) +instance FromTrees String where + fromTrees ts = concatMap (fromTree :: Tree -> String) ts + +------------------------------------------------------------------------------ +class ToHtml a where + toHtml :: a -> String +instance ToHtml a => ToHtml [a] where + toHtml x = concatMap toHtml x + +instance ToHtml Doc where + toHtml (Doc h secs) = "" ++ (toHtml secs) ++ "" +instance ToHtml Section where + toHtml (Section header paragraphs) = "

"++(toHtml header)++"

"++(toHtml paragraphs) +instance ToHtml Paragraph where + toHtml (Blockquote t) = "
"++(toHtml t)++"
" + toHtml HR = "
" + toHtml OL = "
    " + toHtml (P t) = "

    "++(toHtml t)++"

    " +instance ToHtml Text where + toHtml WS = " " + toHtml (Chars s) = toHtml s + toHtml (Symbol s) = toHtml s + toHtml (Quotes x) = "\""++(toHtml x)++"\"" + toHtml (Block x) = toHtml x + toHtml (Verbatim x) = "
    \n"++x++"\n
    " + toHtml (Link t ref) = ""++(toHtml t)++"" + toHtml (Underline x) = ""++(toHtml x)++"" + toHtml (TT x) = ""++(toHtml x)++"" + toHtml (Citation x) = ""++(toHtml x)++"" + toHtml (Strikethrough x) = ""++(toHtml x)++"" + toHtml (Superscript x) = ""++(toHtml x)++"" + toHtml (Subscript x) = ""++(toHtml x)++"" + toHtml (Smallcap x) = ""++(toHtml x)++"" + toHtml (Bold x) = ""++(toHtml x)++"" + toHtml (Keyword x) = ""++(toHtml x)++"" + toHtml (Italic x) = ""++(toHtml x)++"" + toHtml (Command x y) = error $ "unsupported command "++(show x) + toHtml (Footnote x) = error $ "footnotes not supported" + +instance ToHtml String where + toHtml s = concatMap htmlEscapeChar s + where + htmlEscapeChar '<' = "<" + htmlEscapeChar '>' = ">" + htmlEscapeChar '&' = "&" + htmlEscapeChar '\'' = "'" + htmlEscapeChar '\"' = """ + htmlEscapeChar c = [c] + + + + + + +{- + +Doc: { { Section: { { Chars: { 19 } Symbol: { - } Chars: { Nov } } + { P: { { Chars: { Two } WS Chars: { weeks } WS Chars: { ago } WS + Chars: { I } WS Chars: { had } WS Chars: { Lasik } WS + Chars: { performed } WS Chars: { at } WS + Link: { { Chars: { the } WS Chars: { Pacific } WS Chars: { Vision } + WS Chars: { Institute } } + URL: { http DNS: { { pacificvision org } } { . } } } + WS Chars: { The } WS Chars: { short } WS Chars: { story } WS + Chars: { is } WS Chars: { that } WS Chars: { it } WS + Chars: { rocks } Symbol: { , } WS Chars: { and } WS Chars: { I } WS + Chars: { very } WS Chars: { highly } WS + Chars: { recommend } WS Chars: { Dr } Symbol: { . } WS + Chars: { Faktorovich } + Symbol: { , } WS + Chars: { as } WS + Chars: { well } + WS Chars: { as } + WS + Chars: { the } + +-} \end{code} diff --git a/src/SBP.lhs b/src/SBP.lhs index 61a30a5..c7bb5db 100644 --- a/src/SBP.lhs +++ b/src/SBP.lhs @@ -3,21 +3,37 @@ -- These bindings are highly experimental and subject to change -- without notice. You've been warned. -- -module SBP(Tree(Tree),Location(Location),Region(Region),parseFile,prettyPrintTree) - where +module SBP(Tree(Tree),Location(Location),Region(Region),parseFile,prettyPrintTree,coalesceFlatHeadlessNodes) +where #if defined(java_HOST_OS) - +import Foreign +import Foreign.Java +import Text.PrettyPrint.HughesPJ #define CONCAT(x,y) x/**/y #define DEFINE_OBJECT(s,name) \ data CONCAT(name,_); \ type name = Object CONCAT(name,_); \ foreign import jvm s CONCAT(_,name) :: JClass; \ instance JType_ CONCAT(name,_) where jClass_ _ = CONCAT(_,name); - -import Foreign -import Foreign.Java +#else +import Header_Java; +import Class_edu_berkeley_sbp_misc_HaskellHelper; +import Class_java_lang_Object; +import Class_java_lang_Class; +import Class_java_lang_String; +import Class_edu_berkeley_sbp_Tree; +import Header_edu_berkeley_sbp_Tree; +import JVM_edu_berkeley_sbp_misc_HaskellHelper; +import Header_edu_berkeley_sbp_misc_HaskellHelper; +import TypedString; +import JVMBridge; +import JavaText; +import JavaTypes; +import Data.Int; +import Invocation; import Text.PrettyPrint.HughesPJ +#endif data Location = Location Int Int data Region = Region Location Location @@ -37,17 +53,19 @@ coalesceFlatHeadlessNodes t@(Tree s children r) prettyPrintTree (Tree "" [] _) = empty prettyPrintTree (Tree s [] _) = text s -prettyPrintTree t@(Tree s children _) - | s==[] = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}")) - | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children - where - prettyPrintTreeList children = (vcat $ map prettyPrintTree children) +prettyPrintTree (Tree [] children _) = prettyPrintTreeList children +prettyPrintTree (Tree s children _) = (text (s++":")) <+> (nest 4 $ prettyPrintTreeList children) +prettyPrintTreeList [] = text "{}" +prettyPrintTreeList children = (text "{") <+> ((fsep $ map prettyPrintTree children) <+> (text "}")) nullRegion = (Region (Location 0 0) (Location 0 0)) + + +------------------------------------------------------------------------------ +#if defined(java_HOST_OS) foreign import jvm type "edu.berkeley.sbp.Tree" JTree# data JTree = JTree JTree# - foreign import jvm safe "edu.berkeley.sbp.misc.RegressionTests.main" regressionTests :: IO () foreign import jvm safe "edu.berkeley.sbp.misc.HaskellHelper.help" haskellHelper :: JString -> JString -> IO JTree foreign import jvm safe "edu.berkeley.sbp.misc.HaskellHelper.isNull" isNull :: (Object a) -> IO Bool @@ -87,55 +105,13 @@ parseFile g f = do g' <- packJString g x <- haskify tree return x +------------------------------------------------------------------------------ #else - import Header_Java; - import Class_edu_berkeley_sbp_misc_HaskellHelper; - import Class_java_lang_Object; - import Class_java_lang_Class; - import Class_java_lang_String; - import Class_edu_berkeley_sbp_Tree; - import Header_edu_berkeley_sbp_Tree; - import JVM_edu_berkeley_sbp_misc_HaskellHelper; - import Header_edu_berkeley_sbp_misc_HaskellHelper; - import TypedString; - import JVMBridge; - import JavaText; - import JavaTypes; - import Data.Int; - import Invocation; - import Text.PrettyPrint.HughesPJ - -- Why do I need this? instance SubJavaClassMarker Header_edu_berkeley_sbp_Tree.Class_Jedu_berkeley_sbp_Tree Header_edu_berkeley_sbp_misc_HaskellHelper.Class_Jedu_berkeley_sbp_Tree - data Location = Location Int Int - data Region = Region Location Location - - data Tree = Tree String [Tree] Region - instance Show Tree - where - show t@(Tree _ _ _) = show $ prettyPrintTree $ t - - coalesceFlatHeadlessNodes t@(Tree s children r) - | s==[], flat t = Tree (concat $ map (\(Tree s _ _) -> s) children) [] r - | otherwise = Tree s (map coalesceFlatHeadlessNodes children) r - where - flat (Tree _ children _) = not (any id $ map notFlatComponent children) - notFlatComponent (Tree _ [] _) = False - notFlatComponent (Tree _ _ _) = True - - prettyPrintTree (Tree "" [] _) = empty - prettyPrintTree (Tree s [] _) = text s - prettyPrintTree t@(Tree s children _) - | s==[] = (text "{") <+> ((prettyPrintTreeList children) <+> (text "}")) - | otherwise = ((text s) <> (text ":")) <+> prettyPrintTreeList children - where - prettyPrintTreeList children = (vcat $ map prettyPrintTree children) - - nullRegion = (Region (Location 0 0) (Location 0 0)) - parseFile :: [String] -> -- class path String -> -- grammar *.g file diff --git a/src/edu/berkeley/sbp/misc/HaskellHelper.java b/src/edu/berkeley/sbp/misc/HaskellHelper.java index 18f5f6a..b94c30f 100644 --- a/src/edu/berkeley/sbp/misc/HaskellHelper.java +++ b/src/edu/berkeley/sbp/misc/HaskellHelper.java @@ -6,6 +6,7 @@ import edu.berkeley.sbp.*; import edu.berkeley.sbp.misc.*; import edu.berkeley.sbp.meta.*; import edu.berkeley.sbp.chr.*; +import edu.berkeley.sbp.tib.*; import java.io.*; public class HaskellHelper { @@ -14,23 +15,62 @@ public class HaskellHelper { help(argv[0], argv[1]); } public static boolean isNull(Object o) { return o==null; } - public static Tree help(String grammarFile, String targetFile) throws Throwable { + public static Tree help0(String grammarFile, String targetFile) throws Throwable { try { Tree res = new CharParser(MetaGrammar.newInstance()).parse(new FileInputStream(grammarFile)).expand1(); Union meta = Grammar.create(res, "s", new Grammar.Bindings() { - /* + public Sequence createSequence(Production p) { - Sequence ret = super.createSequence(p); - if (ret != null) return ret; - return Sequence.create(p.nonTerminal, p.elements, p.drops, false); + Element[] els = p.elements; + if (p.tag != null) + return Sequence.create(p.tag, p.elements, p.drops, false); + int idx = -1; + for(int i=0; i res = new CharParser(MetaGrammar.newInstance()).parse(new FileInputStream(grammarFile)).expand1(); + Union meta = Grammar.create(res, "s", + new Grammar.Bindings() { + + public Sequence createSequence(Production p) { + Element[] els = p.elements; + if (p.tag != null && !"".equals(p.tag)) + return Sequence.create(p.tag, p.elements, p.drops, false); + int idx = -1; + for(int i=0; i