a partial support for def rules in the C runtime

The def rules are now compiled to byte code by the compiler and then to native code by the JIT compiler in the runtime. Not all constructions are implemented yet. The partial implementation is now in the repository but it is not activated by default since this requires changes in the PGF format. I will enable it only after it is complete.
2014-08-11 10:59:10 +00:00
parent 1ce3569c82
commit 03b067782c
37 changed files with 707 additions and 455 deletions
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -1137,7 +1137,7 @@ allCommands = Map.fromList [
       case arg of
         [EFun id] -> case Map.lookup id (funs (abstract pgf)) of
                        Just fd -> do putStrLn $ render (ppFun id fd)
-                                      let (_,_,_,prob,_) = fd
+                                      let (_,_,_,prob) = fd
                                      putStrLn ("Probability: "++show prob)
                                      return void
                        Nothing -> case Map.lookup id (cats (abstract pgf)) of
@@ -1146,9 +1146,9 @@ allCommands = Map.fromList [
                                                                if null (functionsToCat pgf id)
                                                                  then empty
                                                                  else ' ' $$
-                                                                       vcat [ppFun fid (ty,0,Just [],0,0) | (fid,ty) <- functionsToCat pgf id] $$
+                                                                       vcat [ppFun fid (ty,0,Just ([],[]),0) | (fid,ty) <- functionsToCat pgf id] $$
                                                                       ' ')
-                                                     let (_,_,prob,_) = cd
+                                                     let (_,_,prob) = cd
                                                     putStrLn ("Probability: "++show prob)
                                                     return void
                                     Nothing   -> do putStrLn ("unknown category of function identifier "++show id)
@@ -1322,7 +1322,7 @@ allCommands = Map.fromList [
     | otherwise             = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
                                  return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf

-   funsigs pgf = [(f,ty) | (f,(ty,_,_,_,_)) <- Map.assocs (funs (abstract pgf))]
+   funsigs pgf = [(f,ty) | (f,(ty,_,_,_)) <- Map.assocs (funs (abstract pgf))]
   showFun (f,ty) = showCId f ++ " : " ++ showType [] ty ++ " ;"

   morphos (pgf,mos) opts s =
--- a/src/compiler/GF/Compile/CFGtoPGF.hs
+++ b/src/compiler/GF/Compile/CFGtoPGF.hs
@@ -9,7 +9,6 @@ import PGF.Internal
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
-import qualified Data.ByteString as BS
 import Data.Array.IArray
 import Data.List

@@ -27,13 +26,13 @@ cf2pgf fpath cf =
   cname = mkCId name

 cf2abstr :: CFG -> Abstr
-cf2abstr cfg = Abstr aflags afuns acats BS.empty
+cf2abstr cfg = Abstr aflags afuns acats
  where
    aflags = Map.singleton (mkCId "startcat") (LStr (cfgStartCat cfg))
    acats = Map.fromList [(mkCId cat, ([], [(0,mkRuleName rule) 
-                                              | rule <- Set.toList rules], 0, 0)) 
+                                              | rule <- Set.toList rules], 0))
                            | (cat,rules) <- Map.toList (cfgRules cfg)]
