Hs2lib 0.5.8 → 0.6.0
raw patch · 17 files changed
+42/−196 lines, 17 filesdep ~haskell-src-exts
Dependency ranges changed: haskell-src-exts
Files
- FFI.hs +0/−174
- Hs2lib.cabal +7/−5
- TODO.txt +15/−0
- Tests/Exec/Default.hi binary
- Tests/Exec/Default.o binary
- Tests/Exec/Example.hi binary
- Tests/FindFiles.hi binary
- Tests/FindFiles.o binary
- Tests/Src/Test_Validation.hi binary
- Tests/TestRunner.hi binary
- Tests/TestRunner.o binary
- WinDll/Lib/InstancesTypes.hi binary
- WinDll/Lib/InstancesTypes.o binary
- WinDll/Utils/DepScanner.hs +1/−1
- WinDll/Utils/ListTypes.hs +16/−13
- WinDll/Version/Debug.hs +1/−1
- WinDll/Version/Hs2lib.hs +2/−2
− FFI.hs
@@ -1,174 +0,0 @@-{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE TypeSynonymInstances #-} - -import Control.Applicative -import Control.Monad -import Foreign.C -import Foreign.Ptr -import Foreign.Storable -import Foreign.Marshal.Array - -class Context t where - type Collapse t :: * - type Cxt t :: * -> * - collapse :: t -> Collapse t - -newtype PureCxt a = PureCxt { unwrapPure :: a } - -instance Functor PureCxt where - fmap f = PureCxt . f . unwrapPure -instance Applicative PureCxt where - pure = PureCxt - (<*>) = \(PureCxt f) (PureCxt x) -> PureCxt (f x) -instance Monad PureCxt where - return = pure - m >>= k = k $ unwrapPure m - --- strip out pure contexts, only needs to look at one layer -instance Context (PureCxt a) where - type Collapse (PureCxt a) = a - type Cxt (PureCxt a) = PureCxt - collapse = unwrapPure - --- merge IO contexts using join -instance Context (IO (IO a)) where - type Collapse (IO (IO a)) = IO a - type Cxt (IO (IO a)) = IO - collapse = join - --- remove contexts underneath IO... this might need to be recursive. haven't --- thought through all the ways contexts can stack up yet. -instance Context (IO (PureCxt a)) where - type Collapse (IO (PureCxt a)) = IO a - type Cxt (IO (PureCxt a)) = IO - collapse = fmap unwrapPure - --- defer IO on a function to only the result. definitely recursive here. -instance (Context (IO b)) => Context (IO (a -> b)) where - type Collapse (IO (a -> b)) = a -> Collapse (IO b) - type Cxt (IO (a -> b)) = IO - collapse x y = collapse $ fmap ($ y) x - --- should probably rethink to what extent I want to separate these... -type family ForeignCxt int :: * -> * - -type instance ForeignCxt () = PureCxt - -class Convert ext int | ext -> int, int -> ext where - type Foreign int :: * - type Native ext :: * - toForeign :: Native ext -> ForeignCxt (Native ext) (Foreign int) - toNative :: Foreign int -> ForeignCxt (Foreign int) (Native ext) - -instance Convert () () where - type Foreign () = () - type Native () = () - toForeign = pure - toNative = pure - -type instance ForeignCxt Int = PureCxt -type instance ForeignCxt CInt = PureCxt -instance Convert CInt Int where - type Foreign Int = CInt - type Native CInt = Int - toForeign = pure . fromIntegral - toNative = pure . fromIntegral - -type instance ForeignCxt Double = PureCxt -type instance ForeignCxt CDouble = PureCxt -instance Convert CDouble Double where - type Foreign Double = CDouble - type Native CDouble = Double - toForeign = pure . realToFrac - toNative = pure . realToFrac - -type instance ForeignCxt Float = PureCxt -type instance ForeignCxt CFloat = PureCxt -instance Convert CFloat Float where - type Foreign Float = CFloat - type Native CFloat = Float - toForeign = pure . realToFrac - toNative = pure . realToFrac - - -type instance ForeignCxt String = IO -type instance ForeignCxt CWString = IO -instance Convert CWString String where - type Foreign String = CWString - type Native CWString = String - toForeign = newCWString - toNative = peekCWString - --- a quick and dirty way to represent arrays; the Int is because we need a size --- to convert from an array, and the newtype is because otherwise instances --- for [a] would overlap with String (which is actually [Char]) --- it would probably be nice to handle the (Int,_) as a context, actually, --- but I'm not sure what the most effective way to do that would be. -type SizedArray a = (Int, Ptr a) -newtype AsArray a = AsArray { getSizedArray :: [a] } --- instance Newtype (AsArray a) [a] where - -- pack = AsArray - -- unpack = getSizedArray - -type instance ForeignCxt (AsArray a) = IO -type instance ForeignCxt (SizedArray a) = IO -instance (Storable a) => Convert (SizedArray a) (AsArray a) where - type Foreign (AsArray a) = (SizedArray a) - type Native (SizedArray a) = (AsArray a) - toForeign xs = let xs' = getSizedArray xs in (,) (length xs') <$> newArray xs' - toNative = fmap AsArray . uncurry peekArray - -class FFImport ext where - type Import ext :: * - ffImport :: ext -> Import ext - -class FFExport int where - type Export int :: * - ffExport :: int -> Export int - -class A a where - type Res a :: * - foo :: a -> Res a - -instance A Int where - type Res Int = Int - foo x = x + 4 - --- instance ( Context (IO (ForeignCxt a (Native a))) - -- , Convert a (Native a) - -- ) => FFImport (IO a) where - -- type Import (IO a) = Collapse (IO (ForeignCxt a (Native a))) - -- ffImport x = collapse $ toNative <$> x - --- instance ( FFImport b, Convert a (Native a) - -- , Context (ForeignCxt (Native a) (Import b)) - -- , Functor (ForeignCxt (Native a)) - -- ) => FFImport (a -> b) where - -- type Import (a -> b) = Native a -> Collapse (ForeignCxt (Native a) (Import b)) - -- ffImport f x = collapse $ ffImport . f <$> toForeign x - --- instance ( Context (IO (ForeignCxt a (Foreign a))) - -- , Convert (Foreign a) a - -- ) => FFExport (IO a) where - -- type Export (IO a) = Collapse (IO (ForeignCxt a (Foreign a))) - -- ffExport x = collapse $ toForeign <$> x - --- instance ( FFExport b, Convert (Foreign a) a - -- , Context (ForeignCxt (Foreign a) (Export b)) - -- , Functor (ForeignCxt (Foreign a)) - -- ) => FFExport (a -> b) where - -- type Export (a -> b) = Foreign a -> Collapse (ForeignCxt (Foreign a) (Export b)) - -- ffExport f x = collapse $ ffExport . f <$> toNative x - --- instance ( FFImport (a -> b) - -- , FFExport (c -> d) - -- , Context (Native a -> Collapse (ForeignCxt (Native a) (Import b))) - -- ) => Convert (a -> b) (c -> d) where - -- type Native (a -> b) = Import (a -> b) - -- type Foreign (c -> d) = Export (c -> d) - -- toNative = collapse . ffImport
Hs2lib.cabal view
@@ -1,5 +1,5 @@ Name: Hs2lib -Version: 0.5.8 +Version: 0.6.0 Cabal-Version: >= 1.10 Build-Type: Custom License: BSD3 @@ -28,6 +28,8 @@ . - Does not support automatic instance generation for infix constructors yet . + NOTE: Package is not working again, but I have fixed the version of haskell-src-exts to prevent it from breaking again. + . Data-Files: Templates/main.template-unix.c, Templates/main.template-win.c, Templates/nomain.template-unix.c, @@ -94,7 +96,7 @@ WinDll.Lib.Tuples_Debug, WinDll.Structs.Types - Build-Depends: haskell-src-exts >= 1.13.5, + Build-Depends: haskell-src-exts == 1.13.5, ghc >= 6.12 && < 7.0 || >= 7.0.2, base >= 4 && < 5, filepath >= 1.1.0.2, @@ -127,7 +129,7 @@ mtl >= 1.1.0.2, containers >= 0.2.0.0, array >= 0.2.0.0, - haskell-src-exts >= 1.13.5, + haskell-src-exts == 1.13.5, haddock >= 2.7.2, base >= 4 && < 5, syb >= 0.1.0.2, @@ -157,7 +159,7 @@ mtl >= 1.1.0.2, containers >= 0.2.0.0, array >= 0.2.0.0, - haskell-src-exts >= 1.13.5, + haskell-src-exts == 1.13.5, haddock >= 2.7.2, base >= 4 && < 5, syb >= 0.1.0.2, @@ -189,7 +191,7 @@ mtl >= 1.1.0.2, containers >= 0.2.0.0, array >= 0.2.0.0, - haskell-src-exts >= 1.13.5, + haskell-src-exts == 1.13.5, haddock >= 2.7.2, base >= 4 && < 5, syb >= 0.1.0.2,
+ TODO.txt view
@@ -0,0 +1,15 @@+** 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 []
− Tests/Exec/Default.hi
binary file changed (1503 → absent bytes)
− Tests/Exec/Default.o
binary file changed (1957 → absent bytes)
− Tests/Exec/Example.hi
binary file changed (1821 → absent bytes)
− Tests/FindFiles.hi
binary file changed (1357 → absent bytes)
− Tests/FindFiles.o
binary file changed (8683 → absent bytes)
− Tests/Src/Test_Validation.hi
binary file changed (2253 → absent bytes)
− Tests/TestRunner.hi
binary file changed (1614 → absent bytes)
− Tests/TestRunner.o
binary file changed (8039 → absent bytes)
− WinDll/Lib/InstancesTypes.hi
binary file changed (1173 → absent bytes)
− WinDll/Lib/InstancesTypes.o
binary file changed (1357 → absent bytes)
WinDll/Utils/DepScanner.hs view
@@ -64,7 +64,7 @@ -- | Get the module dependency graph of the given file getGraph :: String -> IO ModuleGraph getGraph file = -#if __GLASGOW_HASKELL__ >= 706+#if __GLASGOW_HASKELL__ >= 704 defaultErrorHandler defaultFatalMessager defaultFlushOut $ do #elif __GLASGOW_HASKELL__ >= 702 defaultErrorHandler defaultLogAction $ do
WinDll/Utils/ListTypes.hs view
@@ -54,7 +54,8 @@ (Exts.TyCon $ Exts.UnQual $ Exts.Ident $ if esc then "CInt" else "Int")) _ -> val) t' else t' - 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' + -- in 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' + in ty' where embedded :: Exts.Type -> Exts.Type embedded (Exts.TyParen a) = (Exts.TyParen (analyzeType esc a)) embedded x = x @@ -102,19 +103,21 @@ -- | Update a type according to the annotations present updateType :: Bool -> Ann -> Exts.Type -> Exts.Type -updateType esc ann = everywhere (mkT pushType) +updateType esc ann t = fold t where -- | Types to update - pushType :: Exts.Type -> Exts.Type - 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 - -- (Exts.TyCon $ Exts.UnQual $ Exts.Ident "Int") x - -- False -> x - -- in if isIO a - -- then simplify (move a $ f b) - -- else Exts.TyApp a b - pushType x = g x + fold :: Exts.Type -> Exts.Type + fold (Exts.TyForall a b c) = Exts.TyForall a b (fold c) + fold (Exts.TyFun a b) = let a' = fold a + b' = fold b + in f a' $ Exts.TyFun a' (g b') + fold (Exts.TyTuple a b) = Exts.TyTuple a (map fold b) + fold (Exts.TyApp a b) = let a' = fold a + b' = fold b + in if isIO a' + then simplify (move a' $ g b') + else Exts.TyApp a b + fold (Exts.TyParen a) = Exts.TyParen (fold a) + fold x = x f x = case isIOList x of True -> Exts.TyFun
WinDll/Version/Debug.hs view
@@ -33,7 +33,7 @@ versionmsg :: String versionmsg = exename ++ " Build version " ++ version - ++ "\n(c) Tamar Christina <tamar@zhox.com>. 2009 - 2011." + ++ "\n(c) Tamar Christina <tamar@zhox.com>. 2009 - 2014." -- | Product name exename :: String
WinDll/Version/Hs2lib.hs view
@@ -19,7 +19,7 @@ -- | Version Number verNum :: [Int] -verNum = [0,5,8] +verNum = [0,6,0] -- | Version string verStr :: String @@ -33,7 +33,7 @@ versionmsg :: String versionmsg = exename ++ " Build version " ++ version - ++ "\n(c) Tamar Christina <tamar@zhox.com>. 2009 - 2011." + ++ "\n(c) Tamar Christina <tamar@zhox.com>. 2009 - 2014." -- | Product name exename :: String