Fixed treatment of predefined types (Int, String).

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

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

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"

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

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
+  Q m f  -> lookupFunType gr m f >>= return . vClos
-  Vr i  -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
+  Vr i   -> maybeErr ("unknown variable" +++ prt at) $ lookup i binds
-  _     -> prtBad "cannot refine with complex term" at ---
+  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]
 
 

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 

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',[])

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"

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
--}

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)
 

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 = case s of 
-string2ref gr s = 
+  'x':'_':ds -> return $ freshAsTerm ds --- hack for generated vars
-  if elem '.' s 
+  '"':_:_ -> return $ G.K $ init $ tail s
-    then return $ uncurry G.Q $ strings2Fun s
+  _:_ | all isDigit s -> return $ G.EInt $ read s
-    else return $ G.Vr $ identC s
+  _ | elem '.' s -> return $ uncurry G.Q $ strings2Fun s
+  _ -> return $ G.Vr $ identC s
 
 string2cat :: StateGrammar -> String -> Err G.Cat
 string2cat gr s = 

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"