From: adam Date: Sun, 27 May 2007 20:58:00 +0000 (-0400) Subject: update SBP.lhs X-Git-Url: http://git.megacz.com/?p=sbp.git;a=commitdiff_plain;h=60b00d51a5d05ba33ae283577fa5a84899430641 update SBP.lhs darcs-hash:20070527205800-5007d-27a76046b73f16b89e6737196811f21ad923013d.gz --- diff --git a/Makefile b/Makefile index c43d38c..33deb50 100644 --- a/Makefile +++ b/Makefile @@ -117,100 +117,11 @@ javadoc: -noqualifier all \ -d doc/api \ edu.berkeley.sbp.meta \ - edu.berkeley.sbp.bind \ edu.berkeley.sbp.chr \ edu.berkeley.sbp.misc \ - edu.berkeley.sbp.tib \ edu.berkeley.sbp.util clean: rm -rf doc/api edu.berkeley.sbp.jar bin edu.berkeley.sbp.tar.gz rm -rf Makefile.bak *.hi *.o *.class *.jar Header_*.hs Class_*.hs *_JVM.hs InterfaceMyClass -upload: - make clean - make javadoc - darcs dist - echo '' > index.html - rsync -are ssh --progress --verbose --delete ./ argus.cs.berkeley.edu:public_html/sbp/ - - - -################################################################### -## Experimental Haskell bindings -## -## make runHaskellDemo JAVA_HOME= -## - -include Makefile.haskell - -.jvm-bridge: - mkdir -p $(prefix)/src - - cd $(prefix)/src; \ - curl $(jvm-bridge-url) | tar -xvzf - - - cd $(prefix)/src/haskell-jvm-bridge-*; \ - patch -p0 < $(shell pwd)/misc/broken-cygwin-detection-patch && \ - $(patchmac) \ - $(patchghc) \ - (cd Native; autoreconf; true) && \ - (cd Haskell; autoreconf; true) - - cd $(prefix)/src/haskell-jvm-bridge-*/Native; \ - ./configure --prefix=$(prefix) $(with_jvmdir) && \ - make && \ - make install - - cd $(prefix)/src/haskell-jvm-bridge-*/Haskell; \ - ./configure --prefix=$(prefix) $(with_jvmdir) && \ - make && \ - make install - - touch $@ - -runHaskellDemo: .jvm-bridge - mkdir -p bin - make bin/HaskellDemo - bin/HaskellDemo - -bin/Header_%.o: edu.berkeley.sbp.jar .jvm-bridge - cd bin; $(bin)/MakeHeaderModule -module Header_$* -jar ../edu.berkeley.sbp.jar - cd bin; $(ghc) -c Header_$*.hs $(link) - -bin/Class_%.o: - make bin/Header_$*.o - cd bin; $(bin)/MakeClassModule -import Header_Java -import Header_$* -cp ../edu.berkeley.sbp.jar `echo $* | sed s/_/./g` - cd bin; $(ghc) -c Class_$*.hs $(link) - -bin/JVM_%.o: - make bin/Class_$*.o - make bin/Header_$*.o - cd bin; echo -e $($*_list) | $(bin)/MakeJVMModule JVM_$* - cd bin; $(ghc) -c JVM_$*.hs $(link) - -edu_berkeley_sbp_misc_HaskellHelper_list = "edu.berkeley.sbp.misc.HaskellHelper\njava.lang.String\nedu.berkeley.sbp.Tree\njava.lang.Object" - -bin/HaskellDemo: src/SBP.hs \ - src/HaskellDemo.hs \ - bin/Class_java_lang_Object.o \ - bin/Class_java_lang_String.o \ - bin/Class_edu_berkeley_sbp_Tree.o \ - bin/JVM_edu_berkeley_sbp_misc_HaskellHelper.o - cd bin; $(ghc) -c ../src/SBP.hs $(link) -o SBP.o - cd bin; $(ghc) -i../src/ -c ../src/HaskellDemo.hs $(link) -o HaskellDemo.o - cd bin; for A in *.hs; do $(ghc) -c $$A $(link); done - cd bin; $(ghc) $(linkopts) $(link) -o HaskellDemo *.o - - -ghcroot = /usr/local/brian/ghc -ghc = $(ghcroot)/compiler/ghc-inplace -fallow-undecidable-instances -fallow-overlapping-instances -ghclibs = $(ghcroot)/rts/HSrts.jar:$(ghcroot)/libraries/base/HSbase.jar:$(ghcroot)/libraries/stm/HSstm.jar - -bin/Main.class: src/Main.lhs src/SBP.lhs - cd src; $(ghc) -fglasgow-exts -cpp -odir ../bin -c -java SBP.lhs - cd src; $(ghc) -fglasgow-exts -cpp -odir ../bin -java Main.lhs - -#profile=-agentlib:yjpagent -go: bin/Main.class edu.berkeley.sbp.jar - java $(profile) -cp bin:$(ghclibs):edu.berkeley.sbp.jar Main \ No newline at end of file diff --git a/src/SBP.lhs b/src/edu/berkeley/sbp/haskell/SBP.lhs similarity index 74% rename from src/SBP.lhs rename to src/edu/berkeley/sbp/haskell/SBP.lhs index c7bb5db..b43bea3 100644 --- a/src/SBP.lhs +++ b/src/edu/berkeley/sbp/haskell/SBP.lhs @@ -3,37 +3,38 @@ -- 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,coalesceFlatHeadlessNodes) +module Edu.Berkeley.Sbp.Haskell.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,_); \ +type name = JObject CONCAT(name,_); \ foreign import jvm s CONCAT(_,name) :: JClass; \ instance JType_ CONCAT(name,_) where jClass_ _ = CONCAT(_,name); #else import Header_Java; -import Class_edu_berkeley_sbp_misc_HaskellHelper; +import Class_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 JVM_HaskellHelper; +import Header_HaskellHelper; import TypedString; import JVMBridge; import JavaText; import JavaTypes; import Data.Int; import Invocation; -import Text.PrettyPrint.HughesPJ #endif +--import Text.PrettyPrint.HughesPJ +import Text.PrettyPrint.Leijen data Location = Location Int Int data Region = Region Location Location @@ -51,12 +52,22 @@ coalesceFlatHeadlessNodes t@(Tree s children r) notFlatComponent (Tree _ [] _) = False notFlatComponent (Tree _ _ _) = True +fsep = fillSep prettyPrintTree (Tree "" [] _) = empty prettyPrintTree (Tree s [] _) = text s prettyPrintTree (Tree [] children _) = prettyPrintTreeList children -prettyPrintTree (Tree s children _) = (text (s++":")) <+> (nest 4 $ prettyPrintTreeList children) +prettyPrintTree (Tree s children _) = (text (s++":")) <$$> (prettyPrintTreeList children) prettyPrintTreeList [] = text "{}" -prettyPrintTreeList children = (text "{") <+> ((fsep $ map prettyPrintTree children) <+> (text "}")) +prettyPrintTreeList children + | allsingles children = text $ "\"" ++ (concatMap (\(Tree s _ _) -> s) children) ++ "\"" + | otherwise = hang 2 $ + (text "{") + <+> + (group + ((fsep $ map (group . prettyPrintTree) children) + <+> + (text "}"))) +allsingles = all (\(Tree s c _) -> (length s)==1 && (length c)==0) nullRegion = (Region (Location 0 0) (Location 0 0)) @@ -66,13 +77,15 @@ 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 type "java.lang.Object" Object# +data Object = Object Object# 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 -foreign import jvm safe "getHead" getHead :: JTree -> IO (Object a) +foreign import jvm safe "HaskellHelper.help" haskellHelper :: JString -> IO JTree +foreign import jvm safe "HaskellHelper.isNull" isNull :: Object -> IO Bool +foreign import jvm safe "getHead" getHead :: JTree -> IO Object foreign import jvm safe "child" getChild :: JTree -> Int32 -> IO JTree foreign import jvm safe "size" size :: JTree -> IO Int32 -foreign import jvm safe "toString" jtoString :: (Object a) -> IO JString +foreign import jvm safe "toString" jtoString :: Object -> IO JString toString o = do isn <- isNull o if isn then return "" @@ -95,22 +108,20 @@ haskify t = return $ Tree str children nullRegion parseFile :: - String -> -- grammar *.g file String -> -- file to be parsed IO Tree -parseFile g f = do g' <- packJString g - f' <- packJString f - tree <- haskellHelper g' f' - x <- haskify tree - return x +parseFile f = do f' <- packJString f + tree <- haskellHelper f' + x <- haskify tree + return x ------------------------------------------------------------------------------ #else -- 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 + Header_HaskellHelper.Class_Jedu_berkeley_sbp_Tree parseFile :: [String] -> -- class path