correctly distinguish between fun and data judgements

src/runtime/haskell/PGF2/ByteCode.hs

@@ -1,30 +1,9 @@
-{-# LANGUAGE ImplicitParams, RankNTypes #-}
-
-module PGF2.Internal(-- * Access the internal structures
-                     FId,isPredefFId,
-                     fidString,fidInt,fidFloat,fidVar,fidStart,
-
-                     -- * Byte code
+module PGF2.ByteCode(-- * Byte code
                      CodeLabel, Instr(..), IVal(..), TailInfo(..),
-
-                     unionPGF, writeConcr
                     ) where
 
-import PGF2.FFI
 import PGF2.Expr
 
-type FId = Int
-
-fidString, fidInt, fidFloat, fidVar, fidStart :: FId
-fidString = (-1)
-fidInt    = (-2)
-fidFloat  = (-3)
-fidVar    = (-4)
-fidStart  = (-5)
-
-isPredefFId :: FId -> Bool
-isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])
-
 type CodeLabel = Int
 
 data Instr
@@ -60,9 +39,3 @@ data TailInfo
   = RecCall
   | TailCall {-# UNPACK #-} !Int
   | UpdateCall
-
-unionPGF :: PGF -> PGF -> Maybe PGF
-unionPGF = error "TODO: unionPGF"
-
-writeConcr :: FilePath -> Concr -> IO ()
-writeConcr = error "TODO: writeConcr"

src/runtime/haskell/PGF2/FFI.hsc

@@ -151,7 +151,7 @@ foreign import ccall pgf_commit_revision :: Ptr PgfDB -> Ptr PGF -> Ptr PgfExn -
 
 foreign import ccall pgf_checkout_revision :: Ptr PgfDB -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr PGF)
 
-foreign import ccall pgf_create_function :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> StablePtr Type -> CSize -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
+foreign import ccall pgf_create_function :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> StablePtr Type -> CSize -> Ptr CChar -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
 
 foreign import ccall pgf_drop_function :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr PgfExn -> IO ()
 

src/runtime/haskell/PGF2/Transactions.hsc

@@ -28,6 +28,7 @@ module PGF2.Transactions
 
 import PGF2.FFI
 import PGF2.Expr
+import PGF2.ByteCode
 
 import Foreign
 import Foreign.C
@@ -123,12 +124,13 @@ checkoutPGF p name =
               langs <- getConcretes (a_db p) fptr
               return (Just (PGF (a_db p) fptr langs))
 
-createFunction :: Fun -> Type -> Int -> Float -> Transaction PGF ()
-createFunction name ty arity prob = Transaction $ \c_db _ c_revision c_exn ->
+createFunction :: Fun -> Type -> Int -> [[Instr]] -> Float -> Transaction PGF ()
+createFunction name ty arity bytecode prob = Transaction $ \c_db _ c_revision c_exn ->
   withText name $ \c_name ->
   bracket (newStablePtr ty) freeStablePtr $ \c_ty ->
+  (if null bytecode then (\f -> f nullPtr) else (allocaBytes 0)) $ \c_bytecode ->
   withForeignPtr marshaller $ \m -> do
-    pgf_create_function c_db c_revision c_name c_ty (fromIntegral arity) prob m c_exn
+    pgf_create_function c_db c_revision c_name c_ty (fromIntegral arity) c_bytecode prob m c_exn
 
 dropFunction :: Fun -> Transaction PGF ()
 dropFunction name = Transaction $ \c_db _ c_revision c_exn ->