Fixed treatment of predefined types (Int, String).

Fixed treatment of predefined types (Int, String).
Added treatment of new reserved words to reading old grammars.

11 files changed, 50 insertions, 16 deletions

diff --git a/src/GF.hs b/src/GF.hs
index 122d52766..bdc9a9fea 100644
--- a/src/GF.hs
+++ b/src/GF.hs
@@ -54,10 +54,8 @@ gfInteract st@(env,_) = do
       gfInteract st'
     Just (ICEditSession,os) -> 
       editSession (addOptions os opts) env >> gfInteract st
-{- -----
     Just (ICTranslateSession,os) -> 
       translateSession (addOptions os opts) env >> gfInteract st
--}
     -- this is a normal command sequence
     _ -> do
       st' <- execLinesH s cs st
diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs
index fb3fbf5ad..a9a40ee06 100644
--- a/src/GF/Compile/GetGrammar.hs
+++ b/src/GF/Compile/GetGrammar.hs
@@ -14,6 +14,7 @@ import SourceToGrammar
 import Option
 --- import Custom
 import ParGF
+import qualified LexGF as L
 
 import ReadFiles ----
 
@@ -57,7 +58,7 @@ parseOldGrammar :: FilePath -> IOE ([FilePath],[A.TopDef])
 parseOldGrammar file = do
   putStrE $ "reading old file" +++ file
   s <- ioeIO $ readFileIf file
-  A.OldGr incl topdefs <- ioeErr $ err2err $ pOldGrammar $ myLexer $ fixNewlines s
+  A.OldGr incl topdefs <- ioeErr $ err2err $ pOldGrammar $ oldLexer $ fixNewlines s
   includes <- ioeErr $ transInclude incl
   return (includes, topdefs)
 
@@ -69,3 +70,13 @@ err2err (E.Bad s) = Bad s
 
 ioeEErr = ioeErr . err2err
 
+-- To resolve the new reserved words: change them by turning the final letter to Z.
+--- There is a risk of clash. 
+
+oldLexer :: String -> [L.Token]
+oldLexer = map change . L.tokens where
+  change t = case t of
+    (L.PT p (L.TS s)) | elem s new -> (L.PT p (L.TV (init s ++ "Z")))
+    _ -> t
+  new = words $ "abstract concrete interface incomplete " ++ 
+                                  "instance out open resource reuse transfer with"
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index 120286d4d..49e08ab6e 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -1,6 +1,7 @@
 module Rename where
 
 import Grammar
+import Values
 import Modules
 import Ident
 import Macros
@@ -78,6 +79,8 @@ renameIdentTerm env@(act,imps) t =
   Vr c -> do
     f <- lookupTreeMany prt opens c
     return $ f c
+  Vr (IC "Int") -> return $ Q cPredefAbs cInt -- Int and String are predefined cats
+  Vr (IC "String") -> return $ Q cPredefAbs cString
   Cn c -> do
     f <- lookupTreeMany prt opens c
     return $ f c
diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
index 43a8c580a..3cd8999ce 100644
--- a/src/GF/Grammar/LookAbs.hs
+++ b/src/GF/Grammar/LookAbs.hs
@@ -75,13 +75,20 @@ isPrimitiveFun gr (m,c) = case lookupAbsDef gr m c of
 
 lookupRef :: GFCGrammar -> Binds -> Term -> Err Val
 lookupRef gr binds at = case at of
-  Q m f -> lookupFunType gr m f >>= return . vClos
-  Vr i  -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
-  _     -> prtBad "cannot refine with complex term" at ---
+  Q m f  -> lookupFunType gr m f >>= return . vClos
+  Vr i   -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
+  EInt _ -> return valAbsInt
+  K _    -> return valAbsString
+  _      -> prtBad "cannot refine with complex term" at ---
 
 refsForType :: (Val -> Type -> Bool) -> GFCGrammar -> Binds -> Val -> [(Term,Val)]
 refsForType compat gr binds val = 
+  -- bound variables
   [(vr i, t) | (i,t) <- binds, Ok ty <- [val2exp t], compat val ty] ++
+  -- integer and string literals
+  [(EInt i, val) | val == valAbsInt, i <- [0,1,2,5,11,1978]] ++
+  [(K s, val) | val == valAbsString, s <- ["foo", "NN", "x"]] ++
+  -- functions defined in the current abstract syntax
   [(qq f, vClos t) | (f,t) <- funsForType compat gr val]
 
 
diff --git a/src/GF/Grammar/TC.hs b/src/GF/Grammar/TC.hs
index 88e66379c..b031fa080 100644
--- a/src/GF/Grammar/TC.hs
+++ b/src/GF/Grammar/TC.hs
@@ -119,6 +119,8 @@ inferExp th tenv@(k,rho,gamma) e = case e of
   Vr x -> mkAnnot (AVr x) $ noConstr $ lookupVar gamma x
   Q m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c)
   QC m c -> mkAnnot (ACn (m,c)) $ noConstr $ lookupConst th (m,c) ----