-    afuns = Map.fromList [(mkRuleName rule, (cftype [mkCId c | NonTerminal c <- ruleRhs rule] (mkCId cat), 0, Nothing, 0, 0))
+    afuns = Map.fromList [(mkRuleName rule, (cftype [mkCId c | NonTerminal c <- ruleRhs rule] (mkCId cat), 0, Nothing, 0))
                            | (cat,rules) <- Map.toList (cfgRules cfg)
                            , rule <- Set.toList rules]

--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -1,78 +1,79 @@
 module GF.Compile.GenerateBC(generateByteCode) where

 import GF.Grammar
-import GF.Compile.Instructions
-import PGF.Internal(Binary(..),encode,BCAddr)
+import PGF(CId,utf8CId)
+import PGF.Internal(Instr(..))
+import qualified Data.Map as Map

-import Data.Maybe
-import qualified Data.IntMap as IntMap
-import qualified Data.ByteString as BSS
-import qualified Data.ByteString.Lazy as BS
-import PGF.Internal()
+generateByteCode :: Int -> [L Equation] -> [Instr]
+generateByteCode arity eqs =
+  compileEquations arity is (map (\(L _ (ps,t)) -> ([],ps,t)) eqs)
+  where
+    is = push_is (arity-1) arity []

-generateByteCode :: [(QIdent,Info)] -> ([(QIdent,Info,BCAddr)], BSS.ByteString)
-generateByteCode = runGenM . mapM genFun
+compileEquations :: Int -> [Int] -> [([(Ident,Int)],[Patt],Term)] -> [Instr]
+compileEquations st _  []            = [FAIL]
+compileEquations st [] ((vs,[],t):_) =
+  let (heap,instrs) = compileBody st vs t 0 []
+  in (if heap > 0 then (ALLOC heap :) else id)
+     (instrs ++ [RET st])
+compileEquations st (i:is) eqs       = whilePP eqs Map.empty
+  where
+    whilePP []                           cns     = mkCase cns []
+    whilePP ((vs, PP c ps' : ps, t):eqs) cns     = whilePP eqs (Map.insertWith (++) (Q c,length ps') [(vs,ps'++ps,t)] cns)
+    whilePP ((vs, PInt n   : ps, t):eqs) cns     = whilePP eqs (Map.insertWith (++) (EInt n,0) [(vs,ps,t)] cns)
+    whilePP ((vs, PString s: ps, t):eqs) cns     = whilePP eqs (Map.insertWith (++) (K s,0) [(vs,ps,t)] cns)
+    whilePP ((vs, PFloat d : ps, t):eqs) cns     = whilePP eqs (Map.insertWith (++) (EFloat d,0) [(vs,ps,t)] cns)
+    whilePP eqs                          cns     = whilePV eqs cns []

-type BCLabel = (Int, BCAddr)
+    whilePV []                           cns vrs = mkCase cns (reverse vrs)
+    whilePV ((vs, PV x     : ps, t):eqs) cns vrs = whilePV eqs cns (((x,i):vs,ps,t) : vrs)
+    whilePV ((vs, PW       : ps, t):eqs) cns vrs = whilePV eqs cns ((      vs,ps,t) : vrs)
+    whilePV eqs                          cns vrs = mkCase cns (reverse vrs) ++ compileEquations st (i:is) eqs

-genFun (id,info@(AbsFun (Just (L _ ty)) ma pty _)) = do
-  l1 <- newLabel
-{-  emitLabel l1
-  emit Ins_fail
-  l2 <- newLabel
-  l3 <- newLabel
-  emit (Ins_switch_on_reg (1,addr l2,addr l3))
-  emitLabel l2
-  emit (Ins_try (1,addr l3))
-  emit (Ins_trust_ext (1,1))
-  emit (Ins_try_me_else (0,addr l1))
-  emitLabel l3
-  l4 <- newLabel
-  l5 <- newLabel
-  emit (Ins_switch_on_term (addr l4,addr l5,addr l1,addr l4))
-  emitLabel l4
-  emitLabel l5-}
-  return (id,info,addr l1)
-genFun (id,info@(AbsCat (Just (L _ cont)))) = do
-  l1 <- newLabel
-  return (id,info,addr l1)
-genFun (id,info) = do
-  l1 <- newLabel
-  return (id,info,addr l1)
+    mkCase cns vrs
+      | Map.null cns = compileEquations st is vrs
+      | otherwise    = EVAL (st-i-1) :
+                       concat [compileBranch t n eqs | ((t,n),eqs) <- Map.toList cns] ++
+                       compileEquations st is vrs

-newtype GenM a = GenM {unGenM :: IntMap.IntMap BCAddr ->
-                                 IntMap.IntMap BCAddr ->
-                                 [Instruction] -> 
-                                 (a,IntMap.IntMap BCAddr,[Instruction])}
+    compileBranch t n eqs =
+      let case_instr = 
+            case t of
+              (Q (_,id)) -> CASE (i2i id)
+              (EInt n)   -> CASE_INT n
+              (K s)      -> CASE_STR s
+              (EFloat d) -> CASE_FLT d
+          instrs = compileEquations (st+n) (push_is st n is) eqs
+      in case_instr (length instrs) : instrs
+        

-instance Monad GenM where
-  return x = GenM (\fm cm is -> (x,cm,is))
-  f >>= g  = GenM (\fm cm is -> case unGenM f fm cm is of
-                                  (x,cm,is) -> unGenM (g x) fm cm is)
+compileBody st vs (App e1 e2) h0 os =
+  case e2 of
+    Vr x -> case lookup x vs of
+              Just i  -> compileBody st vs e1 h0 (SET_VARIABLE (st-i-1):os)
+              Nothing -> error "compileBody: unknown variable"
+    e2   -> let (h1,is1) = compileBody st vs e1 h0 (SET_VALUE h1:os)
+                (h2,is2) = compileBody st vs e2 h1 []
+            in (h2,is1 ++ is2)
+compileBody st vs (QC (_,id)) h0 os = let h1 = h0 + 2 + length os
+                                      in (h1,PUT_CONSTR (i2i id) : os)
+compileBody st vs (Q  (_,id)) h0 os = let h1 = h0 + 2 + length os
+                                      in (h1,PUT_CONSTR (i2i id) : os)
+compileBody st vs (Vr x)      h0 os = case lookup x vs of
+                                        Just i  -> (h0,EVAL (st-i-1) : os)
+                                        Nothing -> error "compileBody: unknown variable"
+compileBody st vs (EInt n)    h0 os = let h1 = h0 + 2
+                                      in (h1,PUT_INT n : os)
+compileBody st vs (K s)       h0 os = let h1 = h0 + 1 + (length s + 4) `div` 4
+                                      in (h1,PUT_STR s : os)
+compileBody st vs (EFloat d)  h0 os = let h1 = h0 + 3
+                                      in (h1,PUT_FLT d : os)
+compileBody st vs t           _  _  = error (show t)

-runGenM :: GenM a -> (a, BSS.ByteString)
-runGenM f = 
-  let (x, cm, is) = unGenM f cm IntMap.empty []
-  in (x, BSS.concat (BS.toChunks (encode (BC (reverse is)))))
+i2i :: Ident -> CId
+i2i = utf8CId . ident2utf8

-emit :: Instruction -> GenM ()
-emit i = GenM (\fm cm is -> ((), cm, i:is))
-
-newLabel :: GenM BCLabel
-newLabel = GenM (\fm cm is -> 
-  let lbl  = IntMap.size cm
-      addr = fromMaybe (error "newLabel") (IntMap.lookup lbl fm)
-  in ((lbl,addr), IntMap.insert lbl 0 cm, is))
-
-emitLabel :: BCLabel -> GenM ()
-emitLabel (lbl,addr) = GenM (\fm cm is ->
-  ((), IntMap.insert lbl (length is) cm, is))
-
-addr :: BCLabel -> BCAddr
-addr (lbl,addr) = addr
-
-data ByteCode = BC [Instruction]
-
-instance Binary ByteCode where
-  put (BC is) = mapM_ putInstruction is
-  get = error "get ByteCode"
+push_is :: Int -> Int -> [Int] -> [Int]
+push_is i 0 is = is
+push_is i n is = i : push_is (i-1) (n-1) is
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -25,13 +25,10 @@ import GF.Infra.UseIO (IOE)
 import GF.Data.Operations

 import Data.List
--import Data.Char (isDigit,isSpace)
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 import Data.Array.IArray
--import GF.Text.Pretty
--import Control.Monad.Identity

 mkCanon2pgf :: Options -> SourceGrammar -> Ident -> IOE D.PGF
 mkCanon2pgf opts gr am = do
@@ -41,25 +38,25 @@ mkCanon2pgf opts gr am = do
  where
    cenv = resourceValues gr

-    mkAbstr am = return (i2i am, D.Abstr flags funs cats bcode)
+    mkAbstr am = return (i2i am, D.Abstr flags funs cats)
      where
        aflags = err (const noOptions) mflags (lookupModule gr am)

-        (adefs,bcode) =
-          generateByteCode $
+        adefs =
            [((cPredefAbs,c), AbsCat (Just (L NoLoc []))) | c <- [cFloat,cInt,cString]] ++ 
            Look.allOrigInfos gr am

        flags = Map.fromList [(mkCId f,x) | (f,x) <- optionsPGF aflags]

-        funs = Map.fromList [(i2i f, (mkType [] ty, mkArrity ma, mkDef pty, 0, addr)) | 
-                                   ((m,f),AbsFun (Just (L _ ty)) ma pty _,addr) <- adefs]
+        funs = Map.fromList [(i2i f, (mkType [] ty, arity, mkDef arity mdef, 0)) | 
+                                   ((m,f),AbsFun (Just (L _ ty)) ma mdef _) <- adefs,
+                                   let arity = mkArrity ma]
                                   
-        cats = Map.fromList [(i2i c, (snd (mkContext [] cont),catfuns c, 0, addr)) |
-                                   ((m,c),AbsCat (Just (L _ cont)),addr) <- adefs]
+        cats = Map.fromList [(i2i c, (snd (mkContext [] cont),catfuns c, 0)) |
+                                   ((m,c),AbsCat (Just (L _ cont))) <- adefs]

        catfuns cat =
-              [(0,i2i f) | ((m,f),AbsFun (Just (L _ ty)) _ _ (Just True),_) <- adefs, snd (GM.valCat ty) == cat]
+              [(0,i2i f) | ((m,f),AbsFun (Just (L _ ty)) _ _ (Just True)) <- adefs, snd (GM.valCat ty) == cat]

    mkConcr cm = do
      let cflags  = err (const noOptions) mflags (lookupModule gr cm)
@@ -148,30 +145,14 @@ mkContext scope hyps = mapAccumL (\scope (bt,x,ty) -> let ty' = mkType scope ty
                                                           then (  scope,(bt,i2i x,ty'))
                                                           else (x:scope,(bt,i2i x,ty'))) scope hyps 

-mkDef (Just eqs) = Just [C.Equ ps' (mkExp scope' e) | L _ (ps,e) <- eqs, let (scope',ps') = mapAccumL mkPatt [] ps]
-mkDef Nothing    = Nothing
+mkDef arity (Just eqs) = Just ([C.Equ ps' (mkExp scope' e) | L _ (ps,e) <- eqs, let (scope',ps') = mapAccumL mkPatt [] ps]
+                              ,generateByteCode arity eqs
+                              )
+mkDef arity Nothing    = Nothing

 mkArrity (Just a) = a
 mkArrity Nothing  = 0

-data PattTree
-  = Ret  C.Expr
-  | Case (Map.Map QIdent [PattTree]) [PattTree]
-
-compilePatt :: [Equation] -> [PattTree]
-compilePatt (([],t):_) = [Ret (mkExp [] t)]
-compilePatt eqs        = whilePP eqs Map.empty
-  where
-    whilePP []                         cns     = [mkCase cns []]
-    whilePP (((PP c ps' : ps), t):eqs) cns     = whilePP eqs (Map.insertWith (++) c [(ps'++ps,t)] cns)
-    whilePP eqs                        cns     = whilePV eqs cns []
-
-    whilePV []                         cns vrs = [mkCase cns (reverse vrs)]
-    whilePV (((PV x     : ps), t):eqs) cns vrs = whilePV eqs cns ((ps,t) : vrs)
-    whilePV eqs                        cns vrs = mkCase cns (reverse vrs) : compilePatt eqs
-
-    mkCase cns vrs = Case (fmap compilePatt cns) (compilePatt vrs)
-

 genCncCats gr am cm cdefs =
  let (index,cats) = mkCncCats 0 cdefs
--- a/src/compiler/GF/Compile/PGFtoHaskell.hs
+++ b/src/compiler/GF/Compile/PGFtoHaskell.hs
@@ -272,7 +272,7 @@ hSkeleton gr =
   fns = groupBy valtypg (sortBy valtyps (map jty (Map.assocs (funs (abstract gr)))))
   valtyps (_, (_,x)) (_, (_,y)) = compare x y
   valtypg (_, (_,x)) (_, (_,y)) = x == y
-   jty (f,(ty,_,_,_,_)) = (f,catSkeleton ty)
+   jty (f,(ty,_,_,_)) = (f,catSkeleton ty)

 updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton
 updateSkeleton cat skel rule =
--- a/src/compiler/GF/Compile/PGFtoJS.hs
+++ b/src/compiler/GF/Compile/PGFtoJS.hs
@@ -1,6 +1,6 @@
 module GF.Compile.PGFtoJS (pgf2js) where

-import PGF(CId,showCId)
+import PGF(showCId)
 import PGF.Internal as M
 import qualified GF.JavaScript.AbsJS as JS
 import qualified GF.JavaScript.PrintJS as JS
@@ -32,8 +32,8 @@ pgf2js pgf =
 abstract2js :: String -> Abstr -> JS.Expr
 abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]

-absdef2js :: (CId,(Type,Int,Maybe [Equation],Double,BCAddr)) -> JS.Property
-absdef2js (f,(typ,_,_,_,_)) =
+absdef2js :: (CId,(Type,Int,Maybe ([Equation],[M.Instr]),Double)) -> JS.Property
+absdef2js (f,(typ,_,_,_)) =
  let (args,cat) = M.catSkeleton typ in 
    JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)])

--- a/src/compiler/GF/Compile/PGFtoLProlog.hs
+++ b/src/compiler/GF/Compile/PGFtoLProlog.hs
@@ -12,25 +12,25 @@ import qualified Data.Map as Map
 grammar2lambdaprolog_mod pgf = render $
  "module" <+> ppCId (absname pgf) <> '.' $$
  ' ' $$
-  vcat [ppClauses cat fns | (cat,(_,fs,_,_)) <- Map.toList (cats (abstract pgf)),
+  vcat [ppClauses cat fns | (cat,(_,fs,_)) <- Map.toList (cats (abstract pgf)),
                            let fns = [(f,fromJust (Map.lookup f (funs (abstract pgf)))) | (_,f) <- fs]]
  where
    ppClauses cat fns =
      "/*" <+> ppCId cat <+> "*/" $$
-      vcat [snd (ppClause (abstract pgf) 0 1 [] f ty) <> dot | (f,(ty,_,Nothing,_,_)) <- fns] $$
+      vcat [snd (ppClause (abstract pgf) 0 1 [] f ty) <> dot | (f,(ty,_,Nothing,_)) <- fns] $$
      ' ' $$
-      vcat [vcat (map (\eq -> equation2clause (abstract pgf) f eq <> dot) eqs) | (f,(_,_,Just eqs,_,_)) <- fns] $$
+      vcat [vcat (map (\eq -> equation2clause (abstract pgf) f eq <> dot) eqs) | (f,(_,_,Just (eqs,_),_)) <- fns] $$
      ' '

 grammar2lambdaprolog_sig pgf = render $
  "sig" <+> ppCId (absname pgf) <> '.' $$
  ' ' $$
-  vcat [ppCat c hyps <> dot | (c,(hyps,_,_,_)) <- Map.toList (cats (abstract pgf))] $$
+  vcat [ppCat c hyps <> dot | (c,(hyps,_,_)) <- Map.toList (cats (abstract pgf))] $$
  ' ' $$
-  vcat [ppFun f ty <> dot | (f,(ty,_,Nothing,_,_)) <- Map.toList (funs (abstract pgf))] $$
+  vcat [ppFun f ty <> dot | (f,(ty,_,Nothing,_)) <- Map.toList (funs (abstract pgf))] $$
  ' ' $$
-  vcat [ppExport c hyps <> dot | (c,(hyps,_,_,_)) <- Map.toList (cats (abstract pgf))] $$
-  vcat [ppFunPred f (hyps ++ [(Explicit,wildCId,DTyp [] c es)]) <> dot | (f,(DTyp hyps c es,_,Just _,_,_)) <- Map.toList (funs (abstract pgf))]
+  vcat [ppExport c hyps <> dot | (c,(hyps,_,_)) <- Map.toList (cats (abstract pgf))] $$
+  vcat [ppFunPred f (hyps ++ [(Explicit,wildCId,DTyp [] c es)]) <> dot | (f,(DTyp hyps c es,_,Just _,_)) <- Map.toList (funs (abstract pgf))]

 ppCat :: CId -> [Hypo] -> Doc
 ppCat c hyps = "kind" <+> ppKind c <+> "type"
@@ -157,8 +157,8 @@ expr2goal abstr scope goals i (EApp e1 e2) args =
  in expr2goal abstr scope goals' i' e1 (e2':args)
 expr2goal abstr scope goals i (EFun f)     args =
  case Map.lookup f (funs abstr) of
-    Just (_,_,Just _,_,_) -> let e = EFun (mkVar i)
-                             in (foldl EApp (EFun f) (args++[e]) : goals, i+1, e)
-    _                     -> (goals,i,foldl EApp (EFun f) args)
+    Just (_,_,Just _,_) -> let e = EFun (mkVar i)
+                           in (foldl EApp (EFun f) (args++[e]) : goals, i+1, e)
+    _                   -> (goals,i,foldl EApp (EFun f) args)
 expr2goal abstr scope goals i (EVar j)     args =
  (goals,i,foldl EApp (EVar j) args)
--- a/src/compiler/GF/Compile/PGFtoProlog.hs
+++ b/src/compiler/GF/Compile/PGFtoProlog.hs
@@ -49,16 +49,16 @@ plAbstract name abs
                    (f, v) <- Map.assocs (aflags abs)] ++++
       plFacts name "cat" 2 "(?Type, ?[X:Type,...])"
                   [[plType cat args, plHypos hypos'] |
-                    (cat, (hypos,_,_,_)) <- Map.assocs (cats abs),
+                    (cat, (hypos,_,_)) <- Map.assocs (cats abs),
                    let ((_, subst), hypos') = mapAccumL alphaConvertHypo emptyEnv hypos,
                        let args = reverse [EFun x | (_,x) <- subst]] ++++
       plFacts name "fun" 3 "(?Fun, ?Type, ?[X:Type,...])"
                   [[plp fun, plType cat args, plHypos hypos] |
-                    (fun, (typ, _, _, _, _)) <- Map.assocs (funs abs),
+                    (fun, (typ, _, _, _)) <- Map.assocs (funs abs),
                    let (_, DTyp hypos cat args) = alphaConvert emptyEnv typ] ++++
       plFacts name "def" 2 "(?Fun, ?Expr)" 
                   [[plp fun, plp expr] |
-                    (fun, (_, _, Just eqs, _, _)) <- Map.assocs (funs abs),
+                    (fun, (_, _, Just (eqs,_), _)) <- Map.assocs (funs abs),
                    let (_, expr) = alphaConvert emptyEnv eqs]
      )
    where plType cat args = plTerm (plp cat) (map plp args)
--- a/src/compiler/GF/Compile/PGFtoPython.hs
+++ b/src/compiler/GF/Compile/PGFtoPython.hs
@@ -39,8 +39,8 @@ pgf2python pgf = ("# -*- coding: utf-8 -*-" ++++
      abs = abstract pgf
      cncs = concretes pgf

-pyAbsdef :: (Type, Int, Maybe [Equation], Double, BCAddr) -> String
-pyAbsdef (typ, _, _, _, _) = pyTuple 0 id [pyCId cat, pyList 0 pyCId args]
+pyAbsdef :: (Type, Int, Maybe ([Equation], [M.Instr]), Double) -> String
+pyAbsdef (typ, _, _, _) = pyTuple 0 id [pyCId cat, pyList 0 pyCId args]
    where (args, cat) = M.catSkeleton typ 

 pyLiteral :: Literal -> String
--- a/src/compiler/GF/Speech/VoiceXML.hs
+++ b/src/compiler/GF/Speech/VoiceXML.hs
@@ -38,7 +38,7 @@ type Skeleton = [(CId, [(CId, [CId])])]

 pgfSkeleton :: PGF -> Skeleton
 pgfSkeleton pgf = [(c,[(f,fst (catSkeleton (lookType (abstract pgf) f))) | (_,f) <- fs]) 
-                   | (c,(_,fs,_,_)) <- Map.toList (cats (abstract pgf))]
+                   | (c,(_,fs,_)) <- Map.toList (cats (abstract pgf))]

 --
 -- * Questions to ask 
--- a/src/compiler/GF/Text/Coding.hs
+++ b/src/compiler/GF/Text/Coding.hs
@@ -23,7 +23,7 @@ encodeUnicode enc s =
  where
    translate cod cbuf
      | i < w     = do bbuf <- newByteBuffer 128 WriteBuffer
-                       (_,cbuf,bbuf) <- cod cbuf bbuf
+                       (cbuf,bbuf) <- cod cbuf bbuf
                       if isEmptyBuffer bbuf
                         then ioe_invalidCharacter1
                         else do let bs = PS (bufRaw bbuf) (bufL bbuf) (bufR bbuf-bufL bbuf)
@@ -48,7 +48,7 @@ decodeUnicodeIO enc (PS fptr l len) = do
  where
    translate cod bbuf cbuf
      | i < w     = do
-                       (_,bbuf,cbuf) <- cod bbuf cbuf
+                       (bbuf,cbuf) <- cod bbuf cbuf
                       if isEmptyBuffer cbuf
                         then ioe_invalidCharacter2
                         else unpack cod bbuf cbuf
--- a/src/compiler/GFC.hs
+++ b/src/compiler/GFC.hs
@@ -2,8 +2,8 @@ module GFC (mainGFC, writePGF) where
 -- module Main where

 import PGF
-import PGF.Internal(PGF,abstract,concretes,code,funs,cats,optimizePGF,unionPGF)
-import PGF.Internal(putSplitAbs)
+import PGF.Internal(PGF,concretes,optimizePGF,unionPGF)
+import PGF.Internal(putSplitAbs,encodeFile,runPut)
 import GF.Compile
 import GF.Compile.Export
 import GF.Compile.CFGtoPGF
@@ -17,13 +17,10 @@ import GF.Data.ErrM
 import GF.System.Directory

 import Data.Maybe
-import PGF.Internal(encode,encodeFile,runPut)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import qualified Data.ByteString as BSS
 import qualified Data.ByteString.Lazy as BSL
 import System.FilePath
-import System.IO
 import Control.Monad(unless,forM_)

 mainGFC :: Options -> [FilePath] -> IO ()
@@ -55,7 +52,6 @@ compileSourceFiles opts fs =
                   then putIfVerb opts $ pgfFile ++ " is up-to-date."
                   else do pgf <- link opts cnc_gr
                           writePGF opts pgf
-                           writeByteCode opts pgf
                           writeOutputs opts pgf

 compileCFFiles :: Options -> [FilePath] -> IOE ()
@@ -105,20 +101,6 @@ writeOutputs opts pgf = do
                 | fmt <- outputFormats opts,
                   (name,str) <- exportPGF opts fmt pgf]

-writeByteCode :: Options -> PGF -> IOE ()
-writeByteCode opts pgf
-  | elem FmtByteCode (flag optOutputFormats opts) =
-             let path = outputPath opts (grammarName opts pgf <.> "bc")
-             in writing opts path $
-                  withBinaryFile path WriteMode
-                      (\h -> do BSL.hPut h (encode addrs)
-                                BSS.hPut h (code (abstract pgf)))
-  | otherwise = return ()
-  where
-    addrs = 
-      [(id,addr) | (id,(_,_,_,_,addr)) <- Map.toList (funs (abstract pgf))] ++
-      [(id,addr) | (id,(_,_,_,addr))   <- Map.toList (cats (abstract pgf))]
-
 writePGF :: Options -> PGF -> IOE ()
 writePGF opts pgf =
    if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF