From f85232947e74ee7ef8c7b0ad2338212e7e68f1be Mon Sep 17 00:00:00 2001 From: krasimir Date: Sun, 13 Dec 2009 18:50:29 +0000 Subject: reorganize the directories under src, and rescue the JavaScript interpreter from deprecated --- src/PGF/Binary.hs | 199 ------------------------------------------------------ 1 file changed, 199 deletions(-) delete mode 100644 src/PGF/Binary.hs (limited to 'src/PGF/Binary.hs') diff --git a/src/PGF/Binary.hs b/src/PGF/Binary.hs deleted file mode 100644 index e4ed98424..000000000 --- a/src/PGF/Binary.hs +++ /dev/null @@ -1,199 +0,0 @@ -module PGF.Binary where - -import PGF.CId -import PGF.Data -import Data.Binary -import Data.Binary.Put -import Data.Binary.Get -import qualified Data.ByteString as BS -import qualified Data.Map as Map -import qualified Data.IntMap as IntMap -import qualified Data.Set as Set -import Control.Monad - -pgfMajorVersion, pgfMinorVersion :: Word16 -(pgfMajorVersion, pgfMinorVersion) = (1,0) - -instance Binary PGF where - put pgf = putWord16be pgfMajorVersion >> - putWord16be pgfMinorVersion >> - put ( absname pgf, cncnames pgf - , gflags pgf - , abstract pgf, concretes pgf - ) - get = do v1 <- getWord16be - v2 <- getWord16be - absname <- get - cncnames <- get - gflags <- get - abstract <- get - concretes <- get - return (PGF{ absname=absname, cncnames=cncnames - , gflags=gflags - , abstract=abstract, concretes=concretes - }) - -instance Binary CId where - put (CId bs) = put bs - get = liftM CId get - -instance Binary Abstr where - put abs = put (aflags abs, funs abs, cats abs) - get = do aflags <- get - funs <- get - cats <- get - let catfuns = Map.mapWithKey (\cat _ -> [f | (f, (DTyp _ c _,_,_)) <- Map.toList funs, c==cat]) cats - return (Abstr{ aflags=aflags - , funs=funs, cats=cats - , catfuns=catfuns - }) - -instance Binary Concr where - put cnc = put ( cflags cnc, lins cnc, opers cnc - , lincats cnc, lindefs cnc - , printnames cnc, paramlincats cnc - , parser cnc - ) - get = do cflags <- get - lins <- get - opers <- get - lincats <- get - lindefs <- get - printnames <- get - paramlincats <- get - parser <- get - return (Concr{ cflags=cflags, lins=lins, opers=opers - , lincats=lincats, lindefs=lindefs - , printnames=printnames - , paramlincats=paramlincats - , parser=parser - }) - -instance Binary Alternative where - put (Alt v x) = put v >> put x - get = liftM2 Alt get get - -instance Binary Term where - put (R es) = putWord8 0 >> put es - put (S es) = putWord8 1 >> put es - put (FV es) = putWord8 2 >> put es - put (P e v) = putWord8 3 >> put (e,v) - put (W e v) = putWord8 4 >> put (e,v) - put (C i ) = putWord8 5 >> put i - put (TM i ) = putWord8 6 >> put i - put (F f) = putWord8 7 >> put f - put (V i) = putWord8 8 >> put i - put (K (KS s)) = putWord8 9 >> put s - put (K (KP d vs)) = putWord8 10 >> put (d,vs) - - get = do tag <- getWord8 - case tag of - 0 -> liftM R get - 1 -> liftM S get - 2 -> liftM FV get - 3 -> liftM2 P get get - 4 -> liftM2 W get get - 5 -> liftM C get - 6 -> liftM TM get - 7 -> liftM F get - 8 -> liftM V get - 9 -> liftM (K . KS) get - 10 -> liftM2 (\d vs -> K (KP d vs)) get get - _ -> decodingError - -instance Binary Expr where - put (EAbs b x exp) = putWord8 0 >> put (b,x,exp) - put (EApp e1 e2) = putWord8 1 >> put (e1,e2) - put (ELit (LStr s)) = putWord8 2 >> put s - put (ELit (LFlt d)) = putWord8 3 >> put d - put (ELit (LInt i)) = putWord8 4 >> put i - put (EMeta i) = putWord8 5 >> put i - put (EFun f) = putWord8 6 >> put f - put (EVar i) = putWord8 7 >> put i - put (ETyped e ty) = putWord8 8 >> put (e,ty) - get = do tag <- getWord8 - case tag of - 0 -> liftM3 EAbs get get get - 1 -> liftM2 EApp get get - 2 -> liftM (ELit . LStr) get - 3 -> liftM (ELit . LFlt) get - 4 -> liftM (ELit . LInt) get - 5 -> liftM EMeta get - 6 -> liftM EFun get - 7 -> liftM EVar get - 8 -> liftM2 ETyped get get - _ -> decodingError - -instance Binary Patt where - put (PApp f ps) = putWord8 0 >> put (f,ps) - put (PVar x) = putWord8 1 >> put x - put PWild = putWord8 2 - put (PLit (LStr s)) = putWord8 3 >> put s - put (PLit (LFlt d)) = putWord8 4 >> put d - put (PLit (LInt i)) = putWord8 5 >> put i - get = do tag <- getWord8 - case tag of - 0 -> liftM2 PApp get get - 1 -> liftM PVar get - 2 -> return PWild - 3 -> liftM (PLit . LStr) get - 4 -> liftM (PLit . LFlt) get - 5 -> liftM (PLit . LInt) get - _ -> decodingError - -instance Binary Equation where - put (Equ ps e) = put (ps,e) - get = liftM2 Equ get get - -instance Binary Type where - put (DTyp hypos cat exps) = put (hypos,cat,exps) - get = liftM3 DTyp get get get - -instance Binary BindType where - put Explicit = putWord8 0 - put Implicit = putWord8 1 - get = do tag <- getWord8 - case tag of - 0 -> return Explicit - 1 -> return Implicit - _ -> decodingError - -instance Binary FFun where - put (FFun fun prof lins) = put (fun,prof,lins) - get = liftM3 FFun get get get - -instance Binary FSymbol where - put (FSymCat n l) = putWord8 0 >> put (n,l) - put (FSymLit n l) = putWord8 1 >> put (n,l) - put (FSymKS ts) = putWord8 2 >> put ts - put (FSymKP d vs) = putWord8 3 >> put (d,vs) - get = do tag <- getWord8 - case tag of - 0 -> liftM2 FSymCat get get - 1 -> liftM2 FSymLit get get - 2 -> liftM FSymKS get - 3 -> liftM2 (\d vs -> FSymKP d vs) get get - _ -> decodingError - -instance Binary Production where - put (FApply ruleid args) = putWord8 0 >> put (ruleid,args) - put (FCoerce fcat) = putWord8 1 >> put fcat - get = do tag <- getWord8 - case tag of - 0 -> liftM2 FApply get get - 1 -> liftM FCoerce get - _ -> decodingError - -instance Binary ParserInfo where - put p = put (functions p, sequences p, productions0 p, totalCats p, startCats p) - get = do functions <- get - sequences <- get - productions0<- get - totalCats <- get - startCats <- get - return (ParserInfo{functions=functions,sequences=sequences - ,productions0=productions0 - ,productions =filterProductions productions0 - ,totalCats=totalCats,startCats=startCats}) - -decodingError = fail "This PGF file was compiled with different version of GF" -- cgit v1.2.3