Updates for editor. Dummies for hugs.

src/GF/API.hs

@@ -20,6 +20,7 @@ import Randomized (mkRandomTree)
 import Zipper
 
 import MMacros
+import qualified Macros as M
 import TypeCheck
 import CMacros
 
@@ -126,8 +127,10 @@ optFile2grammarE = optFile2grammar
 string2treeInState :: GFGrammar -> String -> State -> Err Tree
 string2treeInState gr s st = do
   let metas = allMetas st
-  t <- pTerm s
-  annotate (grammar gr) $ qualifTerm (absId gr) $ refreshMetas metas t
+      xs    = map fst $ actBinds st
+  t0 <- pTerm s
+  let t = qualifTerm (absId gr) $ M.mkAbs xs $ refreshMetas metas $ t0
+  annotateExpInState (grammar gr) t st 
 
 string2srcTerm :: G.SourceGrammar -> I.Ident -> String -> Err G.Term
 string2srcTerm gr m s = do

src/GF/Compile/PGrammar.hs

@@ -9,6 +9,7 @@ import qualified AbsGFC as A
 import qualified GFC as G
 import GetGrammar
 import Macros
+import MMacros
 
 import Operations
 
@@ -46,9 +47,7 @@ string2formsAndTerm s = case s of
 -}
 
 string2ident :: String -> Err Ident
-string2ident s = return $ case s of
-  c:'_':i -> identV (readIntArg i,[c]) ---
-  _ -> zIdent s
+string2ident s = return $ string2var s
 
 {-
 -- reads the Haskell datatype

src/GF/Grammar/LookAbs.hs

@@ -73,9 +73,9 @@ refsForType compat gr binds val =
 funRulesOf :: GFCGrammar -> [(Fun,Type)]
 funRulesOf gr = 
 ----  funRulesForLiterals ++
-  [((i,f),typ) | (i, ModMod m)   <- modules gr,
-                   mtype m == MTAbstract,
-                   (f, C.AbsFun typ _) <- tree2list (jments m)]
+  [((i,f),typ) | (i, ModMod m) <- modules gr,
+                 mtype m == MTAbstract,
+                 (f, C.AbsFun typ _) <- tree2list (jments m)]
 
 allCatsOf :: GFCGrammar -> [(Cat,Context)]
 allCatsOf gr = 

src/GF/Grammar/MMacros.hs

@@ -255,14 +255,20 @@ identVar (Vr x) = return x
 identVar _ = Bad "not a variable"
 
 
--- light-weight rename for user interaction
+-- light-weight rename for user interaction; also change names of internal vars
 
 qualifTerm :: Ident -> Term -> Term
 qualifTerm m  = qualif [] where
   qualif xs t = case t of
-    Abs x b -> Abs x $ qualif (x:xs) b
+    Abs x b -> let x' = chV x in Abs x' $ qualif (x':xs) b
     Prod x a b -> Prod x (qualif xs a) $ qualif (x:xs) b
-    Vr x | notElem x xs -> Q m x 
+    Vr x -> let x' = chV x in if (elem x' xs) then (Vr x') else (Q m x) 
     Cn c  -> Q m c
     Con c -> QC m c
     _ -> composSafeOp (qualif xs) t
+  chV x = string2var $ prIdent x
+    
+string2var :: String -> Ident
+string2var s = case s of
+  c:'_':i -> identV (readIntArg i,[c]) ---
+  _ -> zIdent s

src/GF/Grammar/TypeCheck.hs

@@ -123,6 +123,7 @@ possibleConstraint gr (u,v) = errVal True $ do
  where
   cts t u = isUnknown t || isUnknown u || case (t,u) of
     (Q m c,      Q n d)      -> c == d || notCan (m,c) || notCan (n,d)
+    (QC m c,     QC n d)     -> c == d
     (App f a,    App g b)    -> cts f g && cts a b
     (Abs x b,    Abs y c)    -> cts b c
     (Prod x a f, Prod y b g) -> cts a b && cts f g

src/GF/Shell/CommandL.hs

@@ -78,9 +78,9 @@ pCommand = pCommandWords . words where
     "c" : s : _   -> CTermCommand s
     "a" : _       -> CRefineRandom --- *a*leatoire
     "m" :  _      -> CMenu
-----    "ml" : s : _  -> changeMenuLanguage s
-----    "ms" : s : _  -> changeMenuSize s
-----    "mt" : s : _  -> changeMenuTyped s
+    "ml" : s : _  -> changeMenuLanguage s
+    "ms" : s : _  -> changeMenuSize s
+    "mt" : s : _  -> changeMenuTyped s
     "v" : _       -> CView
     "q" : _       -> CQuit
     "h" : _       -> CHelp initEditMsg

src/GF/Shell/Commands.hs

@@ -3,9 +3,8 @@ module Commands where
 import Operations
 import Zipper
 
-import qualified Grammar as G ---- Cat
+import qualified Grammar as G ---- Cat, Fun
 import GFC
-import qualified AbsGFC ---- Atom
 import CMacros
 import LookAbs
 import Values (loc2treeFocus)----
@@ -19,7 +18,6 @@ import qualified Ident as I
 import qualified PShell
 import qualified Macros as M
 import PrGrammar
-import TypeCheck ---- tree2exp
 import PGrammar
 import IOGrammar
 import UseIO
@@ -400,7 +398,6 @@ displaySStateJavaX env state = unlines $ tagXML "gfedit" $ concat [
   lin (n,gr) = (n, map uni $ linearizeState noWrap opts gr zipper) where
                   uni = optEncodeUTF8 n gr . mkUnicode
   exp    = prprTree $ loc2tree zipper
----  xml    = prExpXML gr $ tree2exp $ loc2tree zipper --- better: dir. from zipper
   zipper = stateSState state
   linAll = map lin lgrs
   gr     = firstStateGrammar env

src/Today.hs

@@ -1 +1 @@
-module Today where today = "Mon Oct  6 11:34:26 CEST 2003"
+module Today where today = "Tue Oct  7 17:59:46 CEST 2003"