+  EInt i -> return (AInt i, valAbsInt, [])
+  K i -> return (AStr i, valAbsString, [])
   Sort _ -> return (AType, vType, [])
   App f t -> do
     (f',w,csf) <- inferExp th tenv f 
diff --git a/src/GF/Grammar/TypeCheck.hs b/src/GF/Grammar/TypeCheck.hs
index 45a0d7c36..53bf426c8 100644
--- a/src/GF/Grammar/TypeCheck.hs
+++ b/src/GF/Grammar/TypeCheck.hs
@@ -162,6 +162,10 @@ aexp2tree (aexp,cs) = do
      ACn c v -> do
        v' <- whnf v ---- 
        return ([],AtC c,v',[])
+     AInt i -> do
+       return ([],AtI i,valAbsInt,[])
+     AStr s -> do
+       return ([],AtL s,valAbsString,[])
      AMeta m v -> do
        v' <- whnf v ---- 
        return ([],AtM m,v',[])
diff --git a/src/GF/Grammar/Values.hs b/src/GF/Grammar/Values.hs
index 9df2fc13e..4d787488d 100644
--- a/src/GF/Grammar/Values.hs
+++ b/src/GF/Grammar/Values.hs
@@ -31,11 +31,18 @@ type MetaSubst = [(MetaSymb,Val)]
 
 -- for TC
 
+valAbsInt, valAbsString :: Val
+valAbsInt = VCn (cPredefAbs, cInt)
+valAbsString = VCn (cPredefAbs, cString)
+
 vType :: Val
 vType = VType
 
-cType :: Ident
+cType,cPredefAbs,cInt,cString :: Ident
 cType = identC "Type" --- #0
+cPredefAbs = identC "PredefAbs"
+cInt = identC "Int"
+cString = identC "String"
 
 eType :: Exp
 eType = Sort "Type"
diff --git a/src/GF/Shell/SubShell.hs b/src/GF/Shell/SubShell.hs
index c910d3dd0..1b8a647df 100644
--- a/src/GF/Shell/SubShell.hs
+++ b/src/GF/Shell/SubShell.hs
@@ -21,7 +21,7 @@ editSession opts st
 
 myUniFont = "-mutt-clearlyu-medium-r-normal--0-0-100-100-p-0-iso10646-1"
 mkOptFont = id
-{- ----
+
 translateSession :: Options -> ShellState -> IO ()
 translateSession opts st = do
   let grs   = allStateGrammars st
@@ -40,4 +40,3 @@ translateLoop opts trans = do
      if s == "." then return () else do
        putStrLnFlush $ trans s
        loopLine
--}
diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index 1b4185796..d38701eb6 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -38,7 +38,7 @@ forName (MTConcrete a) = tri a
 
 trOpen :: OpenSpec Ident -> P.Open
 trOpen o = case o of
-  OSimple OQNormal i -> P.OQualQO P.QOCompl (tri i)
+  OSimple OQNormal i -> P.OName (tri i)
   OSimple q i -> P.OQualQO (trQualOpen q) (tri i)
   OQualif q i j -> P.OQual (trQualOpen q) (tri i) (tri j)
 
diff --git a/src/GF/UseGrammar/GetTree.hs b/src/GF/UseGrammar/GetTree.hs
index 9ad91c21f..0db35baf2 100644
--- a/src/GF/UseGrammar/GetTree.hs
+++ b/src/GF/UseGrammar/GetTree.hs
@@ -13,6 +13,8 @@ import ShellState
 
 import Operations
 
+import Char
+
 -- how to form linearizable trees from strings and from terms of different levels
 --
 -- String --> raw Term --> annot, qualif Term --> Tree
@@ -39,11 +41,12 @@ strings2Cat s = (identC m, identC (drop 1 c)) where (m,c) = span (/= '.') s
 strings2Fun = strings2Cat
 
 string2ref :: StateGrammar -> String -> Err G.Term
-string2ref _ ('x':'_':ds) = return $ freshAsTerm ds --- hack for generated vars
-string2ref gr s = 
-  if elem '.' s 
-    then return $ uncurry G.Q $ strings2Fun s
-    else return $ G.Vr $ identC s
+string2ref gr s = case s of 
+  'x':'_':ds -> return $ freshAsTerm ds --- hack for generated vars
+  '"':_:_ -> return $ G.K $ init $ tail s
+  _:_ | all isDigit s -> return $ G.EInt $ read s
+  _ | elem '.' s -> return $ uncurry G.Q $ strings2Fun s
+  _ -> return $ G.Vr $ identC s
 
 string2cat :: StateGrammar -> String -> Err G.Cat
 string2cat gr s = 
diff --git a/src/Today.hs b/src/Today.hs
index b1a3f414b..4d0cffe81 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Wed Nov  5 13:15:35 CET 2003"
+module Today where today = "Fri Nov  7 16:15:47 CET 2003"