Salsa 0.2.0.1 → 0.2.0.2
raw patch · 13 files changed
+165/−523 lines, 13 files
Files
- Driver/Salsa.dll binary
- Foreign/Salsa/Binding.hs +14/−14
- Foreign/Salsa/Core.hs +21/−26
- Foreign/Salsa/Mono/CLRHost.hs +1/−1
- Foreign/Salsa/Resolver.hs +62/−86
- Foreign/Salsa/TypePrelude.hs +29/−326
- Foreign/Salsa/salsa.c +11/−3
- Generator/Generator.cs +4/−50
- Generator/Generator.csproj +6/−11
- README +3/−3
- Salsa.cabal +1/−1
- Samples/Hello/Hello.hs +6/−1
- Samples/Hello/Hello.imports +7/−1
Driver/Salsa.dll view
binary file changed (18944 → 18944 bytes)
Foreign/Salsa/Binding.hs view
@@ -60,30 +60,30 @@ "System.Int32" -- --- Typeable instances for primitive types+-- SalsaForeignType instances for primitive types -- -instance Typeable Int32 where typeOf _ = typeOfString "System.Int32"-instance Typeable String where typeOf _ = typeOfString "System.String"-instance Typeable Bool where typeOf _ = typeOfString "System.Boolean"-instance Typeable Double where typeOf _ = typeOfString "System.Double"+instance SalsaForeignType Int32 where foreignTypeOf _ = foreignTypeFromString "System.Int32"+instance SalsaForeignType String where foreignTypeOf _ = foreignTypeFromString "System.String"+instance SalsaForeignType Bool where foreignTypeOf _ = foreignTypeFromString "System.Boolean"+instance SalsaForeignType Double where foreignTypeOf _ = foreignTypeFromString "System.Double" -typeOfString :: String -> Obj Type_-typeOfString s = unsafePerformIO $ do+foreignTypeFromString :: String -> Obj Type_+foreignTypeFromString s = unsafePerformIO $ do -- putStrLn $ "typeOfString: " ++ s type_GetType s -- marshalMethod1s type_GetType_stub undefined undefined s --- Define the typeOf function for arrays by first calling typeOf on the element type,+-- Define the foreignTypeOf function for arrays by first calling foreignTypeOf on the element type, -- and then using the Type.MakeArrayType method to return the associated one-dimensional -- array type:-instance Typeable t => Typeable (Arr t) where- typeOf _ = unsafePerformIO $- marshalMethod1i type_MakeArrayType_stub (typeOf (undefined :: t)) undefined (1 :: Int32)+instance SalsaForeignType t => SalsaForeignType (Arr t) where+ foreignTypeOf _ = unsafePerformIO $+ marshalMethod1i type_MakeArrayType_stub (foreignTypeOf (undefined :: t)) undefined (1 :: Int32) -- Note: this function requires ScopedTypeVariables --- Define typeOf for reference types in terms of the associated static type.-instance Typeable t => Typeable (Obj t) where- typeOf _ = typeOf (undefined :: t)+-- Define foreignTypeOf for reference types in terms of the associated static type.+instance SalsaForeignType t => SalsaForeignType (Obj t) where+ foreignTypeOf _ = foreignTypeOf (undefined :: t) -- vim:set sw=4 ts=4 expandtab:
Foreign/Salsa/Core.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE GADTs, TypeFamilies, MultiParamTypeClasses, EmptyDataDecls #-} {-# LANGUAGE ExistentialQuantification, FlexibleContexts, TypeOperators #-} {-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances, CPP, ForeignFunctionInterface #-}+{-# LANGUAGE UndecidableInstances, CPP, ForeignFunctionInterface, DataKinds, PolyKinds #-} ----------------------------------------------------------------------------- -- | -- Licence : BSD-style (see LICENSE)@@ -53,8 +53,8 @@ -- Calls 'ResolveMember', converting argument tuples to/from type-level lists, -- and passing it the appropriate list of candidate signatures.-type family Resolve t m args-type instance Resolve t m args = ListToTuple (ResolveMember (TupleToList args) (Candidates t m))+type family Resolve t m args where+ Resolve t m args = ListToTuple (ResolveMember (TupleToList args) (Candidates t m)) -- | 'Invoker' provides type-based dispatch to method implementations, and -- a constrainted result type for method invocations.@@ -161,42 +161,37 @@ -- | 'TupleToList t' is the type-level list representation of the tuple @t@ -- containing marshalable types. This allows arguments to .NET members to -- be passed as tuples, which have a much neater syntax than lists.-type family TupleToList t-type instance TupleToList () = TNil-type instance TupleToList (Obj x) = Obj x ::: TNil-type instance TupleToList String = String ::: TNil-type instance TupleToList Int32 = Int32 ::: TNil-type instance TupleToList Bool = Bool ::: TNil-type instance TupleToList Double = Double ::: TNil-type instance TupleToList (a,b) = a ::: b ::: TNil-type instance TupleToList (a,b,c) = a ::: b ::: c ::: TNil-type instance TupleToList (a,b,c,d) = a ::: b ::: c ::: d ::: TNil-type instance TupleToList (a,b,c,d,e) = a ::: b ::: c ::: d ::: e ::: TNil+type family TupleToList t where+ TupleToList (a,b,c,d,e) = a ::: b ::: c ::: d ::: e ::: TNil+ TupleToList (a,b,c,d) = a ::: b ::: c ::: d ::: TNil+ TupleToList (a,b,c) = a ::: b ::: c ::: TNil+ TupleToList (a,b) = a ::: b ::: TNil+ TupleToList () = TNil+ TupleToList (a) = a ::: TNil -- ... -- | 'ListToTuple l' is the tuple type associated with the type-level list @l@.-type family ListToTuple t-type instance ListToTuple (Error x) = Error x -- propagate errors-type instance ListToTuple TNil = ()-type instance ListToTuple (a ::: TNil) = a-type instance ListToTuple (a ::: b ::: TNil) = (a,b) -type instance ListToTuple (a ::: b ::: c ::: TNil) = (a,b,c)-type instance ListToTuple (a ::: b ::: c ::: d ::: TNil) = (a,b,c,d)-type instance ListToTuple (a ::: b ::: c ::: d ::: e ::: TNil) = (a,b,c,d,e)+type family ListToTuple t where+ ListToTuple (Error x) = Error x -- propagate errors+ ListToTuple TNil = ()+ ListToTuple (a ::: TNil) = a+ ListToTuple (a ::: b ::: TNil) = (a,b) + ListToTuple (a ::: b ::: c ::: TNil) = (a,b,c)+ ListToTuple (a ::: b ::: c ::: d ::: TNil) = (a,b,c,d)+ ListToTuple (a ::: b ::: c ::: d ::: e ::: TNil) = (a,b,c,d,e) -- ... -- -- Type reflection (connects Haskell types to .NET types) -- --- | The class 'Typeable' provides access to the underlying .NET type that is +-- | The class 'SalsaForeignType' provides access to the underlying .NET type that is -- associated with a given Haskell type.-class Typeable t where +class SalsaForeignType t where -- | Returns the .NET System.Type instance for values of type 't'. -- The value of 't' is not evaluated by the function.- typeOf :: t -> Obj Type_+ foreignTypeOf :: t -> Obj Type_ --- TODO: Perhaps rename Typeable to Type or SalsaType or Target? --
Foreign/Salsa/Mono/CLRHost.hs view
@@ -135,8 +135,8 @@ loadDriverAndBoot :: IO (FunPtr (CString -> IO (FunPtr a))) loadDriverAndBoot = do- loadDriver setupDomain+ loadDriver salsa <- getSalsa method <- getMethodFromNameImage "Salsa.Driver:Boot()" salsa if method == nullPtr then
Foreign/Salsa/Resolver.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TypeFamilies, MultiParamTypeClasses, EmptyDataDecls, TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableInstances, DataKinds, PolyKinds, GADTs #-} ----------------------------------------------------------------------------- -- | -- Licence : BSD-style (see LICENSE)@@ -18,63 +18,38 @@ -- Basic predicates -- -type family IsPrim t+type family IsPrim t :: TBool type instance IsPrim Int32 = TTrue type instance IsPrim String = TTrue type instance IsPrim Bool = TTrue type instance IsPrim Double = TTrue type instance IsPrim (Obj t) = TFalse -type family IsRef t+type family IsRef t :: TBool type instance IsRef t = TNot (IsPrim t) -- FIXME: This definition of IsRef is incorrect. String is a reference -- type (in .NET) but it is also a primitive bridge type. ------ Operations on the encoded (Gödel) representations of .NET types:--- --- | 'TyCode' maps labels representing .NET types to a type-level list of hexadecimal--- values (similar to Gödel numbering) which can (then) be compared for equality.--- This avoids having to define a large type function for comparing every pair--- of labels used to represent .NET types.-type family TyCode t--type instance TyCode Int32 = D0 ::: TNil-type instance TyCode String = D1 ::: TNil-type instance TyCode Bool = D2 ::: TNil-type instance TyCode Double = D3 ::: TNil-type instance TyCode (Obj Null) = D4 ::: TNil-type instance TyCode (Maybe Bool) = D5 ::: TNil -- Temporary HACK---type family FromTyCode t-type instance FromTyCode (D0 ::: TNil) = Int32-type instance FromTyCode (D1 ::: TNil) = String-type instance FromTyCode (D2 ::: TNil) = Bool-type instance FromTyCode (D3 ::: TNil) = Double-type instance FromTyCode (D4 ::: TNil) = Obj Null-type instance FromTyCode (D5 ::: TNil) = Maybe Bool-- -- | 'TyEq t1 t2' is true iff the types @t1@ and @t2@ are the same .NET type -- (as indicated by their code).-type family TyEq t1 t2-type instance TyEq t1 t2 = DigitsEq (TyCode t1) (TyCode t2)+type family TyEq t1 t2 where+ TyEq x x = TTrue+ TyEq x y = TFalse -- | 'MemberEq m n' is true iff the members 'm' and 'n' have the same types.-type family MemberEq m n-type instance MemberEq TNil TNil = TTrue-type instance MemberEq TNil (n ::: ns) = TFalse-type instance MemberEq (m ::: ms) TNil = TFalse-type instance MemberEq (m ::: ms) (n ::: ns) = TAnd (TyEq m n) (MemberEq ms ns)+type family MemberEq m n :: TBool where+ MemberEq TNil TNil = TTrue+ MemberEq TNil (n ::: ns) = TFalse+ MemberEq (m ::: ms) TNil = TFalse+ MemberEq (m ::: ms) (n ::: ns) = TAnd (TyEq m n) (MemberEq ms ns) -- | @'TyElem' t ts@ is true iff the type @t@ is present in the list @ts@ -- (containing coded type representations).-type family TyElem t1 ts-type instance TyElem t1 TNil = TFalse-type instance TyElem t1 (t ::: ts) = TOr (TyEq t1 t) (TyElem t1 ts)+type family TyElem t1 ts :: TBool where+ TyElem t1 TNil = TFalse+ TyElem t1 (t ::: ts) = TOr (TyEq t1 t) (TyElem t1 ts) -- -- Overload resolution algorithm:@@ -110,14 +85,14 @@ -- filterBestMembers :: [Type] -> [Member] -> [Member] -> [Member] -- filterBestMembers as ms ns = filter (isBestMember as ms) ns ---type family FilterBestMembers as ms ns-type instance FilterBestMembers as ms TNil = TNil-type instance FilterBestMembers as ms (n ::: ns) = FilterBestMembers' as ms n (FilterBestMembers as ms ns)+type family FilterBestMembers as ms ns where+ FilterBestMembers as ms TNil = TNil+ FilterBestMembers as ms (n ::: ns) = FilterBestMembers' as ms n (FilterBestMembers as ms ns) -- was: If (IsBestMember as ms n) (n ::: (FilterBestMembers as ms ns)) -- (FilterBestMembers as ms ns) -type family FilterBestMembers' as ms n fbms-type instance FilterBestMembers' as ms n fbms = If (IsBestMember as ms n) (n ::: fbms) fbms+type family FilterBestMembers' as ms n fbms where+ FilterBestMembers' as ms n fbms = If (IsBestMember as ms n) (n ::: fbms) fbms -- | @'IsBestMember' as ms n@ is true iff the member @n@ is better than all@@ -129,24 +104,24 @@ -- | m /= n = isBetterMember as n m && isBestMember as ms n -- | otherwise = isBestMember as ms n -- skip members equal to 'n' ---type family IsBestMember as ms n-type instance IsBestMember as TNil n = TTrue-type instance IsBestMember as (m ::: ms) n =- If (MemberEq m n) (IsBestMember as ms n)+type family IsBestMember as ms n :: TBool where+ IsBestMember as TNil n = TTrue+ IsBestMember as (m ::: ms) n =+ If (MemberEq m n) (IsBestMember as ms n) (TAnd (IsBetterMember as n m) (IsBestMember as ms n)) -- | @'FilterApp' as ms@ returns the list of members from @ms@ that are -- applicable with respect to the argument list @as@.-type family FilterApp as ms-type instance FilterApp as TNil = TNil-type instance FilterApp as (m ::: ms) = FilterApp' as m (FilterApp as ms)+type family FilterApp as ms where+ FilterApp as TNil = TNil+ FilterApp as (m ::: ms) = FilterApp' as m (FilterApp as ms) -- was: If (IsApp as m) (m ::: FilterApp as ms) -- (FilterApp as ms) -- Note: use of FilterApp' increases compilation speed by a factor of 10 (!)-type family FilterApp' as m fas-type instance FilterApp' as m fas = If (IsApp as m) (m ::: fas) fas+type family FilterApp' as m fas where+ FilterApp' as m fas = If (IsApp as m) (m ::: fas) fas -- | @'IsApp' as ps@ is true iff the function member defined by the @@ -154,11 +129,11 @@ -- (ref 7.4.2.1). This means they of the same length and an implicit -- conversion exists from the argument type to the corresponding -- parameter on the function member.-type family IsApp as ps-type instance IsApp TNil TNil = TTrue-type instance IsApp TNil (p ::: ps) = TFalse -- different lengths-type instance IsApp (a ::: as) TNil = TFalse -- different lengths-type instance IsApp (a ::: as) (p ::: ps) = TAnd (ConvertsTo a p) (IsApp as ps)+type family IsApp as ps :: TBool where+ IsApp TNil TNil = TTrue+ IsApp TNil (p ::: ps) = TFalse -- different lengths+ IsApp (a ::: as) TNil = TFalse -- different lengths+ IsApp (a ::: as) (p ::: ps) = TAnd (ConvertsTo a p) (IsApp as ps) -- | @'IsBetterMember' as ps qs@ returns true iff the function member defined by the@@ -168,22 +143,20 @@ -- isBetterMember :: [Type] -> Member -> Member -> Bool -- isBetterMember as ps qs = someBetter as ps qs && not (someBetter as qs ps) ---type family IsBetterMember as ps qs-type instance IsBetterMember as ps qs =- TAnd (AnyBetterConv as ps qs) - (TNot (AnyBetterConv as qs ps))+type family IsBetterMember as ps qs :: TBool where+ IsBetterMember as ps qs =+ TAnd (AnyBetterConv as ps qs) + (TNot (AnyBetterConv as qs ps)) -type family AnyBetterConv as ss ts-type instance AnyBetterConv TNil TNil TNil = TFalse-type instance AnyBetterConv (a ::: as) (s ::: ss) (t ::: ts) =- TOr (IsBetterConv a s t) (AnyBetterConv as ss ts)+type family AnyBetterConv as ss ts :: TBool where+ AnyBetterConv TNil TNil TNil = TFalse+ AnyBetterConv (a ::: as) (s ::: ss) (t ::: ts) = TOr (IsBetterConv a s t) (AnyBetterConv as ss ts) -type family IsBetterConv t t1 t2-type instance IsBetterConv t t1 t2 =- TOr (TAnd (TyEq t t1) (TNot (TyEq t t2)))- (TAnd (ConvertsTo t1 t2) (TNot (ConvertsTo t2 t1)))+type family IsBetterConv t t1 t2 :: TBool where+ IsBetterConv t t1 t2 = TOr (TAnd (TyEq t t1) (TNot (TyEq t t2)))+ (TAnd (ConvertsTo t1 t2) (TNot (ConvertsTo t2 t1))) -- -- Original:@@ -199,16 +172,16 @@ -- | @'ConvertsTo' s t@ returns true iff there is an implicit conversion from @s@ -- to @t@ (ref 6.1).-type family ConvertsTo t1 t2-type instance ConvertsTo t1 t2 =- (TOr (TyEq t1 t2)- (TOr (TAnd (IsPrim t1) (TyEq t2 (Obj Object_)))- (TOr (TAnd (TyEq t1 Int32) (TyEq t2 Double))- (TOr (TAnd (TyEq t1 (Obj Null)) (IsRef t2))--- (TOr (TAnd (TAnd (IsArr t1) (IsArr t2))--- (IsSubtypeOf' (ArrElemTy t1) (ArrElemTy t2)))- (TAnd (TAnd (IsRef t1) (IsRef t2))- (IsSubtypeOf t1 t2)))))) -- )+type family ConvertsTo t1 t2 :: TBool where+ ConvertsTo t1 t2 =+ (TOr (TyEq t1 t2)+ (TOr (TAnd (IsPrim t1) (TyEq t2 (Obj Object_)))+ (TOr (TAnd (TyEq t1 Int32) (TyEq t2 Double))+ (TOr (TAnd (TyEq t1 (Obj Null)) (IsRef t2))+ -- (TOr (TAnd (TAnd (IsArr t1) (IsArr t2))+ -- (IsSubtypeOf' (ArrElemTy t1) (ArrElemTy t2)))+ (TAnd (TAnd (IsRef t1) (IsRef t2))+ (IsSubtypeOf t1 t2)))))) -- ) -- (TOr5 (TyEq t1 t2)@@ -219,19 +192,21 @@ -- Note: using TOr5 instead of a nested set of TOr's only gives a small performance improvement. -type family IsSubtypeOf t1 t2-type instance IsSubtypeOf t1 t2 = - TOr (TyEq t1 t2)+type family IsSubtypeOf t1 t2 :: TBool where+ IsSubtypeOf t1 t2 = TOr (TyEq t1 t2) (TyElem t2 (SupertypesOf t1)) -type family IsArr t-type instance IsArr t = TAnd (TNot (TyEq t (Obj Array_)))- (IsSubtypeOf t (Obj Array_))+type family IsArr t :: TBool where+ IsArr t = TAnd (TNot (TyEq t (Obj Array_)))+ (IsSubtypeOf t (Obj Array_)) +{- type family ArrElemTy t type instance ArrElemTy t = ArrElemTy' (TyCode t)+-} +{- type family ArrElemTy' tc type instance ArrElemTy' (D0 ::: DF ::: tc) = tc type family IsSubtypeOf' t1 t2@@ -246,6 +221,7 @@ type family TyElem' t1 ts type instance TyElem' t1 TNil = TFalse type instance TyElem' t1 (t ::: ts) = TOr (TyEq' t1 (TyCode t)) (TyElem' t1 ts) -- UGLY!+-} -- | @'SupertypesOf' t@ is the list of supertypes of @t@. type family SupertypesOf t
Foreign/Salsa/TypePrelude.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE TypeFamilies, TypeOperators, EmptyDataDecls #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies, TypeOperators, EmptyDataDecls, UndecidableInstances, DataKinds, PolyKinds, GADTs #-} ----------------------------------------------------------------------------- -- | -- Licence : BSD-style (see LICENSE)@@ -14,36 +13,26 @@ -- Type-level booleans and boolean operations: -- -data TTrue = TTrue-data TFalse = TFalse+data TBool where+ TTrue :: TBool+ TFalse :: TBool -type family TOr x y-type instance TOr TTrue x = TTrue-type instance TOr TFalse x = x -type family TAnd x y-type instance TAnd TFalse x = TFalse-type instance TAnd TTrue x = x--type family TNot x-type instance TNot TTrue = TFalse-type instance TNot TFalse = TTrue+type family TOr x y where+ TOr TTrue x = TTrue+ TOr TFalse x = x -type family If c a b-type instance If TTrue a b = a-type instance If TFalse a b = b+type family TAnd x y where+ TAnd TFalse x = TFalse+ TAnd TTrue x = x ---type family TAnd3 x y z---type instance TAnd3 TFalse y z = TFalse---type instance TAnd3 TTrue TFalse z = TFalse---type instance TAnd3 TTrue TTrue z = z+type family TNot x where+ TNot TTrue = TFalse+ TNot TFalse = TTrue ---type family TOr5 a b c d e---type instance TOr5 TTrue b c d e = TTrue---type instance TOr5 TFalse TTrue c d e = TTrue---type instance TOr5 TFalse TFalse TTrue d e = TTrue---type instance TOr5 TFalse TFalse TFalse TTrue e = TTrue---type instance TOr5 TFalse TFalse TFalse TFalse e = e+type family If c a b where+ If TTrue a b = a+ If TFalse a b = b -- -- Type-level lists and associated operations:@@ -53,310 +42,24 @@ data x ::: xs -- = x ::: xs infixr 5 ::: -type family BoolEq x y-type instance BoolEq TTrue TTrue = TTrue-type instance BoolEq TFalse TFalse = TTrue-type instance BoolEq TFalse TTrue = TFalse-type instance BoolEq TTrue TFalse = TFalse+type family BoolEq x y where+ BoolEq TTrue TTrue = TTrue+ BoolEq TFalse TFalse = TTrue+ BoolEq TFalse TTrue = TFalse+ BoolEq TTrue TFalse = TFalse -- | 'ListEq xs ys' is true if the given type-level boolean lists contain -- the same boolean values, and false otherwise.-type family ListEq xs ys-type instance ListEq TNil TNil = TTrue-type instance ListEq (x ::: xs) TNil = TFalse-type instance ListEq TNil (x ::: xs) = TFalse-type instance ListEq (x ::: xs) (y ::: ys) = TAnd (BoolEq x y) (ListEq xs ys)+type family ListEq xs ys where+ ListEq TNil TNil = TTrue+ ListEq (x ::: xs) TNil = TFalse+ ListEq TNil (x ::: xs) = TFalse+ ListEq (x ::: xs) (y ::: ys) = TAnd (BoolEq x y) (ListEq xs ys) -- | @'FromSingleton' xs def@ returns the only element of the list @xs@ (if it is a -- single element list), otherwise it returns the default value @def@.-type family FromSingleton def xs-type instance FromSingleton def TNil = def-type instance FromSingleton def (x ::: TNil) = x-type instance FromSingleton def (x ::: y ::: z) = def---- --- Type-level base-16 digits and equality:-----data D0 = D0-data D1 = D1-data D2 = D2-data D3 = D3-data D4 = D4-data D5 = D5-data D6 = D6-data D7 = D7-data D8 = D8-data D9 = D9-data DA = DA-data DB = DB-data DC = DC-data DD = DD-data DE = DE-data DF = DF--type family DigitEq x y-type instance DigitEq D0 D0 = TTrue-type instance DigitEq D1 D0 = TFalse-type instance DigitEq D2 D0 = TFalse-type instance DigitEq D3 D0 = TFalse-type instance DigitEq D4 D0 = TFalse-type instance DigitEq D5 D0 = TFalse-type instance DigitEq D6 D0 = TFalse-type instance DigitEq D7 D0 = TFalse-type instance DigitEq D8 D0 = TFalse-type instance DigitEq D9 D0 = TFalse-type instance DigitEq DA D0 = TFalse-type instance DigitEq DB D0 = TFalse-type instance DigitEq DC D0 = TFalse-type instance DigitEq DD D0 = TFalse-type instance DigitEq DE D0 = TFalse-type instance DigitEq DF D0 = TFalse-type instance DigitEq D0 D1 = TFalse-type instance DigitEq D1 D1 = TTrue-type instance DigitEq D2 D1 = TFalse-type instance DigitEq D3 D1 = TFalse-type instance DigitEq D4 D1 = TFalse-type instance DigitEq D5 D1 = TFalse-type instance DigitEq D6 D1 = TFalse-type instance DigitEq D7 D1 = TFalse-type instance DigitEq D8 D1 = TFalse-type instance DigitEq D9 D1 = TFalse-type instance DigitEq DA D1 = TFalse-type instance DigitEq DB D1 = TFalse-type instance DigitEq DC D1 = TFalse-type instance DigitEq DD D1 = TFalse-type instance DigitEq DE D1 = TFalse-type instance DigitEq DF D1 = TFalse-type instance DigitEq D0 D2 = TFalse-type instance DigitEq D1 D2 = TFalse-type instance DigitEq D2 D2 = TTrue-type instance DigitEq D3 D2 = TFalse-type instance DigitEq D4 D2 = TFalse-type instance DigitEq D5 D2 = TFalse-type instance DigitEq D6 D2 = TFalse-type instance DigitEq D7 D2 = TFalse-type instance DigitEq D8 D2 = TFalse-type instance DigitEq D9 D2 = TFalse-type instance DigitEq DA D2 = TFalse-type instance DigitEq DB D2 = TFalse-type instance DigitEq DC D2 = TFalse-type instance DigitEq DD D2 = TFalse-type instance DigitEq DE D2 = TFalse-type instance DigitEq DF D2 = TFalse-type instance DigitEq D0 D3 = TFalse-type instance DigitEq D1 D3 = TFalse-type instance DigitEq D2 D3 = TFalse-type instance DigitEq D3 D3 = TTrue-type instance DigitEq D4 D3 = TFalse-type instance DigitEq D5 D3 = TFalse-type instance DigitEq D6 D3 = TFalse-type instance DigitEq D7 D3 = TFalse-type instance DigitEq D8 D3 = TFalse-type instance DigitEq D9 D3 = TFalse-type instance DigitEq DA D3 = TFalse-type instance DigitEq DB D3 = TFalse-type instance DigitEq DC D3 = TFalse-type instance DigitEq DD D3 = TFalse-type instance DigitEq DE D3 = TFalse-type instance DigitEq DF D3 = TFalse-type instance DigitEq D0 D4 = TFalse-type instance DigitEq D1 D4 = TFalse-type instance DigitEq D2 D4 = TFalse-type instance DigitEq D3 D4 = TFalse-type instance DigitEq D4 D4 = TTrue-type instance DigitEq D5 D4 = TFalse-type instance DigitEq D6 D4 = TFalse-type instance DigitEq D7 D4 = TFalse-type instance DigitEq D8 D4 = TFalse-type instance DigitEq D9 D4 = TFalse-type instance DigitEq DA D4 = TFalse-type instance DigitEq DB D4 = TFalse-type instance DigitEq DC D4 = TFalse-type instance DigitEq DD D4 = TFalse-type instance DigitEq DE D4 = TFalse-type instance DigitEq DF D4 = TFalse-type instance DigitEq D0 D5 = TFalse-type instance DigitEq D1 D5 = TFalse-type instance DigitEq D2 D5 = TFalse-type instance DigitEq D3 D5 = TFalse-type instance DigitEq D4 D5 = TFalse-type instance DigitEq D5 D5 = TTrue-type instance DigitEq D6 D5 = TFalse-type instance DigitEq D7 D5 = TFalse-type instance DigitEq D8 D5 = TFalse-type instance DigitEq D9 D5 = TFalse-type instance DigitEq DA D5 = TFalse-type instance DigitEq DB D5 = TFalse-type instance DigitEq DC D5 = TFalse-type instance DigitEq DD D5 = TFalse-type instance DigitEq DE D5 = TFalse-type instance DigitEq DF D5 = TFalse-type instance DigitEq D0 D6 = TFalse-type instance DigitEq D1 D6 = TFalse-type instance DigitEq D2 D6 = TFalse-type instance DigitEq D3 D6 = TFalse-type instance DigitEq D4 D6 = TFalse-type instance DigitEq D5 D6 = TFalse-type instance DigitEq D6 D6 = TTrue-type instance DigitEq D7 D6 = TFalse-type instance DigitEq D8 D6 = TFalse-type instance DigitEq D9 D6 = TFalse-type instance DigitEq DA D6 = TFalse-type instance DigitEq DB D6 = TFalse-type instance DigitEq DC D6 = TFalse-type instance DigitEq DD D6 = TFalse-type instance DigitEq DE D6 = TFalse-type instance DigitEq DF D6 = TFalse-type instance DigitEq D0 D7 = TFalse-type instance DigitEq D1 D7 = TFalse-type instance DigitEq D2 D7 = TFalse-type instance DigitEq D3 D7 = TFalse-type instance DigitEq D4 D7 = TFalse-type instance DigitEq D5 D7 = TFalse-type instance DigitEq D6 D7 = TFalse-type instance DigitEq D7 D7 = TTrue-type instance DigitEq D8 D7 = TFalse-type instance DigitEq D9 D7 = TFalse-type instance DigitEq DA D7 = TFalse-type instance DigitEq DB D7 = TFalse-type instance DigitEq DC D7 = TFalse-type instance DigitEq DD D7 = TFalse-type instance DigitEq DE D7 = TFalse-type instance DigitEq DF D7 = TFalse-type instance DigitEq D0 D8 = TFalse-type instance DigitEq D1 D8 = TFalse-type instance DigitEq D2 D8 = TFalse-type instance DigitEq D3 D8 = TFalse-type instance DigitEq D4 D8 = TFalse-type instance DigitEq D5 D8 = TFalse-type instance DigitEq D6 D8 = TFalse-type instance DigitEq D7 D8 = TFalse-type instance DigitEq D8 D8 = TTrue-type instance DigitEq D9 D8 = TFalse-type instance DigitEq DA D8 = TFalse-type instance DigitEq DB D8 = TFalse-type instance DigitEq DC D8 = TFalse-type instance DigitEq DD D8 = TFalse-type instance DigitEq DE D8 = TFalse-type instance DigitEq DF D8 = TFalse-type instance DigitEq D0 D9 = TFalse-type instance DigitEq D1 D9 = TFalse-type instance DigitEq D2 D9 = TFalse-type instance DigitEq D3 D9 = TFalse-type instance DigitEq D4 D9 = TFalse-type instance DigitEq D5 D9 = TFalse-type instance DigitEq D6 D9 = TFalse-type instance DigitEq D7 D9 = TFalse-type instance DigitEq D8 D9 = TFalse-type instance DigitEq D9 D9 = TTrue-type instance DigitEq DA D9 = TFalse-type instance DigitEq DB D9 = TFalse-type instance DigitEq DC D9 = TFalse-type instance DigitEq DD D9 = TFalse-type instance DigitEq DE D9 = TFalse-type instance DigitEq DF D9 = TFalse-type instance DigitEq D0 DA = TFalse-type instance DigitEq D1 DA = TFalse-type instance DigitEq D2 DA = TFalse-type instance DigitEq D3 DA = TFalse-type instance DigitEq D4 DA = TFalse-type instance DigitEq D5 DA = TFalse-type instance DigitEq D6 DA = TFalse-type instance DigitEq D7 DA = TFalse-type instance DigitEq D8 DA = TFalse-type instance DigitEq D9 DA = TFalse-type instance DigitEq DA DA = TTrue-type instance DigitEq DB DA = TFalse-type instance DigitEq DC DA = TFalse-type instance DigitEq DD DA = TFalse-type instance DigitEq DE DA = TFalse-type instance DigitEq DF DA = TFalse-type instance DigitEq D0 DB = TFalse-type instance DigitEq D1 DB = TFalse-type instance DigitEq D2 DB = TFalse-type instance DigitEq D3 DB = TFalse-type instance DigitEq D4 DB = TFalse-type instance DigitEq D5 DB = TFalse-type instance DigitEq D6 DB = TFalse-type instance DigitEq D7 DB = TFalse-type instance DigitEq D8 DB = TFalse-type instance DigitEq D9 DB = TFalse-type instance DigitEq DA DB = TFalse-type instance DigitEq DB DB = TTrue-type instance DigitEq DC DB = TFalse-type instance DigitEq DD DB = TFalse-type instance DigitEq DE DB = TFalse-type instance DigitEq DF DB = TFalse-type instance DigitEq D0 DC = TFalse-type instance DigitEq D1 DC = TFalse-type instance DigitEq D2 DC = TFalse-type instance DigitEq D3 DC = TFalse-type instance DigitEq D4 DC = TFalse-type instance DigitEq D5 DC = TFalse-type instance DigitEq D6 DC = TFalse-type instance DigitEq D7 DC = TFalse-type instance DigitEq D8 DC = TFalse-type instance DigitEq D9 DC = TFalse-type instance DigitEq DA DC = TFalse-type instance DigitEq DB DC = TFalse-type instance DigitEq DC DC = TTrue-type instance DigitEq DD DC = TFalse-type instance DigitEq DE DC = TFalse-type instance DigitEq DF DC = TFalse-type instance DigitEq D0 DD = TFalse-type instance DigitEq D1 DD = TFalse-type instance DigitEq D2 DD = TFalse-type instance DigitEq D3 DD = TFalse-type instance DigitEq D4 DD = TFalse-type instance DigitEq D5 DD = TFalse-type instance DigitEq D6 DD = TFalse-type instance DigitEq D7 DD = TFalse-type instance DigitEq D8 DD = TFalse-type instance DigitEq D9 DD = TFalse-type instance DigitEq DA DD = TFalse-type instance DigitEq DB DD = TFalse-type instance DigitEq DC DD = TFalse-type instance DigitEq DD DD = TTrue-type instance DigitEq DE DD = TFalse-type instance DigitEq DF DD = TFalse-type instance DigitEq D0 DE = TFalse-type instance DigitEq D1 DE = TFalse-type instance DigitEq D2 DE = TFalse-type instance DigitEq D3 DE = TFalse-type instance DigitEq D4 DE = TFalse-type instance DigitEq D5 DE = TFalse-type instance DigitEq D6 DE = TFalse-type instance DigitEq D7 DE = TFalse-type instance DigitEq D8 DE = TFalse-type instance DigitEq D9 DE = TFalse-type instance DigitEq DA DE = TFalse-type instance DigitEq DB DE = TFalse-type instance DigitEq DC DE = TFalse-type instance DigitEq DD DE = TFalse-type instance DigitEq DE DE = TTrue-type instance DigitEq DF DE = TFalse-type instance DigitEq D0 DF = TFalse-type instance DigitEq D1 DF = TFalse-type instance DigitEq D2 DF = TFalse-type instance DigitEq D3 DF = TFalse-type instance DigitEq D4 DF = TFalse-type instance DigitEq D5 DF = TFalse-type instance DigitEq D6 DF = TFalse-type instance DigitEq D7 DF = TFalse-type instance DigitEq D8 DF = TFalse-type instance DigitEq D9 DF = TFalse-type instance DigitEq DA DF = TFalse-type instance DigitEq DB DF = TFalse-type instance DigitEq DC DF = TFalse-type instance DigitEq DD DF = TFalse-type instance DigitEq DE DF = TFalse-type instance DigitEq DF DF = TTrue--type family DigitsEq xs ys-type instance DigitsEq TNil TNil = TTrue-type instance DigitsEq (x ::: xs) TNil = TFalse-type instance DigitsEq TNil (x ::: xs) = TFalse-type instance DigitsEq (x ::: xs) (y ::: ys) = TAnd (DigitEq x y) (DigitsEq xs ys)+type family FromSingleton def xs where+ FromSingleton def (x ::: TNil) = x+ FromSingleton def x = def -- vim:set sw=4 ts=4 expandtab:
Foreign/Salsa/salsa.c view
@@ -14,6 +14,7 @@ #include <stdint.h> #include <mono/metadata/appdomain.h>+#include <pthread.h> typedef struct { //layout of structures can be found in mono's domain-internals.h MonoObject object;@@ -22,12 +23,19 @@ MonoString *cache_path; MonoString *configuration_file; MonoString *dynamic_base;+ } MonoAppDomainSetupInternal; typedef struct {- void *lock;- void *pad;+ uint32_t depth;+ pthread_mutex_t mutex;++} CRITICAL_SECTION;+++typedef struct {+ CRITICAL_SECTION lock; void *mp; void *code_mp; MonoAppDomainSetupInternal *setup;@@ -37,7 +45,7 @@ } MonoDomainInternal; -void setupDomain(MonoDomain *domain, char *baseDir, char *configFile) //workaround for an issue that was introduced since Mono 3.0 but yet unresolved+void setupDomain(MonoDomain *domain, char *baseDir, char *configFile) //workaround for an issue that was introduced since Mono 3.0 but yet unresolved: https://bugzilla.xamarin.com/show_bug.cgi?id=12669 { MonoAppDomainSetupInternal *appDomSetup; appDomSetup = ((MonoDomainInternal*)domain)->setup;
Generator/Generator.cs view
@@ -37,9 +37,6 @@ /// </summary> private Dictionary<string, long> _uniqueIds = new Dictionary<string, long>(); - private int _typeCodeMaxValue = 15; - private int _typeCodeValue = 7; // Leave first 7 codes available for primitive types - /// <summary> /// Set of types that are required by the types generated so far. /// </summary> @@ -71,41 +68,6 @@ } } - /// <summary> - /// Returns a unique type-level list of booleans, which can be used as a type code. - /// </summary> - private string GetNextTypeCode() - { - const int encodingBase = 15; - // Note: This is not 16, thus leaving 'DF' available to use as a delimiter in type codes - // for parameterised types (like arrays). - - // Build a string for type code (as a Haskell type) - StringBuilder s = new StringBuilder(); - int x = _typeCodeValue; - int b = _typeCodeMaxValue; - while (b > 1) - { - s.AppendFormat("{0} ::: ", - new string[] { - "D0", "D1", "D2", "D3", "D4", "D5", "D6", "D7", - "D8", "D9", "DA", "DB", "DC", "DD", "DE", "DF" }[x % encodingBase]); - x /= encodingBase; - b /= encodingBase; - } - s.Append("TNil"); - - // Obtain the next type code - _typeCodeValue += 1; - if (_typeCodeValue == _typeCodeMaxValue) - { - _typeCodeValue = 0; - _typeCodeMaxValue *= encodingBase; - } - - return s.ToString(); - } - private void RequestAll(Type t) { _requestedTypes.Add(t); @@ -317,16 +279,16 @@ // - // Write a Salsa.Typeable instance for this class + // Write a Salsa.SalsaForeignType instance for this class // // Note: Type.GetType always returns the same instance for a given type, so it is // safe to use 'unsafePerformIO' below. // - w.WriteLine("instance Typeable {0} where", classLabel); - w.WriteLine(" typeOf _ = unsafePerformIO $ type_GetType \"{0}\"", targetType.AssemblyQualifiedName); + w.WriteLine("instance SalsaForeignType {0} where", classLabel); + w.WriteLine(" foreignTypeOf _ = unsafePerformIO $ type_GetType \"{0}\"", targetType.AssemblyQualifiedName); w.WriteLine(); - // TODO: Cache result of 'typeOf' in an IORef? + // TODO: Cache result of 'foreignTypeOf' in an IORef? { // @@ -591,14 +553,6 @@ foreach (Type supertype in supertypes) RequireType(supertype); - - // - // Type code - // - string typeCode = GetNextTypeCode(); - w.WriteLine("type instance TyCode {0} = {1}", ToHaskellType(targetType), typeCode); - w.WriteLine("type instance FromTyCode ({1}) = {0}", ToHaskellType(targetType), typeCode); // EXPERIMENTAL - w.WriteLine(); // if (targetType == typeof(System.Array)) // {
Generator/Generator.csproj view
@@ -1,4 +1,5 @@-<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003" ToolsVersion="3.5"> +<?xml version="1.0" encoding="utf-8"?> +<Project DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003" ToolsVersion="3.5"> <PropertyGroup> <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration> <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform> @@ -62,24 +63,18 @@ <EmbeddedResource Include="Array.hs" /> </ItemGroup> <ItemGroup> - <BootstrapperPackage Include="Microsoft.Net.Framework.2.0"> + <BootstrapperPackage Include="..\..\..\..\Projects\haskell\Salsa\Generator\Microsoft.Net.Framework.2.0"> <Visible>False</Visible> - <ProductName>.NET Framework 2.0 %28x86%29</ProductName> - <Install>true</Install> </BootstrapperPackage> - <BootstrapperPackage Include="Microsoft.Net.Framework.3.0"> + <BootstrapperPackage Include="..\..\..\..\Projects\haskell\Salsa\Generator\Microsoft.Net.Framework.3.0"> <Visible>False</Visible> - <ProductName>.NET Framework 3.0 %28x86%29</ProductName> - <Install>false</Install> </BootstrapperPackage> - <BootstrapperPackage Include="Microsoft.Net.Framework.3.5"> + <BootstrapperPackage Include="..\..\..\..\Projects\haskell\Salsa\Generator\Microsoft.Net.Framework.3.5"> <Visible>False</Visible> - <ProductName>.NET Framework 3.5</ProductName> - <Install>false</Install> </BootstrapperPackage> </ItemGroup> <ItemGroup> - <Folder Include="Properties\" /> + <Folder Include="..\..\..\..\Projects\haskell\Salsa\Generator\Properties\" /> </ItemGroup> <Import Project="$(MSBuildBinPath)\Microsoft.CSharp.targets" /> <!-- To modify your build process, add your task inside one of the targets below and uncomment it.
README view
@@ -45,10 +45,10 @@ Requirements: - * GHC 6.8 + * GHC 7.8 - Salsa makes extensive use of type families and thus requires at least - version 6.8 of GHC. + Salsa makes use of extensions that have only been available since version + 7.8 of GHC. * Microsoft .NET Framework 3.5 / Mono
Salsa.cabal view
@@ -1,7 +1,7 @@ Cabal-Version: >= 1.10 Name: Salsa -Version: 0.2.0.1 +Version: 0.2.0.2 Build-Type: Simple Category: Foreign, .NET
Samples/Hello/Hello.hs view
@@ -5,10 +5,15 @@ -- import Foreign.Salsa+import Control.Monad (forever) import Bindings main :: IO () main = withCLR $ do- _Console # _writeLine ("Hello .NET World!")+ invoke _Console _WriteLine ("Hello .NET World!")+ invoke _Application _EnableVisualStyles ()+ f <- new _Form ()+ invoke _Application _Run (f)+ return () -- vim:set sw=4 ts=4 expandtab:
Samples/Hello/Hello.imports view
@@ -1,2 +1,8 @@-reference C:\Windows\Microsoft.NET\Framework\v2.0.50727\System.dll+reference /usr/local/lib/mono/4.0/System.dll+reference /usr/local/lib/mono/4.0/System.Windows.Forms.dll+# System, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 System.Console: WriteLine+System.Object: ToString+System.Text.StringBuilder+System.Windows.Forms.Form: *+System.Windows.Forms.Application: *