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) = "<html><body>" ++ (toHtml secs) ++ "</body></html>"
+instance ToHtml Section where
+ toHtml (Section header paragraphs) = "<h1>"++(toHtml header)++"</h1>"++(toHtml paragraphs)
+instance ToHtml Paragraph where
+ toHtml (Blockquote t) = "<blockquote>"++(toHtml t)++"</blockquote>"
+ toHtml HR = "<hr/>"
+ toHtml OL = "<ol/>"
+ toHtml (P t) = "<p>"++(toHtml t)++"</p>"
+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) = "<pre>\n"++x++"\n</pre>"
+ toHtml (Link t ref) = "<a href='"++(show ref)++"'>"++(toHtml t)++"</a>"
+ toHtml (Underline x) = "<u>"++(toHtml x)++"</u>"
+ toHtml (TT x) = "<tt>"++(toHtml x)++"</tt>"
+ toHtml (Citation x) = "<i>"++(toHtml x)++"</i>"
+ toHtml (Strikethrough x) = "<strike>"++(toHtml x)++"</strike>"
+ toHtml (Superscript x) = "<sup>"++(toHtml x)++"</sup>"
+ toHtml (Subscript x) = "<sub>"++(toHtml x)++"</sub>"
+ toHtml (Smallcap x) = "<sc>"++(toHtml x)++"</sc>"
+ toHtml (Bold x) = "<b>"++(toHtml x)++"</b>"
+ toHtml (Keyword x) = "<tt>"++(toHtml x)++"</tt>"
+ toHtml (Italic x) = "<i>"++(toHtml x)++"</i>"
+ 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}
-- 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
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
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
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 {
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<String> 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<els.length; i++)
+ if (!p.drops[i])
+ if (idx==-1) idx = i;
+ else return Sequence.create(p.nonTerminal, p.elements, p.drops, false);
+ if (idx != -1) return Sequence.create(els, idx);
+ else return Sequence.create(els, null);
}
- */
+
});
System.out.println();
System.out.println();
- System.out.println();
CharInput input = new CharInput(new FileInputStream(targetFile), "", true);
+ //Input input = new Tib(new FileInputStream(targetFile));
+ Tree ret = new CharParser(meta).parse(input).expand1();
+ if (ret==null) throw new NullPointerException("CharParser returned null");
+ return ret;
+ } catch (Throwable e) {
+ e.printStackTrace();
+ throw e;
+ }
+ }
+ public static Tree help(String grammarFile, String targetFile) throws Throwable {
+ try {
+ Tree<String> 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<els.length; i++)
+ if (!p.drops[i])
+ if (idx==-1) idx = i;
+ else return Sequence.create(p.nonTerminal, p.elements, p.drops, false);
+ if (idx != -1) return Sequence.create(els, idx);
+ else return Sequence.create(els, null);
+ }
+
+ });
+ System.out.println();
+ System.out.println();
+ //CharInput input = new CharInput(new FileInputStream(targetFile), "", true);
+ Input input = new Tib(new FileInputStream(targetFile));
Tree ret = new CharParser(meta).parse(input).expand1();
if (ret==null) throw new NullPointerException("CharParser returned null");
return ret;
projects / sbp.git / commitdiff