removed src for 2.9

5 files changed, 0 insertions, 441 deletions

diff --git a/src/GF/GFCC/Raw/AbsGFCCRaw.hs b/src/GF/GFCC/Raw/AbsGFCCRaw.hs
deleted file mode 100644
index ab5f184a8..000000000
--- a/src/GF/GFCC/Raw/AbsGFCCRaw.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module GF.GFCC.Raw.AbsGFCCRaw where
-
--- Haskell module generated by the BNF converter
-
-newtype CId = CId String deriving (Eq,Ord,Show)
-data Grammar =
-   Grm [RExp]
-  deriving (Eq,Ord,Show)
-
-data RExp =
-   App CId [RExp]
- | AInt Integer
- | AStr String
- | AFlt Double
- | AMet
-  deriving (Eq,Ord,Show)
-
diff --git a/src/GF/GFCC/Raw/ConvertGFCC.hs b/src/GF/GFCC/Raw/ConvertGFCC.hs
deleted file mode 100644
index 0b010d604..000000000
--- a/src/GF/GFCC/Raw/ConvertGFCC.hs
+++ /dev/null
@@ -1,277 +0,0 @@
-module GF.GFCC.Raw.ConvertGFCC (toGFCC,fromGFCC) where
-
-import GF.GFCC.DataGFCC
-import GF.GFCC.Raw.AbsGFCCRaw
-
-import GF.Data.Assoc
-import GF.Formalism.FCFG
-import GF.Formalism.Utilities (NameProfile(..), Profile(..), SyntaxForest(..))
-import GF.Parsing.FCFG.PInfo (FCFPInfo(..), buildFCFPInfo)
-
-import qualified Data.Array as Array
-import Data.Map
-
-pgfMajorVersion, pgfMinorVersion :: Integer
-(pgfMajorVersion, pgfMinorVersion) = (1,0)
-
--- convert parsed grammar to internal GFCC
-
-toGFCC :: Grammar -> GFCC
-toGFCC (Grm [
-  App (CId "pgf") (AInt v1 : AInt v2 : App a []:cs),
-  App (CId "flags")     gfs, 
-  ab@(
-    App (CId "abstract") [
-      App (CId "fun")   fs,
-      App (CId "cat")   cts
-      ]), 
-  App (CId "concrete") ccs
-  ]) = GFCC {
-    absname = a,
-    cncnames = [c | App c [] <- cs],
-    gflags = fromAscList [(f,v) | App f [AStr v] <- gfs],
-    abstract = 
-     let
-      aflags  = fromAscList [(f,v) | App f [AStr v] <- gfs]
-      lfuns   = [(f,(toType typ,toExp def)) | App f [typ, def] <- fs]
-      funs    = fromAscList lfuns
-      lcats   = [(c, Prelude.map toHypo hyps) | App c hyps <- cts]
-      cats    = fromAscList lcats
-      catfuns = fromAscList 
-        [(cat,[f | (f, (DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
-     in Abstr aflags funs cats catfuns,
-    concretes = fromAscList [(lang, toConcr ts) | App lang ts <- ccs]
-    }
- where
-
-toConcr :: [RExp] -> Concr
-toConcr = foldl add (Concr {
-               cflags       = empty,
-               lins         = empty,
-               opers        = empty,
-               lincats      = empty,
-               lindefs      = empty,
-               printnames   = empty,
-               paramlincats = empty,
-               parser       = Nothing
-             })
-  where
-    add :: Concr -> RExp -> Concr
-    add cnc (App (CId "flags") ts)     = cnc { cflags = fromAscList [(f,v) | App f [AStr v] <- ts] }
-    add cnc (App (CId "lin") ts)       = cnc { lins = mkTermMap ts }
-    add cnc (App (CId "oper") ts)      = cnc { opers = mkTermMap ts }
-    add cnc (App (CId "lincat") ts)    = cnc { lincats = mkTermMap ts }
-    add cnc (App (CId "lindef") ts)    = cnc { lindefs = mkTermMap ts }
-    add cnc (App (CId "printname") ts) = cnc { printnames = mkTermMap ts }
-    add cnc (App (CId "param") ts)     = cnc { paramlincats = mkTermMap ts }
-    add cnc (App (CId "parser") ts)    = cnc { parser = Just (toPInfo ts) }
-
-toPInfo :: [RExp] -> FCFPInfo
-toPInfo [App (CId "rules") rs, App (CId "startupcats") cs] = buildFCFPInfo (rules, cats)
-  where 
-    rules = lmap toFRule rs
-    cats = fromList [(c, lmap expToInt fs) | App c fs <- cs]
-
-    toFRule :: RExp -> FRule
-    toFRule (App (CId "rule") 
-              [n,                      
-               App (CId "cats") (rt:at),
-               App (CId "R") ls]) = FRule name args res lins
-      where 
-        name = toFName n
-        args = lmap expToInt at
-        res  = expToInt rt
-        lins = mkArray [mkArray [toSymbol s | s <- l] | App (CId "S") l <- ls]
-
-toFName :: RExp -> FName
-toFName (App (CId "_A") [x]) = Name (CId "_") [Unify [expToInt x]]
-toFName (App f ts) = Name f (lmap toProfile ts)
-    where
-      toProfile :: RExp -> Profile (SyntaxForest CId)
-      toProfile AMet = Unify []
-      toProfile (App (CId "_A") [t]) = Unify [expToInt t]
-      toProfile (App (CId "_U") ts) = Unify [expToInt t | App (CId "_A") [t] <- ts]
-      toProfile t = Constant (toSyntaxForest t)
-
-      toSyntaxForest :: RExp -> SyntaxForest CId
-      toSyntaxForest AMet = FMeta
-      toSyntaxForest (App n ts) = FNode n [lmap toSyntaxForest ts]
-      toSyntaxForest (AStr s) = FString s
-      toSyntaxForest (AInt i) = FInt i
-      toSyntaxForest (AFlt f) = FFloat f
-
-toSymbol :: RExp -> FSymbol
-toSymbol (App (CId "P") [c,n,l]) = FSymCat (expToInt c) (expToInt l) (expToInt n)
-toSymbol (AStr t) = FSymTok t
-
-toType :: RExp -> Type
-toType e = case e of
-  App cat [App (CId "H") hypos, App (CId "X") exps] -> 
-    DTyp (lmap toHypo hypos) cat (lmap toExp exps) 
-  _ -> error $ "type " ++ show e
-
-toHypo :: RExp -> Hypo
-toHypo e = case e of
-  App x [typ] -> Hyp x (toType typ)
-  _ -> error $ "hypo " ++ show e
-
-toExp :: RExp -> Exp
-toExp e = case e of
-  App (CId "App") [App fun [], App (CId "B") xs, App (CId "X") exps] ->
-    DTr [x | App x [] <- xs] (AC fun) (lmap toExp exps)
-  App (CId "Eq") eqs -> 
-    EEq [Equ (lmap toExp ps) (toExp v) | App (CId "E") (v:ps) <- eqs]
-  App (CId "Var") [App i []] -> DTr [] (AV i) []
-  AMet -> DTr [] (AM 0) []
-  AInt i -> DTr [] (AI i) []
-  AFlt i -> DTr [] (AF i) []
-  AStr i -> DTr [] (AS i) []
-  _ -> error $ "exp " ++ show e
-
-toTerm :: RExp -> Term
-toTerm e = case e of
-  App (CId "R") es    -> R  (lmap toTerm es)
-  App (CId "S") es    -> S  (lmap toTerm es)
-  App (CId "FV") es   -> FV (lmap toTerm es)
-  App (CId "P") [e,v] -> P  (toTerm e) (toTerm v)
-  App (CId "RP") [e,v] -> RP  (toTerm e) (toTerm v) ----
-  App (CId "W") [AStr s,v] -> W s (toTerm v)
-  App (CId "A") [AInt i] -> V (fromInteger i)
-  App f []  -> F f
-  AInt i -> C (fromInteger i)
-  AMet   -> TM "?"
-  AStr s -> K (KS s) ----
-  _ -> error $ "term " ++ show e
-
-------------------------------
---- from internal to parser --
-------------------------------
-
-fromGFCC :: GFCC -> Grammar
-fromGFCC gfcc0 = Grm [
-  app "pgf" (AInt pgfMajorVersion:AInt pgfMinorVersion
-             : App (absname gfcc) [] : lmap (flip App []) (cncnames gfcc)), 
-  app "flags" [App f [AStr v] | (f,v) <- toList (gflags gfcc `union` aflags agfcc)],
-  app "abstract" [
-    app "fun"   [App f [fromType t,fromExp d] | (f,(t,d)) <- toList (funs agfcc)],
-    app "cat"   [App f (lmap fromHypo hs) | (f,hs) <- toList (cats agfcc)]
-    ],
-  app "concrete" [App lang (fromConcrete c) | (lang,c) <- toList (concretes gfcc)]
-  ]
- where
-  gfcc = utf8GFCC gfcc0
-  app s = App (CId s)
-  agfcc = abstract gfcc
-  fromConcrete cnc = [
-      app "flags"     [App f [AStr v]     | (f,v) <- toList (cflags cnc)],
-      app "lin"       [App f [fromTerm v] | (f,v) <- toList (lins cnc)],
-      app "oper"      [App f [fromTerm v] | (f,v) <- toList (opers cnc)],
-      app "lincat"    [App f [fromTerm v] | (f,v) <- toList (lincats cnc)],
-      app "lindef"    [App f [fromTerm v] | (f,v) <- toList (lindefs cnc)],
-      app "printname" [App f [fromTerm v] | (f,v) <- toList (printnames cnc)],
-      app "param"     [App f [fromTerm v] | (f,v) <- toList (paramlincats cnc)]
-     ] ++ maybe [] (\p -> [fromPInfo p]) (parser cnc)
-
-fromType :: Type -> RExp
-fromType e = case e of
-  DTyp hypos cat exps -> 
-    App cat [
-      App (CId "H") (lmap fromHypo hypos), 
-      App (CId "X") (lmap fromExp exps)] 
-
-fromHypo :: Hypo -> RExp
-fromHypo e = case e of
-  Hyp x typ -> App x [fromType typ]
-
-fromExp :: Exp -> RExp
-fromExp e = case e of
-  DTr xs (AC fun) exps ->
-    App (CId "App") [App fun [], App (CId "B") (lmap (flip App []) xs), App (CId "X") (lmap fromExp exps)]
-  DTr [] (AV x) [] -> App (CId "Var") [App x []]
-  DTr [] (AS s) [] -> AStr s
-  DTr [] (AF d) [] -> AFlt d
-  DTr [] (AI i) [] -> AInt (toInteger i)
-  DTr [] (AM _) [] -> AMet ----
-  EEq eqs -> 
-    App (CId "Eq") [App (CId "E") (lmap fromExp (v:ps)) | Equ ps v <- eqs]
-  _ -> error $ "exp " ++ show e
-
-fromTerm :: Term -> RExp
-fromTerm e = case e of
-  R es    -> app "R" (lmap fromTerm es)
-  S es    -> app "S" (lmap fromTerm es)
-  FV es   -> app "FV" (lmap fromTerm es)
-  P e v   -> app "P"  [fromTerm e, fromTerm v]
-  RP e v  -> app "RP" [fromTerm e, fromTerm v] ----
-  W s v   -> app "W" [AStr s, fromTerm v]
-  C i     -> AInt (toInteger i)
-  TM _    -> AMet
-  F f     -> App f []
-  V i     -> App (CId "A") [AInt (toInteger i)]
-  K (KS s) -> AStr s ----
-  K (KP d vs) -> app "FV" (str d : [str v | Var v _ <- vs]) ----
- where
-   app = App . CId
-   str v = app "S" (lmap AStr v)
-
--- ** Parsing info
-
-fromPInfo :: FCFPInfo -> RExp
-fromPInfo p = app "parser" [
-          app "rules"         [fromFRule rule | rule <- Array.elems (allRules p)],
-          app "startupcats"   [App f (lmap intToExp cs) | (f,cs) <- toList (startupCats p)]
-        ]
-
-fromFRule :: FRule -> RExp
-fromFRule (FRule n args res lins) = 
-    app "rule" [fromFName n,
-                app "cats" (intToExp res:lmap intToExp args),
-                app "R" [app "S" [fromSymbol s | s <- Array.elems l] | l <- Array.elems lins]
-               ]
-
-fromFName :: FName -> RExp
-fromFName n = case n of
-                Name (CId "_") [p] -> fromProfile p
-                Name f ps          -> App f (lmap fromProfile ps)
-  where
-    fromProfile :: Profile (SyntaxForest CId) -> RExp
-    fromProfile (Unify []) = AMet
-    fromProfile (Unify [x]) = daughter x
-    fromProfile (Unify args) = app "_U" (lmap daughter args)
-    fromProfile (Constant forest) = fromSyntaxForest forest
-
-    daughter n = app "_A" [intToExp n]
-
-    fromSyntaxForest :: SyntaxForest CId -> RExp
-    fromSyntaxForest FMeta = AMet
-    -- FIXME: is there always just one element here?
-    fromSyntaxForest (FNode n [args]) = App n (lmap fromSyntaxForest args)
-    fromSyntaxForest (FString s) = AStr s
-    fromSyntaxForest (FInt i) = AInt i
-    fromSyntaxForest (FFloat f) = AFlt f
-
-fromSymbol :: FSymbol -> RExp
-fromSymbol (FSymCat c l n) = app "P" [intToExp c, intToExp n, intToExp l]
-fromSymbol (FSymTok t) = AStr t
-
--- ** Utilities
-
-mkTermMap :: [RExp] -> Map CId Term
-mkTermMap ts = fromAscList [(f,toTerm v) | App f [v] <- ts]
-
-app :: String -> [RExp] -> RExp
-app = App . CId
-
-mkArray :: [a] -> Array.Array Int a
-mkArray xs = Array.listArray (0, length xs - 1) xs
-
-expToInt :: Integral a => RExp -> a
-expToInt (App (CId "neg") [AInt i]) = fromIntegral (negate i)
-expToInt (AInt i) = fromIntegral i
-
-expToStr :: RExp -> String
-expToStr (AStr s) = s
-
-intToExp :: Integral a => a -> RExp
-intToExp x | x < 0 = App (CId "neg") [AInt (fromIntegral (negate x))]
-           | otherwise =  AInt (fromIntegral x)
diff --git a/src/GF/GFCC/Raw/GFCCRaw.cf b/src/GF/GFCC/Raw/GFCCRaw.cf
deleted file mode 100644
index bedaef685..000000000
--- a/src/GF/GFCC/Raw/GFCCRaw.cf
+++ /dev/null
@@ -1,12 +0,0 @@
-Grm. Grammar ::= [RExp] ;
-
-App.  RExp ::= "(" CId [RExp] ")" ;
-AId.  RExp ::= CId ;
-AInt. RExp ::= Integer ;
-AStr. RExp ::= String ;
-AFlt. RExp ::= Double ;
-AMet. RExp ::= "?" ;
-
-terminator RExp "" ;
-
-token CId (('_' | letter) (letter | digit | '\'' | '_')*) ;
diff --git a/src/GF/GFCC/Raw/ParGFCCRaw.hs b/src/GF/GFCC/Raw/ParGFCCRaw.hs
deleted file mode 100644
index b71904948..000000000
--- a/src/GF/GFCC/Raw/ParGFCCRaw.hs
+++ /dev/null
@@ -1,99 +0,0 @@
-module GF.GFCC.Raw.ParGFCCRaw (parseGrammar) where
-
-import GF.GFCC.Raw.AbsGFCCRaw
-
-import Control.Monad
-import Data.Char
-
-parseGrammar :: String -> IO Grammar
-parseGrammar s = case runP pGrammar s of
-                   Just (x,"") -> return x
-                   _           -> fail "Parse error"
-
-pGrammar :: P Grammar
-pGrammar = liftM Grm pTerms
-
-pTerms :: P [RExp]
-pTerms = liftM2 (:) (pTerm 1) pTerms <++ (skipSpaces >> return [])
-
-pTerm :: Int -> P RExp
-pTerm n = skipSpaces >> (pParen <++ pApp <++ pNum <++ pStr <++ pMeta)
-  where pParen = between (char '(') (char ')') (pTerm 0)
-        pApp = liftM2 App pIdent (if n == 0 then pTerms else return [])
-        pStr = char '"' >> liftM AStr (manyTill (pEsc <++ get) (char '"'))
-        pEsc = char '\\' >> get
-        pNum = do x <- munch1 isDigit
-                  ((char '.' >> munch1 isDigit >>= \y -> return (AFlt (read (x++"."++y))))
-                   <++
-                   return (AInt (read x)))
-        pMeta = char '?' >> return AMet
-        pIdent = liftM CId $ liftM2 (:) (satisfy isIdentFirst) (munch isIdentRest)
-        isIdentFirst c = c == '_' || isAlpha c
-        isIdentRest c = c == '_' || c == '\'' || isAlphaNum c
-
--- Parser combinators with only left-biased choice
-
-newtype P a = P { runP :: String -> Maybe (a,String) }
-
-instance Monad P where
-    return x = P (\ts -> Just (x,ts))
-    P p >>= f = P (\ts -> p ts >>= \ (x,ts') -> runP (f x) ts')
-    fail _ = pfail
-
-instance MonadPlus P where
-    mzero = pfail
-    mplus = (<++)
-
-
-get :: P Char
-get = P (\ts -> case ts of
-                  [] -> Nothing
-                  c:cs -> Just (c,cs))
-
-look :: P String
-look = P (\ts -> Just (ts,ts))
-
-(<++) :: P a -> P a -> P a
-P p <++ P q = P (\ts -> p ts `mplus` q ts)
-
-pfail :: P a
-pfail = P (\ts -> Nothing)
-
-satisfy :: (Char -> Bool) -> P Char
-satisfy p = do c <- get
-               if p c then return c else pfail
-
-char :: Char -> P Char
-char c = satisfy (c==)
-
-string :: String -> P String
-string this = look >>= scan this
-    where
-      scan []     _               = return this
-      scan (x:xs) (y:ys) | x == y = get >> scan xs ys
-      scan _      _               = pfail
-
-skipSpaces :: P ()
-skipSpaces = look >>= skip
-    where
-      skip (c:s) | isSpace c = get >> skip s
-      skip _                 = return ()
-
-manyTill :: P a -> P end -> P [a]
-manyTill p end = scan
-  where scan = (end >> return []) <++ liftM2 (:) p scan
-
-munch :: (Char -> Bool) -> P String
-munch p = munch1 p <++ return []
-
-munch1 :: (Char -> Bool) -> P String
-munch1 p = liftM2 (:) (satisfy p) (munch p)
-
-choice :: [P a] -> P a
-choice = msum
-
-between :: P open -> P close -> P a -> P a
-between open close p = do open
-                          x <- p
-                          close
-                          return x
diff --git a/src/GF/GFCC/Raw/PrintGFCCRaw.hs b/src/GF/GFCC/Raw/PrintGFCCRaw.hs
deleted file mode 100644
index d46d8096f..000000000
--- a/src/GF/GFCC/Raw/PrintGFCCRaw.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-module GF.GFCC.Raw.PrintGFCCRaw (printTree) where
-
-import GF.GFCC.Raw.AbsGFCCRaw
-
-import Data.List (intersperse)
-import Numeric (showFFloat)
-
-printTree :: Grammar -> String
-printTree g = prGrammar g ""
-
-prGrammar :: Grammar -> ShowS
-prGrammar (Grm xs) = prRExpList xs
-
-prRExp :: Int -> RExp -> ShowS
-prRExp _ (App x []) = prCId x
-prRExp n (App x xs) = p (prCId x . showChar ' ' . prRExpList xs)
-    where p s = if n == 0 then s else showChar '(' . s . showChar ')'
-prRExp _ (AInt x) = shows x
-prRExp _ (AStr x) = showChar '"' . concatS (map mkEsc x) . showChar '"'
-prRExp _ (AFlt x) = showFFloat Nothing x
-prRExp _ AMet = showChar '?'
-
-mkEsc :: Char -> ShowS
-mkEsc s = case s of
-  '"'  -> showString "\\\""
-  '\\' -> showString "\\\\"
-  _    -> showChar s
-
-prRExpList :: [RExp] -> ShowS
-prRExpList = concatS . intersperse (showChar ' ') . map (prRExp 1)
-
-prCId :: CId -> ShowS
-prCId (CId x) = showString x
-
-concatS :: [ShowS] -> ShowS
-concatS = foldr (.) id