removed src for 2.9

1 files changed, 0 insertions, 223 deletions

diff --git a/src/GF/Devel/Grammar/GFtoSource.hs b/src/GF/Devel/Grammar/GFtoSource.hs
deleted file mode 100644
index 292f5b826..000000000
--- a/src/GF/Devel/Grammar/GFtoSource.hs
+++ /dev/null
@@ -1,223 +0,0 @@
-module GF.Devel.Grammar.GFtoSource ( 
-  trGrammar,
-  trModule,
-  trAnyDef,
-  trLabel,
-  trt, 
-  tri, 
-  trp
-  ) where
-
-
-import GF.Devel.Grammar.Grammar
-import GF.Devel.Grammar.Construct
-import GF.Devel.Grammar.Macros (contextOfType)
-import qualified GF.Devel.Compile.AbsGF as P
-import GF.Infra.Ident
-
-import GF.Data.Operations
-
-import qualified Data.Map as Map
-
--- From internal source syntax to BNFC-generated (used for printing).
--- | AR 13\/5\/2003
---
--- translate internal to parsable and printable source
-
-trGrammar :: GF -> P.Grammar
-trGrammar = P.Gr . map trModule . listModules -- no includes
-
-trModule :: (Ident,Module) -> P.ModDef
-trModule (i,mo) = P.MModule compl typ body where
-    compl = case isCompleteModule mo of
-      False -> P.CMIncompl
-      _ -> P.CMCompl
-    i' = tri i
-    typ = case mtype mo of
-      MTGrammar -> P.MGrammar i'
-      MTAbstract -> P.MAbstract i'
-      MTConcrete a -> P.MConcrete i' (tri a)
-      MTInterface -> P.MInterface i'
-      MTInstance a -> P.MInstance i' (tri a)
-    body = P.MBody 
-             (trExtends (mextends mo)) 
-             (mkOpens (map trOpen (mopens mo)))
-             (concatMap trAnyDef [(c,j) | (c,j) <- listJudgements mo] ++ 
-                        map trFlag (Map.assocs (mflags mo)))
-
-trExtends :: [(Ident,MInclude)] -> 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)
-
-trOpen :: (Ident,Ident) -> P.Open
-trOpen (i,j) = P.OQual (tri i) (tri j)
-
-mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds
-
-trAnyDef :: (Ident,Judgement) -> [P.TopDef]
-trAnyDef (i,ju) = let 
-   i' = mkName i
-   i0 = tri i 
- in case jform ju of
-  JCat -> [P.DefCat [P.SimpleCatDef i0 []]] ---- (map trDecl co)]]
-  JFun -> [P.DefFun [P.FDecl [i'] (trt (jtype ju))]] 
-    ---- ++ case pt of
-    ---- Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
-    ---- _ -> []
-  ----  JFun ty EData -> [P.DefFunData [P.FunDef [i'] (trt ty)]]
-  JParam -> [P.DefPar [
-    P.ParDefDir i0 [
-      P.ParConstr (tri c) (map trDecl co) | let EParam _ cos = jdef ju, (c,co) <- cos]
-    ]] 
-  JOper -> case jdef ju of 
-    Overload tysts -> 
-      [P.DefOper [P.DDef [i'] (
-        P.EApp (P.EPIdent $ ppIdent "overload") 
-          (P.ERecord [P.LDFull [i0] (trt ty) (trt fu) | (ty,fu) <- tysts]))]]
-    tr -> [P.DefOper [trDef i (jtype ju) tr]]
-  JLincat -> [P.DefLincat [P.DDef [i'] (trt (jtype ju))]] 
-  ---- CncCat pty ptr ppr -> 
-  ----  [P.DefLindef [trDef i' pty ptr]] 
-    ---- ++ [P.DefPrintCat [P.DDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
-  JLin -> 
-    [P.DefLin [trDef i (Meta 0) (jdef ju)]] 
-    ---- ++ [P.DefPrintFun [P.DDef [mkName i] (trt pr)] | Yes pr <- [ppr]]
-  JLink -> []
-
-trDef :: Ident -> Type -> Term -> P.Def
-trDef i pty ptr = case (pty,ptr) of
-  (Meta _, Meta _) -> P.DDef  [mkName i] (P.EMeta) ---
-  (_,      Meta _) -> P.DDecl [mkName i] (trPerh pty)
-  (Meta _,      _) -> P.DDef  [mkName i] (trPerh ptr)
-  (_,           _) -> P.DFull [mkName i] (trPerh pty) (trPerh ptr)
-
-trPerh p = case p of
-  Meta _ -> P.EMeta
-  _ -> trt p
-
-trFlag :: (Ident,String) -> P.TopDef
-trFlag (f,x) = P.DefFlag [P.DDef [mkName f] (P.EString x)]
-
-trt :: Term -> P.Exp 
-trt trm = case trm of
-    Vr s -> P.EPIdent $ tri s
-----    Cn s -> P.ECons $ tri s
-    Con s -> P.EConstr $ tri s
-    Sort s -> P.ESort $ case s of
-      "Type" -> P.Sort_Type
-      "PType" -> P.Sort_PType
-      "Tok" -> P.Sort_Tok
-      "Str" -> P.Sort_Str
-      "Strs" -> P.Sort_Strs
-      _ -> error $ "not yet sort " +++ show trm ----
-
-    App c a -> P.EApp (trt c) (trt a)
-    Abs x b -> P.EAbstr [trb x] (trt b)
-    Eqs pts -> P.EEqs [P.Equ (map trp ps) (trt t) | (ps,t) <- pts]
-    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)
-    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)
-
-    Typed tr ty -> P.ETyped (trt tr) (trt ty)
-    Table x v -> P.ETType (trt x) (trt v)
-    S f x -> P.ESelect  (trt f) (trt x)
-    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
-    EData -> P.EData
-    EParam t _ -> trt t
-
-    _ -> error $ "not yet" +++ show trm ----
-
-trp :: Patt -> P.Patt
-trp p = case p of
-    PChar -> P.PChar
-    PChars s -> P.PChars s
-    PM m c -> P.PM (tri m) (tri c)
-    PW -> P.PW
-    PV s | isWildIdent s -> 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 [trLabelIdent 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)
-
-
-trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty
-  where 
-    t' = trt t
-    x  = [trLabelIdent lab]
-
-trLabelling (lab,ty) = P.LDDecl [trLabelIdent 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 i = ppIdent (prIdent i)
-
-ppIdent i = P.PIdent ((0,0),i)
-  
-trb i = if isWildIdent i then P.BWild else P.BPIdent (tri i)
-
-trLabel :: Label -> P.Label
-trLabel i = case i of
-  LIdent s -> P.LPIdent $ ppIdent s
-  LVar i -> P.LVar $ toInteger i
-
-trLabelIdent i = ppIdent $ case i of
-  LIdent s -> s
-  LVar i -> "v" ++ show i --- should not happen
-
-mkName :: Ident -> P.Name
-mkName = P.PIdentName . tri
-