Some bug fixes mostly in editor commands.

grammars/numerals/old/transNum.gfs

@@ -53,4 +53,29 @@ i -old -abs=Nums -cnc=Tamil tamil.gf
 i -old -abs=Nums -cnc=Tibetan tibetan.gf
 i -old -abs=Nums -cnc=Totonac totonac.gf
 i -old -abs=Nums -cnc=Turkish turkish.gf
+i -old -abs=Nums -cnc=AfTunni af_tunni.gf
+i -old -abs=Nums -cnc=Albanian albanian.gf
+i -old -abs=Nums -cnc=BearlakeSlave bearlake_slave.gf
+i -old -abs=Nums -cnc=Dagur dagur.gf
+i -old -abs=Nums -cnc=Fulfulde fulfulde.gf
+i -old -abs=Nums -cnc=Guahibo guahibo.gf
+i -old -abs=Nums -cnc=Guarani guarani.gf
+i -old -abs=Nums -cnc=Kabardian kabardian.gf
+i -old -abs=Nums -cnc=Kambera kambera.gf
+i -old -abs=Nums -cnc=Kawaiisu kawaiisu.gf
+i -old -abs=Nums -cnc=KolymaYukaghir kolyma_yukaghir.gf
+i -old -abs=Nums -cnc=Kwaza kwaza.gf
+i -old -abs=Nums -cnc=Lithuanian lithuanian.gf
+i -old -abs=Nums -cnc=Lotuxo lotuxo.gf
+i -old -abs=Nums -cnc=Maale maale.gf
+i -old -abs=Nums -cnc=Maltese maltese.gf
+i -old -abs=Nums -cnc=Mapuche mapuche.gf
+i -old -abs=Nums -cnc=Maybrat maybrat.gf
+i -old -abs=Nums -cnc=Miya miya.gf
+i -old -abs=Nums -cnc=Nenets nenets.gf
+i -old -abs=Nums -cnc=Sango sango.gf
+i -old -abs=Nums -cnc=TukangBesi tukang_besi.gf
+i -old -abs=Nums -cnc=Welsh welsh.gf
+i -old -abs=Nums -cnc=YasinBurushaski yasin_burushaski.gf
+
 ---ts -f

src/GF/API.hs

@@ -264,7 +264,7 @@ optPrintSyntax opts = customOrDefault opts grammarPrinter customSyntaxPrinter
 prCanonGrammar :: CanonGrammar -> String
 prCanonGrammar = MC.prCanon
 
