diff --git a/Hs2lib.cabal b/Hs2lib.cabal --- a/Hs2lib.cabal +++ b/Hs2lib.cabal @@ -1,5 +1,5 @@ Name: Hs2lib -Version: 0.5.7 +Version: 0.5.8 Cabal-Version: >= 1.10 Build-Type: Custom License: BSD3 diff --git a/TODO.txt b/TODO.txt deleted file mode 100644 --- a/TODO.txt +++ /dev/null @@ -1,15 +0,0 @@ -** fix http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html (includes, include-install and fix the libpaths so the files are found at runtime) - -** fix unix code compile - -** fix selecPreTyp selection error (unit test: cabal file) -** fix qualified names used in original source file -** fix the type synonym resolver. It's really buggy and needs complete rewrite -** fix Storable error with embedded structues e.g. (Maybe [String]) doesn't work inside a data declare. - -- data Foo = Foo (Maybe [String]) (Maybe (Int,[String])) -** fixed type applications with typles e.g type Field a = (Int, [a]) and Field (String, String) -** Find the bug in the c# codegen for tuples -** update type to IO -** change codegens ** partually -** change where it detects lists, IO is now supported -** test something ending in IO [] diff --git a/Templates/.svn/all-wcprops b/Templates/.svn/all-wcprops deleted file mode 100644 --- a/Templates/.svn/all-wcprops +++ /dev/null @@ -1,5 +0,0 @@ -K 25 -svn:wc:ra_dav:version-url -V 46 -/svn/WinDll/!svn/ver/37/trunk/WinDLL/Templates -END diff --git a/Templates/.svn/dir-prop-base b/Templates/.svn/dir-prop-base deleted file mode 100644 --- a/Templates/.svn/dir-prop-base +++ /dev/null @@ -1,14 +0,0 @@ -K 10 -svn:ignore -V 52 -*.hi -*.aux -*.blg -*.out -*.log -*.gz -*.idx -*.toc -*.bbl - -END diff --git a/Templates/.svn/entries b/Templates/.svn/entries deleted file mode 100644 --- a/Templates/.svn/entries +++ /dev/null @@ -1,164 +0,0 @@ -10 - -dir -52 -https://svn.zhox.com:3690/svn/WinDll/trunk/WinDLL/Templates -https://svn.zhox.com:3690/svn/WinDll - - - -2011-05-19T19:13:35.523032Z -37 -Phyx -has-props - - - - - - - - - - - - - -73766c1b-e474-454a-a9e1-e490cd0c8aae - -main.template-unix.c -file - - - - -2010-03-15T21:24:21.372005Z -48af026cf6e2f6f682e78360f0cdced1 -2010-03-16T03:01:07.297910Z -26 -Phyx - - - - - - - - - - - - - - - - - - - - - -568 - -nomain.template-win.c -file - - - - -2010-12-23T14:42:20.271212Z -72a799eec8f13f10992c6f1456c6320b -2011-04-10T16:33:09.493305Z -31 -Phyx - - - - - - - - - - - - - - - - - - - - - -415 - -main.template-win.c -file - - - - -2009-12-28T13:02:40.000000Z -ea42dcc8177275209a57ca29aaf11901 -2010-01-13T00:31:41.317428Z -18 -Phyx - - - - - - - - - - - - - - - - - - - - - -486 - -nomain.template-unix.c -file - - - - -2010-12-23T14:42:40.732382Z -b1be51667a0006cbeb60ffbf5916aae4 -2011-04-10T16:33:09.493305Z -31 -Phyx - - - - - - - - - - - - - - - - - - - - - -373 - diff --git a/Templates/.svn/text-base/main.template-unix.c.svn-base b/Templates/.svn/text-base/main.template-unix.c.svn-base deleted file mode 100644 --- a/Templates/.svn/text-base/main.template-unix.c.svn-base +++ /dev/null @@ -1,26 +0,0 @@ -#include - -extern void __stginit_%name(void); - -HsBool __attribute__ ((constructor)) %name_load(void); -void __attribute__ ((destructor)) %name_unload(void); - -HsBool %name_load(void){ - int argc = 1; - char *argv[] = { "ghcDll", NULL }; - /* N.B. argv arrays must end with NULL */ - - // Initialize Haskell runtime - hs_init(&argc, &argv); - - // Tell Haskell about all root modules - hs_add_root(__stginit_%name); - - // do any other initialization here and - // return false if there was a problem - return HS_BOOL_TRUE; -} - -void %name_unload(void){ - hs_exit(); -} diff --git a/Templates/.svn/text-base/main.template-win.c.svn-base b/Templates/.svn/text-base/main.template-win.c.svn-base deleted file mode 100644 --- a/Templates/.svn/text-base/main.template-win.c.svn-base +++ /dev/null @@ -1,23 +0,0 @@ -#include -#include - -extern void __stginit_%name(void); - -static char* args[] = { "ghcDll", NULL }; - /* N.B. argv arrays must end with NULL */ -BOOL -%callconv -DllMain - ( HANDLE hModule - , DWORD reason - , void* reserved - ) -{ - if (reason == DLL_PROCESS_ATTACH) { - /* By now, the RTS DLL should have been hoisted in, but we need to start it up. */ - startupHaskell(1, args, __stginit_%name); - return TRUE; - } - return TRUE; -} - diff --git a/Templates/.svn/text-base/nomain.template-unix.c.svn-base b/Templates/.svn/text-base/nomain.template-unix.c.svn-base deleted file mode 100644 --- a/Templates/.svn/text-base/nomain.template-unix.c.svn-base +++ /dev/null @@ -1,21 +0,0 @@ -#include - -extern void __stginit_%name(void); - -void HsStart(void) -{ - int argc = 1; - char* argv[] = {"ghcDll", NULL}; // argv must end with NULL - - // Initialize Haskell runtime - char** args = argv; - hs_init(&argc, &args); - - // Tell Haskell about all root modules - hs_add_root(__stginit_%name); -} - -void HsEnd(void) -{ - hs_exit(); -} diff --git a/Templates/.svn/text-base/nomain.template-win.c.svn-base b/Templates/.svn/text-base/nomain.template-win.c.svn-base deleted file mode 100644 --- a/Templates/.svn/text-base/nomain.template-win.c.svn-base +++ /dev/null @@ -1,22 +0,0 @@ -#include -#include - -extern void __stginit_%name(void); - -void %callconv HsStart(void) -{ - int argc = 1; - char* argv[] = {"ghcDll", NULL}; // argv must end with NULL - - // Initialize Haskell runtime - char** args = argv; - hs_init(&argc, &args); - - // Tell Haskell about all root modules - hs_add_root(__stginit_%name); -} - -void %callconv HsEnd(void) -{ - hs_exit(); -} diff --git a/Tests/Exec/Default.hi b/Tests/Exec/Default.hi new file mode 100644 Binary files /dev/null and b/Tests/Exec/Default.hi differ diff --git a/Tests/Exec/Default.o b/Tests/Exec/Default.o new file mode 100644 Binary files /dev/null and b/Tests/Exec/Default.o differ diff --git a/Tests/Exec/Example.hi b/Tests/Exec/Example.hi new file mode 100644 Binary files /dev/null and b/Tests/Exec/Example.hi differ diff --git a/Tests/FindFiles.hi b/Tests/FindFiles.hi new file mode 100644 Binary files /dev/null and b/Tests/FindFiles.hi differ diff --git a/Tests/FindFiles.o b/Tests/FindFiles.o new file mode 100644 Binary files /dev/null and b/Tests/FindFiles.o differ diff --git a/Tests/Src/Test_Validation.hi b/Tests/Src/Test_Validation.hi new file mode 100644 Binary files /dev/null and b/Tests/Src/Test_Validation.hi differ diff --git a/Tests/TestRunner.hi b/Tests/TestRunner.hi new file mode 100644 Binary files /dev/null and b/Tests/TestRunner.hi differ diff --git a/Tests/TestRunner.o b/Tests/TestRunner.o new file mode 100644 Binary files /dev/null and b/Tests/TestRunner.o differ diff --git a/WinDll/CodeGen/CSharp/CSharp.hs b/WinDll/CodeGen/CSharp/CSharp.hs --- a/WinDll/CodeGen/CSharp/CSharp.hs +++ b/WinDll/CodeGen/CSharp/CSharp.hs @@ -142,6 +142,7 @@ ,LibInclude "System.Runtime.InteropServices" ,LibInclude "WinDll" ,LocalInclude "Utils" + ,LocalInclude "Generated.Types" ] , _structs = map upgradeField (join structs) , _typeDecls = [] diff --git a/WinDll/Identifier.hs b/WinDll/Identifier.hs --- a/WinDll/Identifier.hs +++ b/WinDll/Identifier.hs @@ -104,6 +104,7 @@ mcallbacks mstableptr + -- liftIO $ print f -- liftIO $ print mdep -- liftIO $ print mcallbacks @@ -136,7 +137,7 @@ fn' = resolveCallback True cl fn -- | Generates callbacks for an Export type. This hides the original type --- b ecause if we don't, it'll generate too many specifications. +-- because if we don't, it'll generate too many specifications. generateCallbacksFromExports :: Ann -> [Export] -> Exec [Callback] generateCallbacksFromExports defs xs = fmap concat $ mapM gen (zip xs [1..(length xs)]) where gen :: (Export,Int) -> Exec [Callback] diff --git a/WinDll/Lib/InstancesTypes.hi b/WinDll/Lib/InstancesTypes.hi new file mode 100644 Binary files /dev/null and b/WinDll/Lib/InstancesTypes.hi differ diff --git a/WinDll/Lib/InstancesTypes.o b/WinDll/Lib/InstancesTypes.o new file mode 100644 Binary files /dev/null and b/WinDll/Lib/InstancesTypes.o differ diff --git a/WinDll/Lib/NativeMapping_Base.cpphs b/WinDll/Lib/NativeMapping_Base.cpphs --- a/WinDll/Lib/NativeMapping_Base.cpphs +++ b/WinDll/Lib/NativeMapping_Base.cpphs @@ -288,7 +288,7 @@ where from f x = fromFFI _ST_ (f (toFFI _ST_ x)) --- | I decided to use a CAString because on windows this gives me a constant 16 value +-- | I decided to use a CWString because on windows this gives me a constant 16 value instance FFIType String CWString where toNative = RECORDM(__FILE__, __LINE__, "newCWString" , newCWString) fromNative _ST_ ptr = do {(RECORD( __FILE__, __LINE__, "peekCWString", id)) _ST_ ptr; diff --git a/WinDll/Utils/DepScanner.hs b/WinDll/Utils/DepScanner.hs --- a/WinDll/Utils/DepScanner.hs +++ b/WinDll/Utils/DepScanner.hs @@ -64,7 +64,7 @@ -- | Get the module dependency graph of the given file getGraph :: String -> IO ModuleGraph getGraph file = -#if __GLASGOW_HASKELL__ >= 704 +#if __GLASGOW_HASKELL__ >= 706 defaultErrorHandler defaultFatalMessager defaultFlushOut $ do #elif __GLASGOW_HASKELL__ >= 702 defaultErrorHandler defaultLogAction $ do diff --git a/WinDll/Utils/ListTypes.hs b/WinDll/Utils/ListTypes.hs --- a/WinDll/Utils/ListTypes.hs +++ b/WinDll/Utils/ListTypes.hs @@ -22,9 +22,11 @@ import WinDll.Structs.Structures hiding (Module) import qualified WinDll.Structs.Structures as WinDll +import WinDll.Structs.MShow.MShow import WinDll.Structs.MShow.HaskellSrcExts import WinDll.Structs.Folds.HaskellSrcExts import WinDll.Utils.Types +import qualified Debug.Trace as D -- | Upgrade a type by performing actions such as identifying list -- and changing the type to also pass along list counters @@ -52,7 +54,7 @@ (Exts.TyCon $ Exts.UnQual $ Exts.Ident $ if esc then "CInt" else "Int")) _ -> val) t' else t' - in ty' -- D.trace ("IN: " ++ mshowM 2 t') $ D.trace ("OUT: " ++ mshowM 2 ty') $ D.trace (show arr' ++ " - " ++ show lst) ty' + in ty' -- D.trace (show t') $ D.trace ("IN: " ++ mshowM 2 t') $ D.trace ("OUT: " ++ mshowM 2 ty') $ D.trace (show arr' ++ " - " ++ show lst ++ " (" ++ show arr' ++ ")") ty' where embedded :: Exts.Type -> Exts.Type embedded (Exts.TyParen a) = (Exts.TyParen (analyzeType esc a)) embedded x = x @@ -103,17 +105,7 @@ updateType esc ann = everywhere (mkT pushType) where -- | Types to update pushType :: Exts.Type -> Exts.Type - pushType (Exts.TyFun a b) = let f x = case isIOList x of - True -> Exts.TyFun - (Exts.TyCon $ Exts.UnQual $ Exts.Ident "Int") - False -> id - g x = case isIOList x of - True -> Exts.TyFun - (Exts.TyApp - (Exts.TyCon $ Exts.UnQual $ Exts.Ident "Ptr") - (Exts.TyCon $ Exts.UnQual $ Exts.Ident $ if esc then "CInt" else "Int")) - x - False -> x + pushType (Exts.TyFun a b) = let in f a $ Exts.TyFun a (g b) -- pushType (Exts.TyApp a b) = let f x = case isList x of -- True -> Exts.TyFun @@ -122,8 +114,20 @@ -- in if isIO a -- then simplify (move a $ f b) -- else Exts.TyApp a b - pushType x = x + pushType x = g x + f x = case isIOList x of + True -> Exts.TyFun + (Exts.TyCon $ Exts.UnQual $ Exts.Ident "Int") + False -> id + g x = case isIOList x of + True -> Exts.TyFun + (Exts.TyApp + (Exts.TyCon $ Exts.UnQual $ Exts.Ident "Ptr") + (Exts.TyCon $ Exts.UnQual $ Exts.Ident $ if esc then "CInt" else "Int")) + x + False -> x + -- | Move an IO declaration inwards. move :: Exts.Type -> Exts.Type -> Exts.Type move io (Exts.TyFun a b) = Exts.TyFun a (Exts.TyApp io b) diff --git a/WinDll/Version/Hs2lib.hs b/WinDll/Version/Hs2lib.hs --- a/WinDll/Version/Hs2lib.hs +++ b/WinDll/Version/Hs2lib.hs @@ -19,7 +19,7 @@ -- | Version Number verNum :: [Int] -verNum = [0,5,6] +verNum = [0,5,8] -- | Version string verStr :: String