the compiler now compiles with the new runtime

src/runtime/haskell/PGF2/Expr.hs

@@ -11,7 +11,7 @@ module PGF2.Expr(Var, Cat, Fun,
                  mkFloat,  unFloat,
                  mkMeta,   unMeta,
 
-                 exprSize, exprFunctions,
+                 exprSize, exprFunctions, exprSubstitute,
 
                  mkType, unType,
                  mkHypo, mkDepHypo, mkImplHypo
@@ -169,6 +169,15 @@ exprFunctions (EImplArg e) = exprFunctions e
 exprFunctions (EFun f)     = [f]
 exprFunctions _            = []
 
+exprSubstitute :: Expr -> [Expr] -> Expr
+exprSubstitute (EAbs bt x e) vs = EAbs bt x (exprSubstitute e vs)
+exprSubstitute (EApp e1 e2)  vs = EApp (exprSubstitute e1 vs) (exprSubstitute e2 vs)
+exprSubstitute (EMeta i)     vs = vs !! i
+exprSubstitute (ETyped e ty) vs = ETyped (exprSubstitute e vs) ty
+exprSubstitute (EImplArg e)  vs = EImplArg (exprSubstitute e vs)
+exprSubstitute e             vs = e
+
+
 -- | creates a type from list of hypothesises, category and 
 -- list of arguments for the category. The operation 
 -- @mkType [h_1,...,h_n] C [e_1,...,e_m]@ will create 

src/runtime/haskell/PGF2/FFI.hsc

@@ -18,11 +18,14 @@ import PGF2.Expr
 
 #include <pgf/pgf.h>
 
+type AbsName  = String -- ^ Name of abstract syntax
+type ConcName = String -- ^ Name of concrete syntax
+
 -- | An abstract data type representing multilingual grammar
 -- in Portable Grammar Format.
 data PGF = PGF { a_db     :: ForeignPtr PgfDB
                , revision :: ForeignPtr PgfRevision
-               , langs    :: Map.Map String Concr
+               , languages:: Map.Map ConcName Concr
                }
 data Concr = Concr {c_pgf :: ForeignPtr PgfDB, concr :: Ptr PgfConcr}
 

src/runtime/haskell/PGF2/Internal.hsc

@@ -1,4 +1,93 @@
 {-# LANGUAGE ImplicitParams, RankNTypes #-}
 
 module PGF2.Internal(-- * Access the internal structures
+                     FId,isPredefFId,
+                     fidString,fidInt,fidFloat,fidVar,fidStart,
+
+                     -- * Byte code
+                     CodeLabel, Instr(..), IVal(..), TailInfo(..),
+
+                     SeqId,LIndex,
+                     FunId,Token,Production(..),PArg(..),Symbol(..),
+
+                     unionPGF, writeConcr
                     ) where
+
+import PGF2.FFI
+import PGF2.Expr
+
+type Token  = String
+type LIndex = Int
+data Symbol
+  = SymCat {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex
+  | SymLit {-# UNPACK #-} !Int {-# UNPACK #-} !LIndex
+  | SymVar {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+  | SymKS Token
+  | SymKP [Symbol] [([Symbol],[String])]
+  | SymBIND                         -- the special BIND token
+  | SymNE                           -- non exist
+  | SymSOFT_BIND                    -- the special SOFT_BIND token
+  | SymSOFT_SPACE                   -- the special SOFT_SPACE token
+  | SymCAPIT                        -- the special CAPIT token
+  | SymALL_CAPIT                    -- the special ALL_CAPIT token
+  deriving (Eq,Ord,Show)
+data Production
+  = PApply  {-# UNPACK #-} !FunId [PArg]
+  | PCoerce {-# UNPACK #-} !FId
+  deriving (Eq,Ord,Show)
+type FunId = Int
+type SeqId = Int
+type FId = Int
+data PArg = PArg [FId] {-# UNPACK #-} !FId deriving (Eq,Ord,Show)
+
+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
+  = CHECK_ARGS {-# UNPACK #-} !Int
+  | CASE Fun  {-# UNPACK #-} !CodeLabel
+  | CASE_LIT Literal  {-# UNPACK #-} !CodeLabel
+  | SAVE {-# UNPACK #-} !Int
+  | ALLOC  {-# UNPACK #-} !Int
+  | PUT_CONSTR Fun
+  | PUT_CLOSURE   {-# UNPACK #-} !CodeLabel
+  | PUT_LIT Literal
+  | SET IVal
+  | SET_PAD
+  | PUSH_FRAME
+  | PUSH IVal
+  | TUCK IVal {-# UNPACK #-} !Int
+  | EVAL IVal TailInfo
+  | DROP {-# UNPACK #-} !Int
+  | JUMP {-# UNPACK #-} !CodeLabel
+  | FAIL
+  | PUSH_ACCUM Literal
+  | POP_ACCUM
+  | ADD
+
+data IVal
+  = HEAP     {-# UNPACK #-} !Int
+  | ARG_VAR  {-# UNPACK #-} !Int
+  | FREE_VAR {-# UNPACK #-} !Int
+  | GLOBAL   Fun
+  deriving Eq
+
+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/Transactions.hsc

@@ -91,7 +91,7 @@ branchPGF_ c_name p (Transaction f) =
                         ex_type <- (#peek PgfExn, type) c_exn
                         if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE)
                           then do fptr2 <- C.newForeignPtr c_revision (withForeignPtr (a_db p) (\c_db -> pgf_free_revision c_db c_revision))
-                                  return (PGF (a_db p) fptr2 (langs p))
+                                  return (PGF (a_db p) fptr2 (languages p))
                           else do pgf_free_revision c_db c_revision
                                   return p
                 else do pgf_free_revision c_db c_revision
@@ -107,7 +107,7 @@ checkoutPGF p name =
     if c_revision == nullPtr
       then return Nothing
       else do fptr2 <- C.newForeignPtr c_revision (withForeignPtr (a_db p) (\c_db -> pgf_free_revision c_db c_revision))
-              return (Just (PGF (a_db p) fptr2 (langs p)))
+              return (Just (PGF (a_db p) fptr2 (languages p)))
 
 createFunction :: Fun -> Type -> Float -> Transaction ()
 createFunction name ty prob = Transaction $ \c_db c_revision c_exn ->