-{- ----
+
 optPrintTree :: Options -> GFGrammar -> Tree -> String
 optPrintTree opts = customOrDefault opts grammarPrinter customTermPrinter
 
@@ -274,11 +274,11 @@ optStringCommand opts g =
   optIntOrAll opts flagLength .  
   customOrDefault opts filterString customStringCommand g
 
-optTreeCommand :: Options -> GFGrammar -> Tree -> [Tree]
+optTermCommand :: Options -> GFGrammar -> Tree -> [Tree]
-optTreeCommand opts st = 
+optTermCommand opts st = 
   optIntOrAll opts flagNumber .  
   customOrDefault opts termCommand customTermCommand st
--}
+
 
 {-
 -- wraps term in a function and optionally computes the result

src/GF/Compile/ShellState.hs

@@ -28,7 +28,7 @@ import List (nub,nubBy)
 data ShellState = ShSt {
   abstract   :: Maybe Ident ,        -- pointer to actual abstract, if not empty st
   concrete   :: Maybe Ident ,        -- pointer to primary concrete
-  concretes  :: [(Ident,Ident)],     -- list of all concretes
+  concretes  :: [((Ident,Ident),Bool)], -- list of all concretes, and whether active
   canModules :: CanonGrammar ,       -- compiled abstracts and concretes
   srcModules :: G.SourceGrammar ,    -- saved resource modules
   cfs        :: [(Ident,CF)] ,       -- context-free grammars
@@ -133,7 +133,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
   return $ ShSt {
     abstract   = abstr0, 
     concrete   = concr0, 
-    concretes  = zip concrs concrs,
+    concretes  = zip (zip concrs concrs) (repeat True),
     canModules = cgr,
     srcModules = src,
     cfs        = zip concrs cfs,
@@ -148,7 +148,7 @@ prShellStateInfo :: ShellState -> String
 prShellStateInfo sh = unlines [
   "main abstract :    " +++ abstractName sh,
   "main concrete :    " +++ maybe "(none)" P.prt (concrete sh),
-  "all concretes :    " +++ unwords (map (P.prt . fst) (concretes sh)),
+  "all concretes :    " +++ unwords (map (P.prt . fst) (map fst (concretes sh))),
   "canonical modules :" +++ unwords (map (P.prt .fst) (M.modules (canModules sh))),
   "source modules :   " +++ unwords (map (P.prt .fst) (M.modules (srcModules sh))),
   "global options :   " +++ prOpts (gloptions sh)
@@ -177,7 +177,7 @@ purgeShellState :: ShellState -> ShellState
 purgeShellState sh = ShSt {
   abstract   = abstract sh,
   concrete   = concrete sh,
-  concretes  = [(a,i) | (a,i) <- concretes sh, elem i needed],
+  concretes  = [((a,i),b) | ((a,i),b) <- concretes sh, elem i needed],
   canModules = M.MGrammar $ purge $ M.modules $ canModules sh,
   srcModules = M.emptyMGrammar,
   cfs        = cfs sh,
@@ -190,7 +190,7 @@ purgeShellState sh = ShSt {
  where
    needed = nub $ concatMap (requiredCanModules (canModules sh)) acncs
    purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
-   acncs = maybe [] singleton (abstract sh) ++ map snd (concretes sh)
+   acncs = maybe [] singleton (abstract sh) ++ map (snd . fst) (concretes sh)
 
 -- form just one state grammar, if unique, from a canonical grammar
 
@@ -259,22 +259,21 @@ stateAbstractGrammar st = StGr {
 
 -- analysing shell state into parts
 globalOptions = gloptions
-allLanguages  = map fst . concretes
+allLanguages  = map (fst . fst) . concretes
 
 allStateGrammars = map snd . allStateGrammarsWithNames
 
-allStateGrammarsWithNames st = [(c, mkStateGrammar st c) | (c,_) <- concretes st]
+allStateGrammarsWithNames st = 
-
+  [(c, mkStateGrammar st c) | ((c,_),_) <- concretes st]
-allGrammarFileNames st = [prLanguage c ++ ".gf" | (c,_) <- concretes st] ---
-
-{-
-allActiveStateGrammarsWithNames (ShSt (ma,gs,_)) = 
-  [(l, mkStateGrammar a c) | (l,((_,True),c)) <- gs, Just a <- [ma]]
 
+allGrammarFileNames st = [prLanguage c ++ ".gf" | ((c,_),_) <- concretes st] ---
 
+allActiveStateGrammarsWithNames st =   
+  [(c, mkStateGrammar st c) | ((c,_),True) <- concretes st]
 
 allActiveGrammars = map snd . allActiveStateGrammarsWithNames
 
+{-
 allGrammarSTs = map stateGrammarST . allStateGrammars
 allCFs        = map stateCF        . allStateGrammars
 
@@ -370,14 +369,15 @@ type ShellStateOper = ShellState -> ShellState
 reinitShellState :: ShellStateOper
 reinitShellState = const emptyShellState
 
-{-
 languageOn  = languageOnOff True
 languageOff = languageOnOff False
 
 languageOnOff :: Bool -> Language -> ShellStateOper
-languageOnOff b lang (ShSt (ab,gs,os)) = ShSt (ab, gs', os) where
+languageOnOff b lang (ShSt a c cs cg sg cfs ms os fs cats sts) =
-  gs' = [if lang==l then (l,((f,b),g)) else i | i@(l,((f,_),g)) <- gs]
+  ShSt a c cs' cg sg cfs ms os fs cats sts where
+  cs' = [if lang==l then ((l,c),b) else i | i@((l,c),_) <- cs]
 
+{-
 updateLanguage :: FilePath -> (Language, StateConcrete) -> ShellStateOper
 updateLanguage file (lang,gr) (ShSt (ab,gs,os)) = 
   ShSt (ab, updateAssoc (lang,((file,True),gr)) gs, os') where

src/GF/Grammar/LookAbs.hs

@@ -119,6 +119,11 @@ funsOnTypeFs compat fs val = [((fun,i),typ) |
                                         (i,arg) <- zip [0..] (map snd args),
                                         compat val arg]
 
+allDefs :: GFCGrammar -> [(Fun,Term)]
+allDefs gr = [((i,c),d) | (i, ModMod m) <- modules gr,
+                    isModAbs m,
+                    (c, C.AbsFun _ d) <- tree2list (jments m)]
+
 -- this is needed at compile time
 
 lookupFunTypeSrc :: Grammar -> Ident -> Ident -> Err Type

src/GF/Grammar/PrGrammar.hs

@@ -29,6 +29,11 @@ class Print a where
   prt_ = prt
   prpr = return . prt
 
+-- 8/1/2004
+--- Usually followed principle: prt_ for displaying in the editor, prt
+--- in writing grammars to a file. For some constructs, e.g. prMarkedTree,
+--- only the former is ever needed.
+
 -- to show terms etc in error messages
 prtBad :: Print a => String -> a -> Err b
 prtBad s a = Bad (s +++ prt a)
@@ -92,14 +97,18 @@ instance Print TrNode where
     prBinds bi ++ 
     prt at +++ ":" +++ prt vt 
     +++ prConstraints cs +++ prMetaSubst ms
+  prt_ (N (bi,at,vt,(cs,ms),_)) = 
+    prBinds bi ++ 
+    prt_ at +++ ":" +++ prt_ vt 
+    +++ prConstraints cs +++ prMetaSubst ms
 
 prMarkedTree :: Tr (TrNode,Bool) -> [String]
 prMarkedTree = prf 1 where
   prf ind t@(Tr (node, trees)) = 
     prNode ind node : concatMap (prf (ind + 2)) trees
   prNode ind node = case node of
-    (n, False) -> indent ind (prt n)
+    (n, False) -> indent ind (prt_ n)
-    (n, _)     -> '*' : indent (ind - 1) (prt n)
+    (n, _)     -> '*' : indent (ind - 1) (prt_ n)
 
 prTree :: Tree -> [String]
 prTree = prMarkedTree . mapTr (\n -> (n,False))
@@ -111,9 +120,9 @@ prprTree :: Tree -> [String]
 prprTree = prf False where
   prf par t@(Tr (node, trees)) = 
     parIf par (prn node : concat [prf (ifPar t) t | t <- trees])
-  prn (N (bi,at,_,_,_)) = prb bi ++ prt at
+  prn (N (bi,at,_,_,_)) = prb bi ++ prt_ at
   prb [] = ""
-  prb bi = "\\" ++ concat (intersperse "," (map (prt . fst) bi)) ++ " -> "
+  prb bi = "\\" ++ concat (intersperse "," (map (prt_ . fst) bi)) ++ " -> "
   parIf par (s:ss) = map (indent 2) $
                          if par 
                             then ('(':s) : ss ++ [")"] 
@@ -144,15 +153,15 @@ prBinds bi = if null bi
                 then [] 
                 else "\\" ++ concat (intersperse "," (map prValDecl bi)) +++ "-> "
  where
-   prValDecl (x,t) = prParenth (prt x +++ ":" +++ prt t)
+   prValDecl (x,t) = prParenth (prt_ x +++ ":" +++ prt_ t)
 
 instance Print Val where
   prt (VGen i x) = prt x ---- ++ "-$" ++ show i ---- latter part for debugging
   prt (VApp u v) = prt u +++ prv1 v
-  prt (VCn mc) = prQIdent mc
+  prt (VCn mc) = prQIdent_ mc
   prt (VClos env e) = case e of
-    Meta _ -> prt e ++ prEnv env
+    Meta _ -> prt_ e ++ prEnv env
-    _      -> prt e ---- ++ prEnv env ---- for debugging
+    _      -> prt_ e ---- ++ prEnv env ---- for debugging
  
 prv1 v = case v of
   VApp _ _  -> prParenth $ prt v
@@ -165,10 +174,15 @@ instance Print Atom where
   prt (AtV i) = prt i
   prt (AtL s) = s
   prt (AtI i) = show i
+  prt_ (AtC f) = prQIdent_ f 
+  prt_ a = prt a
 
 prQIdent :: QIdent -> String
 prQIdent (m,f) = prt m ++ "." ++ prt f
 
+prQIdent_ :: QIdent -> String
+prQIdent_ (_,f) = prt f
+
 -- print terms without qualifications
 
 prExp :: Term -> String

src/GF/Grammar/TypeCheck.hs

@@ -240,3 +240,6 @@ exp2termCommand gr f t = errIn ("modifying term" +++ prt t) $ do
   let exp = tree2exp t
   exp2 <- f exp
   annotate gr exp2
+
+exp2termlistCommand :: GFCGrammar -> (Exp -> [Exp]) -> Tree -> [Tree]
+exp2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f . tree2exp

src/GF/Shell.hs

@@ -171,7 +171,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
   CGenerateRandom n -> do
     ts <- randomTreesIO opts gro (optIntOrN opts flagNumber n)
     returnArg (ATrms ts) sa
------  CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro) . s2t) sa
+  CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro) . s2t) sa
 -----  CWrapTerm f -> changeArg (opTT2CommandArg (return . wrapByFun opts gro f)) sa
   CMorphoAnalyse -> changeArg (AString . morphoAnalyse opts gro . prCommandArg) sa
   CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa

src/GF/Shell/CommandL.hs

@@ -66,8 +66,8 @@ pCommand = pCommandWords . words where
     "+" : _       -> CLast
     "mp" : p      -> CMovePosition (readIntList (unwords p))
     "r" : f : _   -> CRefineWithAtom f
-    "w" : f:i : _ -> CWrapWithFun (strings2Fun f, readIntArg i)
+    "w" : f:i : _ -> CWrapWithFun (f, readIntArg i)
-    "ch": f : _   -> CChangeHead (strings2Fun f)
+    "ch": f : _   -> CChangeHead f
     "ph": _       -> CPeelHead
     "x" : ws      -> CAlphaConvert $ unwords ws
     "s" : i : _   -> CSelectCand (readIntArg i)

src/GF/Shell/Commands.hs

@@ -37,7 +37,7 @@ import Option
 import Str (sstr) ----
 
 import Random (mkStdGen, newStdGen)
-import Monad (liftM2)
+import Monad (liftM2, foldM)
 import List (intersperse)
 
 --- temporary hacks for GF 2.0
@@ -60,8 +60,8 @@ data Command =
  | CRefineWithClip Int
  | CRefineWithAtom String
  | CRefineParse String
- | CWrapWithFun (G.Fun,Int)
+ | CWrapWithFun (String,Int)
- | CChangeHead G.Fun
+ | CChangeHead String
  | CPeelHead
  | CAlphaConvert String
  | CRefineRandom
@@ -127,13 +127,9 @@ execCommand env c s = case c of
     st <- shellStateFromFiles opts env file
     return (st,s)
 
-{- ----
+  CCEnvEmptyAndImport file -> useIOE (emptyShellState, initSState) $ do
-  CCEnvEmptyAndImport file -> do
+    st <- shellStateFromFiles opts emptyShellState file
-    gr <- optFile2grammar noOptions Nothing file
+    return (st,s)
-    let lan = getLangNameOpt noOptions file
-    return (updateLanguage file (lan, getStateConcrete gr) 
-                 (initWithAbstract (stateAbstract gr) emptyShellState), initSState)
--}
 
   CCEnvEmpty -> do
     return (emptyShellState, initSState)
@@ -143,33 +139,20 @@ execCommand env c s = case c of
     (msg,(env',_)) <- Shell.execLines False cs (Shell.initHState env)
     return (env', changeMsg msg s) ----
 
-{- ----
   CCEnvOpenTerm file -> do
     c <- readFileIf file
     let (fs,t) = envAndTerm file c
-
+    env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs
-    env' <- shellStateFromFiles noOptions fs
+    return (env', execECommand env' (CNewTree t) s)
-    return (env', (action2commandNext $ \x -> 
-                      (string2treeErr (grammarCEnv env') t x >>= 
-                                                      \t -> newTree t x)) s)
 
   CCEnvOpenString file -> do
     c <- readFileIf file
     let (fs,t) = envAndTerm file c
-    env' <- shellStateFromFiles noOptions fs
+    env' <- useIOE env $ foldM (shellStateFromFiles noOptions) env fs
-    let gr   = grammarCEnv env'
+    return (env', execECommand env' (CRefineParse t) s)
-        sgr  = firstStateGrammar env'
-        agrs = allActiveGrammars env'
-        cat  = firstCatOpts (stateOptions sgr) sgr
-    state0 <- err (const $ return (stateSState s)) return $
-                   newCat gr (cfCat2Cat cat) $ stateSState s
-    state1 <- return $ 
-                   refineByExps True gr (parseAny agrs cat t) $ changeState state0 s
-    return (env', state1)
--}
 
-  CCEnvOn  name -> return (env,s) ---- return (languageOn  (language name) env,s)
+  CCEnvOn  name -> return (languageOn  (language name) env,s)
-  CCEnvOff name -> return (env,s) ---- return (languageOff (language name) env,s)
+  CCEnvOff name -> return (languageOff (language name) env,s)
 
 -- this command is improved by the use of IO
   CRefineRandom -> do
@@ -220,8 +203,8 @@ execECommand env c = case c of
                           t  <- string2ref gr s
                           s' <- refineWithAtom der cgr t x
                           uniqueRefinements cgr s'
-  CWrapWithFun fi    -> action2commandNext $ wrapWithFun cgr fi
+  CWrapWithFun (f,i) -> action2commandNext $ wrapWithFun cgr (qualif f, i)
-  CChangeHead f      -> action2commandNext $ changeFunHead cgr f
+  CChangeHead f      -> action2commandNext $ changeFunHead cgr (qualif f)
   CPeelHead          -> action2commandNext $ peelFunHead cgr
 
   CAlphaConvert s    -> action2commandNext $ \x ->
@@ -268,12 +251,13 @@ execECommand env c = case c of
   _                  -> changeMsg ["command not yet implemented"]
  where
    sgr  = firstStateGrammar env 
-   agrs = allStateGrammars env ---- allActiveGrammars env
+   agrs = allActiveGrammars env
    cgr  = canCEnv env
    gr   = grammarCEnv env
    der  = maybe True not $ caseYesNo (globalOptions env) noDepTypes
           -- if there are dep types, then derived refs;  deptypes is the default
    abs = absId sgr
+   qualif = string2Fun gr
 
 --
 
@@ -298,9 +282,12 @@ mkRefineMenuAll :: CEnv -> SState -> [(Command,(String,String))]
 mkRefineMenuAll env sstate = 
   case (refinementsState cgr state, candsSState sstate, wrappingsState cgr state) of
     ([],[],wraps) -> 
-       [(CWrapWithFun fi, prWrap fit)     | fit@(fi,_) <- wraps] ++
+       [(CWrapWithFun (prQIdent_ f, i), prWrap fit)     
-       [(CChangeHead f,   prChangeHead f) | f <- headChangesState cgr state] ++
+         | fit@((f,i),_) <- wraps] ++
-       [(CPeelHead,    (ifShort "ph" "PeelHead", "ph")) | canPeelState cgr state] ++
+       [(CChangeHead (prQIdent_ f),  prChangeHead f) 
+         | f <- headChangesState cgr state] ++
+       [(CPeelHead,    (ifShort "ph" "PeelHead", "ph")) 
+         | canPeelState cgr state] ++
        [(CDelete,      (ifShort "d"  "Delete",   "d"))] ++
        [(CAddClip,     (ifShort "ac" "AddClip",  "ac"))]
     (refs,[],_)   -> 
@@ -311,18 +298,18 @@ mkRefineMenuAll env sstate =
 
  where
   prRef (f,t) = 
-    (ifShort "r" "Refine" +++ prOrLinRef f +++ ifTyped (":" +++ prt t),
+    (ifShort "r" "Refine" +++ prOrLinRef f +++ ifTyped (":" +++ prt_ t),
      "r" +++ prRefinement f)
   prClip i t =
     (ifShort "rc" "Paste" +++ prOrLinTree t,
      "rc" +++ show i)
   prChangeHead f = 
     (ifShort "ch" "ChangeHead" +++ prOrLinFun f,
-     "ch" +++ prQIdent f)
+     "ch" +++ prQIdent_ f)
   prWrap ((f,i),t) = 
     (ifShort "w" "Wrap"   +++ prOrLinFun f +++ ifTyped (":" +++ prt t) +++
      ifShort (show i) (prBracket (show i)),
-     "w" +++ prQIdent f +++ show i)
+     "w" +++ prQIdent_ f +++ show i)
   prCand (t,i) = 
     (ifShort ("s" +++ prOrLinExp t) ("Select" +++ prOrLinExp t),"s" +++ show i)
 
@@ -335,14 +322,14 @@ mkRefineMenuAll env sstate =
     _ -> b
   ifShort = ifOpt sizeDisplay "short"
   ifTyped t = ifOpt typeDisplay "typed" t ""
-  prOrLinExp t = prt t ---- 
+  prOrLinExp t = prt_ t ---- 
   prOrLinRef t = case t of
     G.Q m f  ->  printname env sstate (m,f) 
     G.QC m f ->  printname env sstate (m,f) 
-    _ -> prt t
+    _ -> prt_ t
   prOrLinFun = printname env sstate
   prOrLinTree t = case getOptVal opts menuDisplay of
-    Just "Abs" -> prTermOpt opts $ tree2exp t
+    Just "Abs" -> prt_ $ tree2exp t ---- prTermOpt opts $ tree2exp t
     Just lang  -> prQuotedString $ lin lang t
     _ -> prTermOpt opts $ tree2exp t
   lin lang t = optLinearizeTreeVal opts (stateGrammarOfLang env (language lang)) t
@@ -422,7 +409,7 @@ displaySStateJavaX isNew env state = unlines $ tagXML "gfedit" $ concat [
   (tree,msg,menu) = displaySState env state
   menu'  = [tagXML "show" [s] ++ tagXML "send" [c] | (s,c) <- menu] 
   (ls,grs) = unzip $ lgrs
-  lgrs   = allStateGrammarsWithNames env ---- allActiveStateGrammarsWithNames env
+  lgrs   = allActiveStateGrammarsWithNames env
   lins   = (langAbstract, exp) : linAll
   opts   = addOptions (optsSState state)   -- state opts override 
               (addOption (markLin mark) (globalOptions env))
@@ -459,12 +446,12 @@ menuSState env state = [(s,c) | (_,(s,c)) <- mkRefineMenuAll env state]
 
 printname :: CEnv -> SState -> G.Fun -> String
 printname env state f = case getOptVal opts menuDisplay of
-  Just "Abs" -> prQIdent f
+  Just "Abs" -> prQIdent_ f
   Just lang  -> printn lang f
-  _ -> prTermOpt opts (qq f)
+  _ -> prQIdent_ f ---- prTermOpt opts (qq f)
  where
   opts = addOptions (optsSState state) (globalOptions env)
-  printn lang f = err id (ifNull (prQIdent f) (sstr . head)) $ do
+  printn lang f = err id (ifNull (prQIdent_ f) (sstr . head)) $ do
     t  <- lookupPrintname gr mf 
     strsFromTerm t
    where

src/GF/UseGrammar/Custom.hs

@@ -184,7 +184,8 @@ customTermCommand =
   ,(strCI "compute",    \g t -> let gr = grammar g in
                                   err (const [t]) return 
                                     (exp2termCommand gr (computeAbsTerm gr) t))
-----  ,(strCI "paraphrase", \g t -> mkParaphrases g t)
+  ,(strCI "paraphrase", \g t -> let gr = grammar g in
+                                  exp2termlistCommand gr (mkParaphrases gr) t)
 ----  ,(strCI "typecheck",  \g t -> err (const []) return (checkIfValidExp g t))
   ,(strCI "solve",      \g t -> err (const [t]) (return . loc2tree)
                                    (uniqueRefinements (grammar g) (tree2loc t)))

src/GF/UseGrammar/Paraphrases.hs

@@ -1,41 +1,40 @@
 module Paraphrases (mkParaphrases) where
 
-import Operations
+import Abstract
-import AbsGFC
+import PrGrammar
-import GFC
+import LookAbs
-import Look
-import CMacros ---- (mkApp, eqStrIdent)
 import AbsCompute
+
+import Operations
+
 import List (nub)
 
 -- paraphrases of GF terms. AR 6/10/1998 -- 24/9/1999 -- 5/7/2000 -- 5/6/2002
 -- Copyright (c) Aarne Ranta 1998--99, under GNU General Public License (see GPL)
 -- thus inherited from the old GF. Incomplete and inefficient...
 
-mkParaphrases :: CanonGrammar -> Exp -> [Exp]
+mkParaphrases :: GFCGrammar -> Term -> [Term]
-mkParaphrases st t = [t]
+mkParaphrases st = nub . map (beta []) . paraphrases (allDefs st)
----- mkParaphrases st = nub . map (beta []) . paraphrases (allDefs st)
 
-{- ----
+type Definition = (Fun,Term)
-type Definition = (Fun,Trm)
 
-paraphrases :: [Definition] -> Trm -> [Trm]
+paraphrases :: [Definition] -> Term -> [Term]
 paraphrases th t =
-  t :
   paraImmed th t ++
 ---  paraMatch th t ++
   case t of
     App c a -> [App d b | d <- paraphrases th c, b <- paraphrases th a]
     Abs x b -> [Abs x d | d <- paraphrases th b]
     c       -> []
+  ++ [t]
 
-paraImmed :: [Definition] -> Trm -> [Trm]
+paraImmed :: [Definition] -> Term -> [Term]
 paraImmed defs t = 
-  [Cn f | (f, u) <- defs, t == u] ++ --- eqTerm
+  [Q m f | ((m,f), u) <- defs, t == u] ++ --- eqTerm
   case t of
-    Cn c -> [u | (f, u) <- defs, eqStrIdent f c]
+  ----  Cn c -> [u | (f, u) <- defs, eqStrIdent f c]
     _    -> []
--}
+
 {- ---
 paraMatch :: [Definition] -> Trm -> [Trm]
 paraMatch th@defs t = 

src/Today.hs

@@ -1 +1 @@
-module Today where today = "Mon Jan  5 11:31:04 CET 2004"
+module Today where today = "Thu Jan  8 16:37:47 CET 2004"