clean up the GF.Grammar API

1 files changed, 0 insertions, 233 deletions

diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
deleted file mode 100644
index a3754336e..000000000
--- a/src/GF/Source/GrammarToSource.hs
+++ /dev/null
@@ -1,233 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : GrammarToSource
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/10/04 11:05:07 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.23 $
---
--- From internal source syntax to BNFC-generated (used for printing).
------------------------------------------------------------------------------
-
-module GF.Source.GrammarToSource ( trGrammar,
-			 trModule,
-			 trAnyDef,
-			 trLabel,
-			 trt, tri, trp
-		       ) where
-
-import GF.Data.Operations
-import GF.Grammar.Grammar
-import GF.Grammar.Predef 
-import GF.Infra.Modules
-import GF.Infra.Option
-import qualified GF.Source.AbsGF as P
-import GF.Infra.Ident
-import qualified Data.ByteString.Char8 as BS
-
--- | AR 13\/5\/2003
---
--- translate internal to parsable and printable source
-trGrammar :: SourceGrammar -> P.Grammar
-trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes
-
-trModule :: (Ident,SourceModInfo) -> P.ModDef
-trModule (i,m) = P.MModule compl typ body
-  where
-    compl = case mstatus m of
-      MSIncomplete -> P.CMIncompl
-      _ -> P.CMCompl
-    i' = tri i
-    typ = case mtype m of
-      MTResource -> P.MTResource i'
-      MTAbstract -> P.MTAbstract i'
-      MTConcrete a -> P.MTConcrete i' (tri a)
-      MTTransfer a b -> P.MTTransfer i' (trOpen a) (trOpen b)
-      MTInstance a -> P.MTInstance i' (tri a)
-      MTInterface -> P.MTInterface i'
-    body = P.MBody 
-             (trExtends (extend m)) 
-             (mkOpens (map trOpen (opens m)))
-             (mkTopDefs (concatMap trAnyDef (tree2list (jments m)) ++ trFlags (flags m)))
-
-trExtends :: [(Ident,MInclude Ident)] -> P.Extend
-trExtends [] = P.NoExt 
-trExtends es = (P.Ext $ map tre es) where
-  tre (i,c) = case c of 
-    MIAll       -> P.IAll   (tri i)
-    MIOnly is   -> P.ISome  (tri i) (map tri is)
-    MIExcept is -> P.IMinus (tri i) (map tri is)
-
----- this has to be completed with other mtys
-forName (MTConcrete a) = tri a
-
-trOpen :: OpenSpec Ident -> P.Open
-trOpen o = case o of
-  OSimple i   -> P.OName (tri i)
-  OQualif i j -> P.OQual P.QOCompl (tri i) (tri j)
-
-mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds
-mkTopDefs ds = ds
-
-trAnyDef :: (Ident,Info) -> [P.TopDef]
-trAnyDef (i,info) = let i' = tri i in case info of
-  AbsCat (Just co) pd -> [P.DefCat [P.SimpleCatDef i' (map trDecl co)]]
-  AbsFun (Just ty) _ Nothing    -> [P.DefFunData [P.FunDef [i'] (trt ty)]]
-  AbsFun (Just ty) _ (Just eqs) -> [P.DefFun [P.FunDef [i'] (trt ty)]] ++
-                                   [P.DefDef [P.DPatt (mkName i') (map trp patts) (trt res)] | (patts,res) <- eqs]
-
-  ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
-  ResParam pp -> [P.DefPar [case pp of
-    Just (ps,_) -> P.ParDefDir i' [P.ParConstr (tri c) (map trDecl co) | (c,co) <- ps]
-    Nothing     -> P.ParDefAbs i']]
-
-  ResOverload os tysts -> 
-    [P.DefOper [P.DDef [mkName i'] (
-      foldl P.EApp 
-        (P.EIdent $ tri $ cOverload)
-          (map (P.EIdent . tri) os ++ 
-           [P.ERecord [P.LDFull [i'] (trt ty) (trt fu) | (ty,fu) <- tysts]]))]]
-
-  CncCat (Just ty) Nothing _ -> 
-    [P.DefLincat [P.PrintDef [mkName i'] (trt ty)]] 
-  CncCat pty ptr ppr -> 
-    [P.DefLindef [trDef i' pty ptr]] ++
-    [P.DefPrintCat [P.PrintDef [mkName i'] (trt pr)] | Just pr <- [ppr]]
-  CncFun _ ptr ppr -> 
-    [P.DefLin [trDef i' Nothing ptr]] ++ 
-    [P.DefPrintFun [P.PrintDef [mkName i'] (trt pr)] | Just pr <- [ppr]]
-  _ -> [] 
-
-
-trDef :: P.PIdent -> Maybe Type -> Maybe Term -> P.Def
-trDef i pty ptr = case (pty,ptr) of
-  (Nothing,     Nothing) -> P.DDef  [mkName i] (P.EMeta) ---
-  (_,           Nothing) -> P.DDecl [mkName i] (maybe P.EMeta trt pty)
-  (Nothing,     _      ) -> P.DDef  [mkName i] (maybe P.EMeta trt ptr)
-  (_,           _      ) -> P.DFull [mkName i] (maybe P.EMeta trt pty) (maybe P.EMeta trt ptr)
-
-trFlags :: Options -> [P.TopDef]
-trFlags = map trFlag . optionsGFO
-
-trFlag :: (String,String) -> P.TopDef
-trFlag (f,x) = P.DefFlag [P.FlagDef (tri $ identC (BS.pack f)) (tri $ identC (BS.pack x))]
-
-trt :: Term -> P.Exp 
-trt trm = case trm of
-    Vr s -> P.EIdent $ tri s
-    Cn s -> P.ECons $ tri s
-    Con s -> P.EConstr $ tri s
-    Sort s -> P.ESort $! if s == cType  then P.Sort_Type  else
-                         if s == cPType then P.Sort_PType else
-                         if s == cTok   then P.Sort_Tok   else
-                         if s == cStr   then P.Sort_Str   else
-                         if s == cStrs  then P.Sort_Strs  else
-                           error $ "not yet sort " +++ show trm
-    App c a -> P.EApp (trt c) (trt a)
-    Abs x b -> P.EAbstr [trb x] (trt b)
-    Meta m  -> P.EMeta
-    Prod x a b | isWildIdent x -> P.EProd (P.DExp (trt a)) (trt b)
-    Prod x a b -> P.EProd (P.DDec [trb x] (trt a)) (trt b)
-
-    Example t s -> P.EExample (trt t) s
-    R [] -> P.ETuple [] --- to get correct parsing when read back
-    R r -> P.ERecord $ map trAssign r
-    RecType r -> P.ERecord $ map trLabelling r
-    ExtR x y -> P.EExtend (trt x) (trt y)
-    P t l -> P.EProj (trt t) (trLabel l)
-    PI t l _ -> P.EProj (trt t) (trLabel l)
-    Q t l -> P.EQCons (tri t) (tri l)
-    QC t l -> P.EQConstr (tri t) (tri l)
-    TSh (TComp ty) cc -> P.ETTable (trt ty) (map trCases cc)
-    TSh (TTyped ty) cc -> P.ETTable (trt ty) (map trCases cc)
-    TSh (TWild ty) cc -> P.ETTable (trt ty) (map trCases cc)
-    T (TTyped ty) cc -> P.ETTable (trt ty) (map trCase cc)
-    T (TComp ty) cc -> P.ETTable (trt ty) (map trCase cc)
-    T (TWild ty) cc -> P.ETTable (trt ty) (map trCase cc)
-    T _ cc -> P.ETable (map trCase cc)
-    V ty cc -> P.EVTable (trt ty) (map trt cc)
-
-    Table x v -> P.ETType (trt x) (trt v)
-    S f x -> P.ESelect  (trt f) (trt x)
-----    Alias c a t -> "{-" +++ prt c +++ "=" +++ "-}" +++ prt t
---    Alias c a t -> prt (Let (c,(Just a,t)) (Vr c))  -- thus Alias is only internal
-
-    Let (x,(ma,b)) t -> 
-      P.ELet [maybe (P.LDDef x' b') (\ty -> P.LDFull x' (trt ty) b')  ma] (trt t)
-                          where 
-                            b' = trt b
-                            x' = [tri x]
-
-    Empty -> P.EEmpty
-    K [] -> P.EEmpty
-    K a -> P.EString a
-    C a b -> P.EConcat (trt a) (trt b)
-
-    EInt i -> P.EInt i
-    EFloat i -> P.EFloat i
-
-    EPatt p -> P.EPatt (trp p)
-    EPattType t -> P.EPattType (trt t)
-
-    Glue a b -> P.EGlue (trt a) (trt b)
-    Alts (t, tt) -> P.EPre (trt t) [P.Alt (trt v) (trt c) | (v,c) <- tt]
-    FV ts -> P.EVariants $ map trt ts
-    Strs tt -> P.EStrs $ map trt tt
-    Val te _ _ -> trt te ----
-    _ -> error $ "not yet" +++ show trm ----
-
-trp :: Patt -> P.Patt
-trp p = case p of
-    PW -> P.PW
-    PV s -> P.PV $ tri s
-    PC c [] -> P.PCon $ tri c
-    PC c a -> P.PC (tri c) (map trp a)
-    PP p c [] -> P.PQ (tri p) (tri c)
-    PP p c a -> P.PQC (tri p) (tri c) (map trp a)
-    PR r -> P.PR [P.PA [tri $ label2ident l] (trp p) | (l,p) <- r]
-    PString s -> P.PStr s
-    PInt i -> P.PInt i
-    PFloat i -> P.PFloat i
-    PT t p -> trp p ---- prParenth (prt p +++ ":" +++ prt t)
-
-    PAs  x p -> P.PAs (tri x) (trp p)
-
-    PAlt p q -> P.PDisj (trp p) (trp q)
-    PSeq p q -> P.PSeq (trp p) (trp q)
-    PRep p   -> P.PRep (trp p)
-    PNeg p   -> P.PNeg (trp p)
-    PChar    -> P.PChar
-    PChars s -> P.PChars s
-    PM m c   -> P.PM (tri m) (tri c)
-
-    PVal p _ _ -> trp p ----
-
-trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
-  where 
-    t' = trt t
-    x  = [tri $ label2ident lab]
-
-trLabelling (lab,ty) = P.LDDecl [tri $ label2ident lab] (trt ty)
-
-trCase  (patt, trm) = P.Case (trp patt) (trt trm)
-trCases (patts,trm) = P.Case (foldl1 P.PDisj (map trp patts)) (trt trm)
-
-trDecl (x,ty) = P.DDDec [trb x] (trt ty)
-
-tri :: Ident -> P.PIdent
-tri = ppIdent . ident2bs 
-
-ppIdent i = P.PIdent ((0,0),i)
-
-trb i = if isWildIdent i then P.BWild else P.BIdent (tri i)
-
-trLabel :: Label -> P.Label
-trLabel i = case i of
-  LIdent s -> P.LIdent $ ppIdent s
-  LVar i -> P.LVar $ toInteger i
-
-mkName :: P.PIdent -> P.Name
-mkName = P.IdentName