diff --git a/src/GF/API.hs b/src/GF/API.hs index ad97fa821..262c65382 100644 --- a/src/GF/API.hs +++ b/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 diff --git a/src/GF/Compile/PGrammar.hs b/src/GF/Compile/PGrammar.hs index 6237b6f25..e2fdebd58 100644 --- a/src/GF/Compile/PGrammar.hs +++ b/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 diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs index 04b6286e9..8400d9af5 100644 --- a/src/GF/Grammar/LookAbs.hs +++ b/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 = diff --git a/src/GF/Grammar/MMacros.hs b/src/GF/Grammar/MMacros.hs index cea8af11a..15e9b3c45 100644 --- a/src/GF/Grammar/MMacros.hs +++ b/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 diff --git a/src/GF/Grammar/TypeCheck.hs b/src/GF/Grammar/TypeCheck.hs index 2445d50ad..45a0d7c36 100644 --- a/src/GF/Grammar/TypeCheck.hs +++ b/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 diff --git a/src/GF/Shell/CommandL.hs b/src/GF/Shell/CommandL.hs index d1ba0f7ba..d470130ab 100644 --- a/src/GF/Shell/CommandL.hs +++ b/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 diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs index 3ba783c3b..71ef3244b 100644 --- a/src/GF/Shell/Commands.hs +++ b/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 diff --git a/src/Today.hs b/src/Today.hs index 1fc48a713..9259ba6b5 100644 --- a/src/Today.hs +++ b/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"