[start adding support for dotnet foreign imports
John Meacham <john@repetae.net>**20061218100226] hunk ./C/FFI.hs 11
-data CallConv = CCall | StdCall | Primitive deriving(Eq,Ord,Show,Data,Typeable)
+data CallConv = CCall | StdCall | Primitive | DotNet deriving(Eq,Ord,Show,Data,Typeable)
hunk ./C/Prims.hs 27
+data DotNetPrim = DotNetField | DotNetCtor | DotNetMethod
+    deriving(Typeable, Data, Eq, Ord, Show)
+    {-! derive: GhcBinary !-}
+
hunk ./C/Prims.hs 43
+    | PrimDotNet {
+        primStatic :: Bool,
+        primDotNet :: DotNetPrim,
+        primIOLike :: Bool,
+        primAssembly :: PackedString,
+        primDotNetName :: PackedString
+        }
hunk ./C/Prims.hs 130
+    pprint PrimDotNet { primDotNet = dn,  primDotNetName = n} = parens (text (unpackPS n))
hunk ./C/Prims.hs 135
+parseDotNetFFI :: Monad m => String -> m Prim
+parseDotNetFFI s = ans where
+    init = PrimDotNet { primStatic = False, primDotNet = DotNetField, primAssembly = packString "", primDotNetName = packString "" }
+    ans = case words s of
+        ("static":rs) -> f rs init { primStatic = True }
+        rs -> f rs init
+    f ("field":rs) dn = g dn { primDotNet = DotNetField } rs
+    f ("ctor":rs) dn = g dn { primDotNet = DotNetCtor } rs
+    f ("method":rs) dn = g dn { primDotNet = DotNetMethod } rs
+    f _ _ = fail "invalid .NET ffi specification"
+    g dn ['[':rs] | (as,']':nm) <- span (/= ']') rs = return dn { primAssembly = packString as, primDotNetName = packString nm }
+    g dn [n] = return dn { primDotNetName = packString n }
+    g _ _ = fail "invalid .NET ffi specification"
+
+
hunk ./E/FromHs.hs 392
+    cDecl (HsForeignDecl _ (FfiSpec (Import rcn _) _ DotNet) n _) = do
+        (var,ty,lamt) <- convertValue (toName Name.Val n)
+        let (ts,rt) = argTypes' ty
+            (isIO,rt') = case  rt of
+                ELit (LitCons { litName = c, litArgs = [x] }) | c == tc_IO -> (True,x)
+                _ -> (False,rt)
+        es <- newVars [ t |  t <- ts, not (sortKindLike t) ]
+        (_,pt) <- lookupCType dataTable rt'
+        [tvrWorld, tvrWorld2] <- newVars [tWorld__,tWorld__]
+        dnet <- parseDotNetFFI rcn
+        let cFun = createFunc dataTable (map tvrType es)
+            prim rs rtt = EPrim (APrim dnet { primIOLike = isIO } mempty)
+        result <- case (isIO,pt) of
+            (True,"void") -> cFun $ \rs -> (,) (ELam tvrWorld) $
+                        eStrictLet tvrWorld2 (prim rs "void" (EVar tvrWorld:[EVar t | (t,_) <- rs ]) tWorld__) (eJustIO (EVar tvrWorld2) vUnit)
+            (False,"void") -> fail "pure foreign function must return a valid value"
+            _ -> do
+                (cn,rtt',rtt) <- lookupCType' dataTable rt'
+                [rtVar,rtVar'] <- newVars [rt',rtt']
+                let rttIO = ltTuple [tWorld__, rt']
+                    rttIO' = ltTuple' [tWorld__, rtt']
+                case isIO of
+                    False -> cFun $ \rs -> (,) id $ eStrictLet rtVar' (prim rs rtt [ EVar t | (t,_) <- rs ] rtt') (ELit $ litCons { litName = cn, litArgs = [EVar rtVar'], litType = rt' })
+                    True -> cFun $ \rs -> (,) (ELam tvrWorld) $
+                                eCaseTup' (prim rs rtt (EVar tvrWorld:[EVar t | (t,_) <- rs ]) rttIO')  [tvrWorld2,rtVar'] (eLet rtVar (ELit $ litCons { litName = cn, litArgs = [EVar rtVar'], litType = rt' }) (eJustIO (EVar tvrWorld2) (EVar rtVar)))
+        return [(toName Name.Val n,var,lamt result)]
hunk ./E/Traverse.hs 66
-        return $ caseUpdate ECase { eCaseScrutinee =e', eCaseBind = b', eCaseAlts = as', eCaseDefault = d', eCaseType = t'}
+        return $ caseUpdate ec { eCaseScrutinee =e', eCaseBind = b', eCaseAlts = as', eCaseDefault = d', eCaseType = t'}
hunk ./FrontEnd/ParseUtils.hs 379
+            f ["import","dotnet"] cname = return $ HsForeignDecl srcLoc (FfiSpec (Import cname nullRequires) Safe DotNet) vname qt