summaryrefslogtreecommitdiff
path: root/src/GF
diff options
context:
space:
mode:
authoraarne <unknown>2003-10-07 15:17:55 +0000
committeraarne <unknown>2003-10-07 15:17:55 +0000
commit889e5a92e4e0c40ab249f9f86d0fa2647132d87a (patch)
treed9dd9687ee2d8a735b65f9b617f3f1a607666615 /src/GF
parent0988010e33fabc02090490b4a562a53fa9a08780 (diff)
Updates for editor. Dummies for hugs.
Diffstat (limited to 'src/GF')
-rw-r--r--src/GF/API.hs7
-rw-r--r--src/GF/Compile/PGrammar.hs5
-rw-r--r--src/GF/Grammar/LookAbs.hs6
-rw-r--r--src/GF/Grammar/MMacros.hs12
-rw-r--r--src/GF/Grammar/TypeCheck.hs1
-rw-r--r--src/GF/Shell/CommandL.hs6
-rw-r--r--src/GF/Shell/Commands.hs5
7 files changed, 24 insertions, 18 deletions
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