removed src for 2.9

1 files changed, 0 insertions, 221 deletions

diff --git a/src/GF/Devel/Grammar/Construct.hs b/src/GF/Devel/Grammar/Construct.hs
deleted file mode 100644
index 5b4215843..000000000
--- a/src/GF/Devel/Grammar/Construct.hs
+++ /dev/null
@@ -1,221 +0,0 @@
-module GF.Devel.Grammar.Construct where
-
-import GF.Devel.Grammar.Grammar
-import GF.Infra.Ident
-
-import GF.Data.Operations
-
-import Control.Monad
-import Data.Map
-import Debug.Trace (trace)
-
-------------------
--- abstractions on Grammar, constructing objects
-------------------
-
--- abstractions on GF
-
-emptyGF :: GF
-emptyGF = GF Nothing [] empty empty
-
-type SourceModule = (Ident,Module)
-
-listModules :: GF -> [SourceModule]
-listModules = assocs.gfmodules
-
-addModule :: Ident -> Module -> GF -> GF
-addModule c m gf = gf {gfmodules = insert c m (gfmodules gf)}
-
-gfModules :: [(Ident,Module)] -> GF
-gfModules ms = emptyGF {gfmodules = fromList ms}
-
--- abstractions on Module
-
-emptyModule :: Module
-emptyModule = Module MTGrammar True [] [] [] [] empty empty
-
-isCompleteModule :: Module -> Bool
-isCompleteModule = miscomplete
-
-isInterface :: Module -> Bool
-isInterface m = case mtype m of
-  MTInterface -> True
-  MTAbstract -> True
-  _ -> False
-
-interfaceName :: Module -> Maybe Ident
-interfaceName mo = case mtype mo of
-  MTInstance i -> return i
-  MTConcrete i -> return i
-  _ -> Nothing
-
-listJudgements :: Module -> [(Ident,Judgement)]
-listJudgements = assocs . mjments
-
-isInherited :: MInclude -> Ident -> Bool
-isInherited mi i = case mi of
-  MIExcept is -> notElem i is
-  MIOnly is -> elem i is
-  _ -> True
-
--- abstractions on Judgement
-
-isConstructor :: Judgement -> Bool
-isConstructor j = jdef j == EData
-
-isLink :: Judgement -> Bool
-isLink j = jform j == JLink
-
--- constructing judgements from parse tree
-
-emptyJudgement :: JudgementForm -> Judgement
-emptyJudgement form = Judgement form meta meta meta (identC "#") 0 where
-  meta = Meta 0
-
-addJType :: Type -> Judgement -> Judgement
-addJType tr ju = ju {jtype = tr}
-
-addJDef :: Term -> Judgement -> Judgement
-addJDef tr ju = ju {jdef = tr}
-
-addJPrintname :: Term -> Judgement -> Judgement
-addJPrintname tr ju = ju {jprintname = tr}
-
-linkInherited :: Bool -> Ident -> Judgement
-linkInherited can mo = (emptyJudgement JLink){
-  jlink = mo,
-  jdef = if can then EData else Meta 0
-  }
-
-absCat :: Context -> Judgement
-absCat co = addJType (mkProd co typeType) (emptyJudgement JCat)
-
-absFun :: Type -> Judgement
-absFun ty = addJType ty (emptyJudgement JFun)
-
-cncCat :: Type -> Judgement
-cncCat ty = addJType ty (emptyJudgement JLincat)
-
-cncFun :: Term -> Judgement
-cncFun tr = addJDef tr (emptyJudgement JLin)
-
-resOperType :: Type -> Judgement
-resOperType ty = addJType ty (emptyJudgement JOper)
-
-resOperDef :: Term -> Judgement
-resOperDef tr = addJDef tr (emptyJudgement JOper)
-
-resOper :: Type -> Term -> Judgement
-resOper ty tr = addJDef tr (resOperType ty)
-
-resOverload :: [(Type,Term)] -> Judgement
-resOverload tts = resOperDef (Overload tts)
-
--- param p = ci gi  is encoded as p : ((ci : gi) -> p) -> Type
--- we use EData instead of p to make circularity check easier  
-resParam :: Ident -> [(Ident,Context)] -> Judgement
-resParam p cos = addJDef (EParam (Con p) cos) (addJType typePType (emptyJudgement JParam))
-
--- to enable constructor type lookup:
--- create an oper for each constructor p = c g, as c : g -> p = EData
-paramConstructors :: Ident -> [(Ident,Context)] -> [(Ident,Judgement)]
-paramConstructors p cs = [(c,resOper (mkProd co (Con p)) EData) | (c,co) <- cs]
-
--- unifying contents of judgements
-
----- used in SourceToGF; make error-free and informative
-unifyJudgements j k = case unifyJudgement j k of
-  Ok l -> l
-  Bad s -> error s
-
-unifyJudgement :: Judgement -> Judgement -> Err Judgement
-unifyJudgement old new = do
-  testErr (jform old == jform new) "different judment forms"
-  [jty,jde,jpri] <- mapM unifyField [jtype,jdef,jprintname]
-  return $ old{jtype = jty, jdef = jde, jprintname = jpri}
- where
-   unifyField field = unifyTerm (field old) (field new)
-   unifyTerm oterm nterm = case (oterm,nterm) of
-     (Meta _,t) -> return t
-     (t,Meta _) -> return t
-     _ -> do
-       if (nterm /= oterm) 
-          then (trace (unwords ["illegal update of",show oterm,"to",show nterm]) 
-                (return ()))
-          else return () ---- to recover from spurious qualification conflicts
-----       testErr (nterm == oterm) 
-----               (unwords ["illegal update of",prt oterm,"to",prt nterm])
-       return nterm
-
-updateJudgement :: Ident -> Ident -> Judgement -> GF -> Err GF
-updateJudgement m c ju gf = do
-  mo  <- maybe (Bad (show m)) return $ Data.Map.lookup m $ gfmodules gf
-  let mo' = mo {mjments = insert c ju (mjments mo)}
-  return $ gf {gfmodules = insert m mo' (gfmodules gf)}
-
--- abstractions on Term
-
-type Cat  = QIdent
-type Fun  = QIdent
-type QIdent = (Ident,Ident)
-
--- | branches à la Alfa
-newtype Branch = Branch (Con,([Ident],Term)) deriving (Eq, Ord,Show,Read)
-type Con = Ident ---
-
-varLabel :: Int -> Label
-varLabel = LVar
-
-wildPatt :: Patt
-wildPatt = PW
-
-type Trm = Term
-
-mkProd :: Context -> Type -> Type
-mkProd = flip (foldr (uncurry Prod))
-
--- type constants
-
-typeType :: Type
-typeType = Sort "Type"
-
-typePType :: Type
-typePType = Sort "PType"
-
-typeStr :: Type
-typeStr = Sort "Str"
-
-typeTok :: Type      ---- deprecated
-typeTok = Sort "Tok"  
-
-cPredef :: Ident
-cPredef = identC "Predef"
-
-cPredefAbs :: Ident
-cPredefAbs = identC "PredefAbs"
-
-typeString, typeFloat, typeInt :: Term
-typeInts :: Integer -> Term
-
-typeString = constPredefRes "String"
-typeInt = constPredefRes "Int"
-typeFloat = constPredefRes "Float"
-typeInts i = App (constPredefRes "Ints") (EInt i)
-
-isTypeInts :: Term -> Bool
-isTypeInts ty = case ty of
-  App c _ -> c == constPredefRes "Ints"
-  _ -> False
-
-cnPredef = constPredefRes
-
-constPredefRes :: String -> Term
-constPredefRes s = Q (IC "Predef") (identC s)
-
-isPredefConstant :: Term -> Bool
-isPredefConstant t = case t of
-  Q (IC "Predef") _ -> True
-  Q (IC "PredefAbs") _ -> True
-  _ -> False
-
-