forked from GitHub/gf-core
manually copy the "c-runtime" branch from the old repository.
This commit is contained in:
Krasimir Angelov
@@ -1 +1,163 @@
|
||||
module PGF.Internal where
|
||||
{-# LANGUAGE ImplicitParams #-}
|
||||
module PGF.Internal(CId(..),Language,PGF2.PGF,
|
||||
PGF2.Concr,lookConcr,
|
||||
PGF2.FId,isPredefFId,
|
||||
PGF2.FunId,PGF2.SeqId,PGF2.LIndex,PGF2.Token,
|
||||
PGF2.Production(..),PGF2.PArg(..),PGF2.Symbol(..),PGF2.Literal(..),PGF2.BindType(..),Sequence,
|
||||
globalFlags, abstrFlags, concrFlags,
|
||||
concrTotalCats, concrCategories, concrProductions,
|
||||
concrTotalFuns, concrFunction,
|
||||
concrTotalSeqs, concrSequence,
|
||||
|
||||
PGF2.CodeLabel, PGF2.Instr(..), PGF2.IVal(..), PGF2.TailInfo(..),
|
||||
|
||||
PGF2.Builder, PGF2.B, PGF2.build,
|
||||
eAbs, eApp, eMeta, eFun, eVar, eLit, eTyped, eImplArg, dTyp, hypo,
|
||||
PGF2.AbstrInfo, newAbstr, PGF2.ConcrInfo, newConcr, newPGF,
|
||||
|
||||
-- * Write an in-memory PGF to a file
|
||||
writePGF, writeConcr,
|
||||
|
||||
PGF2.fidString, PGF2.fidInt, PGF2.fidFloat, PGF2.fidVar, PGF2.fidStart,
|
||||
|
||||
ppFunId, ppSeqId, ppFId, ppMeta, ppLit, ppSeq,
|
||||
|
||||
unionPGF
|
||||
) where
|
||||
|
||||
import qualified PGF2
|
||||
import qualified PGF2.Internal as PGF2
|
||||
import qualified Data.Map as Map
|
||||
import PGF2.FFI(PGF(..))
|
||||
import Data.Array.IArray
|
||||
import Data.Array.Unboxed
|
||||
import Text.PrettyPrint
|
||||
|
||||
newtype CId = CId String deriving (Show,Read,Eq,Ord)
|
||||
|
||||
type Language = CId
|
||||
|
||||
lookConcr (PGF _ langs _) (CId lang) =
|
||||
case Map.lookup lang langs of
|
||||
Just cnc -> cnc
|
||||
Nothing -> error "Unknown language"
|
||||
|
||||
globalFlags pgf = Map.fromAscList [(CId name,value) | (name,value) <- PGF2.globalFlags pgf]
|
||||
abstrFlags pgf = Map.fromAscList [(CId name,value) | (name,value) <- PGF2.abstrFlags pgf]
|
||||
concrFlags concr = Map.fromAscList [(CId name,value) | (name,value) <- PGF2.concrFlags concr]
|
||||
|
||||
concrTotalCats = PGF2.concrTotalCats
|
||||
|
||||
concrCategories :: PGF2.Concr -> [(CId,PGF2.FId,PGF2.FId,[String])]
|
||||
concrCategories c = [(CId cat,start,end,lbls) | (cat,start,end,lbls) <- PGF2.concrCategories c]
|
||||
|
||||
concrProductions :: PGF2.Concr -> PGF2.FId -> [PGF2.Production]
|
||||
concrProductions = PGF2.concrProductions
|
||||
|
||||
concrTotalFuns = PGF2.concrTotalFuns
|
||||
|
||||
concrFunction :: PGF2.Concr -> PGF2.FunId -> (CId,[PGF2.SeqId])
|
||||
concrFunction c funid =
|
||||
let (fun,seqids) = PGF2.concrFunction c funid
|
||||
in (CId fun,seqids)
|
||||
|
||||
concrTotalSeqs :: PGF2.Concr -> PGF2.SeqId
|
||||
concrTotalSeqs = PGF2.concrTotalSeqs
|
||||
|
||||
concrSequence = PGF2.concrSequence
|
||||
|
||||
isPredefFId = PGF2.isPredefFId
|
||||
|
||||
type Sequence = [PGF2.Symbol]
|
||||
|
||||
eAbs :: (?builder :: PGF2.Builder s) => PGF2.BindType -> CId -> PGF2.B s PGF2.Expr -> PGF2.B s PGF2.Expr
|
||||
eAbs bind_type (CId var) body = PGF2.eAbs bind_type var body
|
||||
|
||||
eApp :: (?builder :: PGF2.Builder s) => PGF2.B s PGF2.Expr -> PGF2.B s PGF2.Expr -> PGF2.B s PGF2.Expr
|
||||
eApp = PGF2.eApp
|
||||
|
||||
eMeta :: (?builder :: PGF2.Builder s) => Int -> PGF2.B s PGF2.Expr
|
||||
eMeta = PGF2.eMeta
|
||||
|
||||
eFun (CId fun) = PGF2.eFun fun
|
||||
|
||||
eVar :: (?builder :: PGF2.Builder s) => Int -> PGF2.B s PGF2.Expr
|
||||
eVar = PGF2.eVar
|
||||
|
||||
eLit :: (?builder :: PGF2.Builder s) => PGF2.Literal -> PGF2.B s PGF2.Expr
|
||||
eLit = PGF2.eLit
|
||||
|
||||
eTyped :: (?builder :: PGF2.Builder s) => PGF2.B s PGF2.Expr -> PGF2.B s PGF2.Type -> PGF2.B s PGF2.Expr
|
||||
eTyped = PGF2.eTyped
|
||||
|
||||
eImplArg :: (?builder :: PGF2.Builder s) => PGF2.B s PGF2.Expr -> PGF2.B s PGF2.Expr
|
||||
eImplArg = PGF2.eImplArg
|
||||
|
||||
dTyp :: (?builder :: PGF2.Builder s) => [PGF2.B s (PGF2.BindType,String,PGF2.Type)] -> CId -> [PGF2.B s PGF2.Expr] -> PGF2.B s PGF2.Type
|
||||
dTyp hypos (CId cat) es = PGF2.dTyp hypos cat es
|
||||
|
||||
hypo bind_type (CId var) ty = PGF2.hypo bind_type var ty
|
||||
|
||||
newAbstr flags cats funs = PGF2.newAbstr [(flag,lit) | (CId flag,lit) <- flags]
|
||||
[(cat,hypos,prob) | (CId cat,hypos,prob) <- cats]
|
||||
[(fun,ty,arity,prob) | (CId fun,ty,arity,prob) <- funs]
|
||||
|
||||
newConcr abs flags printnames lindefs linrefs prods cncfuns seqs cnccats total_ccats =
|
||||
PGF2.newConcr abs [(flag,lit) | (CId flag,lit) <- flags]
|
||||
[(id,name) | (CId id,name) <- printnames]
|
||||
lindefs linrefs
|
||||
prods
|
||||
[(fun,seq_ids) | (CId fun,seq_ids) <- cncfuns]
|
||||
seqs
|
||||
[(cat,start,end,labels) | (CId cat,start,end,labels) <- cnccats]
|
||||
total_ccats
|
||||
|
||||
newPGF flags (CId name) abstr concrs =
|
||||
PGF2.newPGF [(flag,lit) | (CId flag,lit) <- flags]
|
||||
name
|
||||
abstr
|
||||
[(name,concr) | (CId name,concr) <- concrs]
|
||||
|
||||
writePGF = PGF2.writePGF
|
||||
writeConcr fpath pgf lang = PGF2.writeConcr fpath (lookConcr pgf lang)
|
||||
|
||||
|
||||
ppFunId funid = char 'F' <> int funid
|
||||
ppSeqId seqid = char 'S' <> int seqid
|
||||
|
||||
ppFId fid
|
||||
| fid == PGF2.fidString = text "CString"
|
||||
| fid == PGF2.fidInt = text "CInt"
|
||||
| fid == PGF2.fidFloat = text "CFloat"
|
||||
| fid == PGF2.fidVar = text "CVar"
|
||||
| fid == PGF2.fidStart = text "CStart"
|
||||
| otherwise = char 'C' <> int fid
|
||||
|
||||
ppMeta :: Int -> Doc
|
||||
ppMeta n
|
||||
| n == 0 = char '?'
|
||||
| otherwise = char '?' <> int n
|
||||
|
||||
ppLit (PGF2.LStr s) = text (show s)
|
||||
ppLit (PGF2.LInt n) = int n
|
||||
ppLit (PGF2.LFlt d) = double d
|
||||
|
||||
ppSeq (seqid,seq) =
|
||||
ppSeqId seqid <+> text ":=" <+> hsep (map ppSymbol seq)
|
||||
|
||||
ppSymbol (PGF2.SymCat d r) = char '<' <> int d <> comma <> int r <> char '>'
|
||||
ppSymbol (PGF2.SymLit d r) = char '{' <> int d <> comma <> int r <> char '}'
|
||||
ppSymbol (PGF2.SymVar d r) = char '<' <> int d <> comma <> char '$' <> int r <> char '>'
|
||||
ppSymbol (PGF2.SymKS t) = doubleQuotes (text t)
|
||||
ppSymbol PGF2.SymNE = text "nonExist"
|
||||
ppSymbol PGF2.SymBIND = text "BIND"
|
||||
ppSymbol PGF2.SymSOFT_BIND = text "SOFT_BIND"
|
||||
ppSymbol PGF2.SymSOFT_SPACE= text "SOFT_SPACE"
|
||||
ppSymbol PGF2.SymCAPIT = text "CAPIT"
|
||||
ppSymbol PGF2.SymALL_CAPIT = text "ALL_CAPIT"
|
||||
ppSymbol (PGF2.SymKP syms alts) = text "pre" <+> braces (hsep (punctuate semi (hsep (map ppSymbol syms) : map ppAlt alts)))
|
||||
|
||||
ppAlt (syms,ps) = hsep (map ppSymbol syms) <+> char '/' <+> hsep (map (doubleQuotes . text) ps)
|
||||
|
||||
unionPGF = PGF2.unionPGF
|
||||
|
||||
|
||||
Reference in New Issue
Block a user