Ints n

examples/gfcc/ImperC.gf

@@ -36,10 +36,10 @@ concrete ImperC of Imper = open ResImper in {
     EVar  _ x  = constant x.s ;
     EInt    n  = constant n.s ;
     EFloat a b = constant (a.s ++ "." ++ b.s) ;
-    EMul _     = infixL P2 "*" ;
+    EMul _     = infixL 3 "*" ;
-    EAdd _     = infixL P1 "+" ;
+    EAdd _     = infixL 2 "+" ;
-    ESub _     = infixL P1 "-" ;
+    ESub _     = infixL 2 "-" ;
-    ELt _      = infixN P0 "<" ;
+    ELt _      = infixN 1 "<" ;
 
     EApp args val f exps = constant (f.s ++ paren exps.s) ;
 

examples/gfcc/ResImper.gf

@@ -1,33 +1,28 @@
-resource ResImper = {
+resource ResImper = open Predef in {
 
   -- precedence
 
-  param
+  oper 
-    Prec = P0 | P1 | P2 | P3 ;
+    Prec     : PType = Predef.Ints 4 ;
-  oper
+    PrecExp  : Type = {s : Prec => Str} ;
-    PrecExp   : Type = {s : Prec => Str} ;
+    ex       : PrecExp -> Str = \exp -> exp.s ! 0 ;
-    ex        : PrecExp -> Str = \exp -> exp.s ! P0 ;
+    constant : Str -> PrecExp = \c -> {s = \\_ => c} ;
-    constant  : Str -> PrecExp = \c -> {s = \\_ => c} ;
     infixN : Prec -> Str -> PrecExp -> PrecExp -> PrecExp = \p,f,x,y ->
-      {s = \\k => mkPrec (x.s ! (nextPrec ! p) ++ f ++ y.s ! (nextPrec ! p)) ! p ! k} ;
+      {s = mkPrec (x.s ! (nextPrec ! p) ++ f ++ y.s ! (nextPrec ! p)) ! p} ;
     infixL : Prec -> Str -> PrecExp -> PrecExp -> PrecExp = \p,f,x,y ->
       {s = mkPrec (x.s ! p ++ f ++ y.s ! (nextPrec ! p)) ! p} ;
 
-    nextPrec : Prec => Prec = table {P0 => P1 ; P1 => P2 ; _ => P3} ;
+    nextPrec : Prec => Prec = table {
-    mkPrec : Str -> Prec => Prec => Str = \str -> table {
+      4 => 4 ; 
-      P3 => table {                -- use the term of precedence P3...
+      n => Predef.plus n 1
-        _   => str} ;              -- ...always without parentheses
-      P2 => table {                -- use the term of precedence P2...
-        P3  => paren str ;     -- ...in parentheses if P3 is expected...
-        _   => str} ;              -- ...otherwise without parentheses
-      P1 => table {
-        P3 | P2 => paren str ;
-        _  => str} ;
-      P0 => table {
-        P0  => str ;
-        _   => paren str}
       } ;
 
+    mkPrec : Str -> Prec => Prec => Str = \str -> 
+      \\p,q => case Predef.lessInt p q of {
+        Predef.PTrue => paren str ;
+        _ => str
+        } ;
+
   -- string operations
 
     SS  : Type = {s : Str} ;

examples/gfcc/compiler/CleanJVM.hs

@@ -0,0 +1,30 @@
+module Main where
+
+import System
+
+main :: IO ()
+main = do
+  jvm:src:_ <- getArgs
+  s <- readFile jvm
+  let obj = takeWhile (/='.') src ++ ".j"
+  writeFile obj $ mkJVM s
+  putStrLn $ "wrote file " ++ obj
+
+mkJVM :: String -> String
+mkJVM = unlines . reverse . fst . foldl trans ([],([],0)) . lines where
+  trans (code,(env,v)) s = case words s of
+    ".method":f:ns -> ((".method " ++ f ++ concat ns):code,([],0))
+    "alloc":t:x:_  -> (code, ((x,v):env, v + size t))
+    ".limit":"locals":ns -> chCode (".limit locals " ++ show (length ns - 1))
+    t:"_load" :x:_ -> chCode (t ++ "load "  ++ look x) 
+    t:"_store":x:_ -> chCode (t ++ "store " ++ look x)
+    t:"_return":_  -> chCode (t ++ "return")
+    "goto":ns      -> chCode ("goto " ++ concat ns)
+    "ifzero":ns    -> chCode ("ifzero " ++ concat ns) 
+    _ ->   chCode s
+   where
+     chCode c = (c:code,(env,v))
+     look x = maybe (x ++ show env) show $ lookup x env
+     size t = case t of
+       "d" -> 2
+       _ -> 1

examples/gfcc/compiler/FILES

@@ -0,0 +1,39 @@
+GF sources:
+----------
+Imper.gf      -- abstract syntax of an imperative language
+ImperC.gf     -- concrete syntax for C notation
+ImperJVM.gf   -- concrete syntax for JVM notation
+ResImper.gf   -- resource module for concrete syntaxes
+
+Scripts:
+-------
+gfcc          -- the main compiler executable reading Foo.c ; shell script
+typecheck.gfs -- the type checker and constraint solver ; GF editor script
+CleanJVM.hs   -- cleans up jvm.tmp to produce Foo.j ; Haskell module
+makefile      -- builds the compiler from GF source ; Unix Make file
+
+Generated files:
+---------------
+Imper.gfcm    -- canonical multilingual GF grammar for C and JVM
+ImperC.cf     -- LBNF grammar for C generated from Imper.gfcm
+gft.tmp       -- parse result generated by the compiler front end
+jvm.tmp       -- pseudo-JVM produced by GF linearization
+
+Required programs to use the compiler:
+-------------------------------------
+gf+       -- Grammatical Framework version 2.0+, >= 23/9/2004
+jasmin    -- JVM assembler (to compile Foo.j to Foo.class)
+
+Required programs to build the compiler:
+---------------------------------------
+bnfc       -- BNF Converter version 2.1+,  >= 23/9/2004
+happy      -- parser generator for Haskell, >= 1.13 
+alex       -- lexer generator for Haskell, >= 2.0
+Profile.hs -- BNFC source file (formats/profile), must be on your path
+Trees.hs   -- BNFC source file (formats/profile), must be on your path
+
+File formats:
+------------
+Foo.c      -- C source file
+Foo.j      -- generated Jasmin JVM assembler file
+Foo.class  -- assembled JVM bytecode file

examples/gfcc/compiler/abs.c

@@ -0,0 +1,12 @@
+int abs (int x){
+  if (x < 0){
+    return 0 - x ;
+    }
+  else return x ;
+  } ;
+int main () {
+  int i ;
+  i = abs (16);
+  } ;
+
+

examples/gfcc/compiler/gfcc

@@ -0,0 +1,4 @@
+./TestImperC $1 | tail -1 >gft.tmp
+echo "es -file=typecheck.gfs" | gf+ -s Imper.gfcm
+runhugs CleanJVM jvm.tmp $1
+rm *.tmp

examples/gfcc/compiler/makefile

@@ -0,0 +1,12 @@
+GF=gf+
+SRC=../
+
+all: compiler
+
+compiler:
+	echo "pm | wf Imper.gfcm ;; pg -lang=ImperC -printer=lbnf | wf ImperC.tmp" | $(GF) $(SRC)ImperC.gf $(SRC)ImperJVM.gf
+	echo "entrypoints Program, Stm, Exp ;" >entry.tmp
+	cat entry.tmp ImperC.tmp >ImperC.cf
+	bnfc -m -prof ImperC.cf
+	make -f Makefile
+	rm *.tmp

examples/gfcc/compiler/typecheck.gfs

@@ -0,0 +1,8 @@
+n Program
+open gft.tmp
+'
+c solve
+'
+c reindex
+'
+save ImperJVM jvm.tmp

grammars/prelude/Predef.gf

@@ -7,7 +7,8 @@ resource Predef = {
 
   -- these operations have their proper definitions in AppPredefined.hs
 
-  oper Int : Type = variants {} ;                      -- the type of integers
+  oper Int  : Type = variants {} ;                     -- the type of integers
+  oper Ints : Int -> Type = variants {} ;              -- the type of integers from 0 to n
 
   oper length : Tok ->        Int      = variants {} ; -- length of string
   oper drop   : Int -> Tok -> Tok      = variants {} ; -- drop prefix of length
@@ -15,6 +16,7 @@ resource Predef = {
   oper tk     : Int -> Tok -> Tok      = variants {} ; -- drop suffix of length
   oper dp     : Int -> Tok -> Tok      = variants {} ; -- take suffix of length
   oper eqInt  : Int -> Int -> PBool    = variants {} ; -- test if equal integers
+  oper lessInt: Int -> Int -> PBool    = variants {} ; -- test order of integers
   oper plus   : Int -> Int -> Int      = variants {} ; -- add integers
   oper eqStr  : Tok -> Tok -> PBool    = variants {} ; -- test if equal strings
   oper occur  : Tok -> Tok -> PBool    = variants {} ; -- test if occurs as substring

src/GF.hs

@@ -26,6 +26,7 @@ main = do
   let (os,fs) = getOptions "-" xs
       opt j   = oElem j os
       st0     = optInitShellState os
+      ifNotSil c = if oElem beSilent os then return () else c 
   case 0 of
 
     _ | opt getHelp -> do
@@ -51,10 +52,11 @@ main = do
       if opt beSilent then return () else putStrLnFlush "</gfbatch>"
       return ()
     _ -> do
-      putStrLnFlush $ welcomeMsg
+
+      ifNotSil $ putStrLnFlush $ welcomeMsg
       st <- useIOE st0 $ 
               foldM (shellStateFromFiles os) st0 fs
-      if null fs then return () else putCPU 
+      if null fs then return () else (ifNotSil putCPU) 
       gfInteract (initHState st) 
       return ()
 
@@ -73,7 +75,7 @@ welcomeMsg =
   "Welcome to " ++ authorMsg ++++ welcomeArch ++ "\n\nType 'h' for help."
 
 authorMsg = unlines [
- "Grammatical Framework, Version 2.0",
+ "Grammatical Framework, Version 2.0+",
  "Compiled " ++ today,
  "Copyright (c)", 
  "Björn Bringert, Markus Forsberg, Thomas Hallgren, Harald Hammarström,",

src/GF/Canon/AbsGFC.hs

@@ -104,6 +104,7 @@ data CType =
  | Table CType CType
  | Cn CIdent
  | TStr
+ | TInts Integer
   deriving (Eq,Ord,Show)
 
 data Labelling =
@@ -121,6 +122,7 @@ data Term =
  | S Term Term
  | C Term Term
  | FV [Term]
+ | EInt Integer
  | K Tokn
  | E
   deriving (Eq,Ord,Show)
@@ -157,6 +159,7 @@ data Patt =
  | PV Ident
  | PW
  | PR [PattAssign]
+ | PI Integer
   deriving (Eq,Ord,Show)
 
 data PattAssign =

src/GF/Canon/CMacros.hs

@@ -77,6 +77,7 @@ term2patt trm = case trm of
     aa' <- mapM term2patt aa
     return (PR (map (uncurry PAss) (zip ll aa')))
   LI x -> return $ PV x
+  EInt i -> return $ PI i
   _ -> prtBad "no pattern corresponds to term" trm
 
 patt2term :: Patt -> Term
@@ -85,6 +86,7 @@ patt2term p = case p of
   PV x    -> LI x
   PW      -> anyTerm ----
   PR pas  -> R [ Ass lbl (patt2term q) | PAss lbl q <- pas ]
+  PI i    -> EInt i
 
 anyTerm :: Term
 anyTerm  = LI (A.identC "_") --- should not happen

src/GF/Canon/CanonToGrammar.hs

@@ -111,6 +111,7 @@ redCType t = case t of
   Table p v  -> liftM2 G.Table (redCType p) (redCType v)
   Cn mc  -> liftM (uncurry G.QC) $ redQIdent mc
   TStr -> return $ F.typeStr
+  TInts i -> return $ F.typeInts (fromInteger i)
 
 redCTerm :: Term -> Err G.Term
 redCTerm x = case x of
@@ -139,6 +140,7 @@ redCTerm x = case x of
   C term0 term  -> liftM2 G.C (redCTerm term0) (redCTerm term)
   FV terms  -> liftM G.FV $ mapM redCTerm terms
   K (KS str) -> return $ G.K str
+  EInt i     -> return $ G.EInt $ fromInteger i
   E  -> return $ G.Empty
   K (KP d vs)  -> return $ 
                     G.Alts (tList d,[(tList s, G.Strs $ map G.K v) | Var s v <- vs])
@@ -169,5 +171,6 @@ redPatt p = case p of
         ls' = map redLabel ls
     ts <- mapM redPatt ts
     return $ G.PR $ zip ls' ts
+  PI i -> return $ G.PInt (fromInteger i)
   _ -> Bad $ "cannot recompile pattern" +++ show p
 

src/GF/Canon/GFC.cf

@@ -93,6 +93,7 @@ RecType. CType ::= "{" [Labelling] "}" ;
 Table.   CType ::= "(" CType "=>" CType ")" ;
 Cn.      CType ::= CIdent ;
 TStr.    CType ::= "Str" ;
+TInts.   CType ::= "Ints" Integer ;
 
 Lbg.  Labelling ::= Label ":" CType ;
 
@@ -108,6 +109,7 @@ S.    Term1 ::= Term1 "!" Term2 ;
 C.    Term  ::= Term "++" Term1 ;
 FV.   Term1 ::= "variants" "{" [Term2] "}" ;  --- no separator!
 
+EInt. Term2 ::= Integer ;
 K.    Term2 ::= Tokn ;
 E.    Term2 ::= "[" "]" ;
 
@@ -129,6 +131,7 @@ PC.   Patt ::= "(" CIdent [Patt] ")" ;
 PV.   Patt ::= Ident ;
 PW.   Patt ::= "_" ;
 PR.   Patt ::= "{" [PattAssign] "}" ;
+PI.   Patt ::= Integer ;
 
 PAss. PattAssign ::= Label "=" Patt ;
 

src/GF/Canon/LexGFC.hs

@@ -37,12 +37,12 @@ data Tok =
  | TD String     -- double precision float literals
  | TC String     -- character literals
 
- deriving (Eq,Show)
+ deriving (Eq,Show,Ord)
 
 data Token = 
    PT  Posn Tok
  | Err Posn
-  deriving Show
+  deriving (Eq,Show,Ord)
 
 tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
 tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
@@ -57,12 +57,13 @@ prToken t = case t of
   PT _ (TV s) -> s
   PT _ (TD s) -> s
   PT _ (TC s) -> s
+  _ -> show t
 
 
 eitherResIdent :: (String -> Tok) -> String -> Tok
 eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where
   isResWord s = isInTree s $
-    B "lin" (B "data" (B "abstract" (B "Type" (B "Str" N N) N) (B "concrete" (B "cat" N N) N)) (B "grammar" (B "fun" (B "flags" N N) N) (B "in" N N))) (B "pre" (B "open" (B "of" (B "lincat" N N) N) (B "param" (B "oper" N N) N)) (B "transfer" (B "table" (B "resource" N N) N) (B "variants" N N)))
+    B "lin" (B "concrete" (B "Type" (B "Str" (B "Ints" N N) N) (B "cat" (B "abstract" N N) N)) (B "fun" (B "flags" (B "data" N N) N) (B "in" (B "grammar" N N) N))) (B "pre" (B "open" (B "of" (B "lincat" N N) N) (B "param" (B "oper" N N) N)) (B "transfer" (B "table" (B "resource" N N) N) (B "variants" N N)))
 
 data BTree = N | B String BTree BTree deriving (Show)
 
@@ -90,7 +91,7 @@ unescapeInitTail = unesc . tail where
 -------------------------------------------------------------------
 
 data Posn = Pn !Int !Int !Int
-      deriving (Eq, Show)
+      deriving (Eq, Show,Ord)
 
 alexStartPos :: Posn
 alexStartPos = Pn 0 1 1

src/GF/Canon/PrintGFC.hs

@@ -234,6 +234,7 @@ instance Print CType where
    Table ctype0 ctype -> prPrec i 0 (concatD [doc (showString "(") , prt 0 ctype0 , doc (showString "=>") , prt 0 ctype , doc (showString ")")])
    Cn cident -> prPrec i 0 (concatD [prt 0 cident])
    TStr  -> prPrec i 0 (concatD [doc (showString "Str")])
+   TInts n -> prPrec i 0 (concatD [doc (showString "Ints") , prt 0 n])
 
   prtList es = case es of
    [] -> (concatD [])
@@ -260,6 +261,7 @@ instance Print Term where
    S term0 term -> prPrec i 1 (concatD [prt 1 term0 , doc (showString "!") , prt 2 term])
    C term0 term -> prPrec i 0 (concatD [prt 0 term0 , doc (showString "++") , prt 1 term])
    FV terms -> prPrec i 1 (concatD [doc (showString "variants") , doc (showString "{") , prt 2 terms , doc (showString "}")])
+   EInt n -> prPrec i 2 (concatD [prt 0 n])
    K tokn -> prPrec i 2 (concatD [prt 0 tokn])
    E  -> prPrec i 2 (concatD [doc (showString "[") , doc (showString "]")])
 
@@ -322,6 +324,7 @@ instance Print Patt where
    PV id -> prPrec i 0 (concatD [prt 0 id])
    PW  -> prPrec i 0 (concatD [doc (showString "_")])
    PR pattassigns -> prPrec i 0 (concatD [doc (showString "{") , prt 0 pattassigns , doc (showString "}")])
+   PI n -> prPrec i 0 (concatD [prt 0 n])
 
   prtList es = case es of
    [] -> (concatD [])

src/GF/Canon/SkelGFC.hs

@@ -35,7 +35,7 @@ transModType x = case x of
 
 transExtend :: Extend -> Result
 transExtend x = case x of
-  Ext id  -> failure x
+  Ext ids  -> failure x
   NoExt  -> failure x
 
 
@@ -129,6 +129,7 @@ transCType x = case x of
   Table ctype0 ctype  -> failure x
   Cn cident  -> failure x
   TStr  -> failure x
+  TInts n  -> failure x
 
 
 transLabelling :: Labelling -> Result
@@ -148,6 +149,7 @@ transTerm x = case x of
   S term0 term  -> failure x
   C term0 term  -> failure x
   FV terms  -> failure x
+  EInt n  -> failure x
   K tokn  -> failure x
   E  -> failure x
 
@@ -191,6 +193,7 @@ transPatt x = case x of
   PV id  -> failure x
   PW  -> failure x
   PR pattassigns  -> failure x
+  PI n  -> failure x
 
 
 transPattAssign :: PattAssign -> Result

src/GF/Compile/CheckGrammar.hs

@@ -233,6 +233,9 @@ computeLType gr t = do
  where
   comp ty = case ty of
 
+    App (Q (IC "Predef") (IC "Ints")) _ -> return ty ---- shouldn't be needed
+    Q (IC "Predef") (IC "Int")          -> return ty ---- shouldn't be needed
+
     Q m c | elem c [cPredef,cPredefAbs] -> return ty
 
     Q m ident -> checkIn ("Q" +++ show m) $ do
@@ -664,6 +667,15 @@ checkEqLType env t u trm = do
                                  all (\ (l,a) -> 
                                      any (\ (k,b) -> alpha g a b && l == k) ts) rs
 
+     -- the following say that Ints n is a subset of Int and of Ints m
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n
+     (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
+        Q (IC "Predef") (IC "Int"))                 -> True ---- should check size
+     
+     (Q (IC "Predef") (IC "Int"),
+        App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
+
      (Table a b,  Table c d)  -> alpha g a c && alpha g b d
      (Vr x,       Vr y)       -> x == y || elem (x,y) g || elem (y,x) g
      _                        -> t == u 

src/GF/Compile/GrammarToCanon.hs

@@ -165,6 +165,9 @@ redCType t = case t of
   Table p v  -> liftM2 G.Table (redCType p) (redCType v)
   Q m c    -> liftM G.Cn $ redQIdent (m,c)
   QC m c   -> liftM G.Cn $ redQIdent (m,c)
+
+  App (Q (IC "Predef") (IC "Ints")) (EInt n) -> return $ G.TInts (toInteger n)
+
   Sort "Str" -> return $ G.TStr
   _ -> prtBad "cannot reduce to canonical the type" t
 
@@ -197,6 +200,7 @@ redCTerm t = case t of
     return $ G.T ty' $ map (uncurry G.Cas) $ zip (map singleton ps') ts'
   S u v -> liftM2 G.S (redCTerm u) (redCTerm v)
   K s   -> return $ G.K (G.KS s)
+  EInt i -> return $ G.EInt $ toInteger i
   C u v -> liftM2 G.C (redCTerm u) (redCTerm v)
   FV ts -> liftM G.FV $ mapM redCTerm ts
 ---  Ready ss -> return $ G.Ready [redStr ss] --- obsolete
@@ -224,6 +228,7 @@ redPatt p = case p of
     ts <- mapM redPatt tts
     return $ G.PR $  map (uncurry G.PAss) $ zip ls' ts
   PT _ q -> redPatt q
+  PInt i -> return $ G.PI (toInteger i)
   _ -> prtBad "cannot reduce pattern" p
 
 redLabel :: Label -> G.Label

src/GF/GFModes.hs

@@ -6,6 +6,7 @@ import Option
 import ShellState
 import ShellCommands
 import Shell
+import CommandL (execCommandHistory)
 import SubShell
 import PShell
 import JGF
@@ -14,14 +15,14 @@ import Char (isSpace)
 -- separated from GF Main 24/6/2003
 
 gfInteract :: HState -> IO HState
-gfInteract st@(env,_) = do
+gfInteract st@(env,hist) = do
   -- putStrFlush "> " M.F 25/01-02 prompt moved to Arch.
   (s,cs) <- getCommandLines
   case ifImpure cs of
 
     -- these are the three impure commands
     Just (ICQuit,_) -> do
-      putStrLnFlush "See you."
+      ifNotSilent "See you."
       return st
     Just (ICExecuteHistory file,_) -> do
       ss  <- readFileIf file
@@ -34,8 +35,13 @@ gfInteract st@(env,_) = do
       st' <- execLinesH line [co] st       -- s would not work in execLinesH
       gfInteract st'
 
-    Just (ICEditSession,os) -> 
+    Just (ICEditSession,os) -> case getOptVal os useFile of
-      editSession (addOptions os opts) env >> gfInteract st
+      Just file -> do
+        s <- readFileIf file
+        (env',tree) <- execCommandHistory env s
+        gfInteract st
+      _ -> 
+        editSession (addOptions os opts) env >> gfInteract st
     Just (ICTranslateSession,os) -> 
       translateSession (addOptions os opts) env >> gfInteract st
 
@@ -45,6 +51,8 @@ gfInteract st@(env,_) = do
       gfInteract st'
    where
      opts = globalOptions env
+     ifNotSilent c = 
+       if oElem beSilent opts then return () else putStrLnFlush c
 
 gfBatch :: HState -> IO HState
 gfBatch st@(sh,_) = do

src/GF/Grammar/AppPredefined.hs

@@ -15,16 +15,18 @@ isInPredefined = err (const True) (const False) . typPredefined
 typPredefined :: Ident -> Err Type
 typPredefined c@(IC f) = case f of
   "Int"    -> return typePType
+  "Ints"   -> return $ mkFunType [cnPredef "Int"] typePType
   "PBool"  -> return typePType
   "PFalse" -> return $ cnPredef "PBool"
   "PTrue"  -> return $ cnPredef "PBool"
   "dp"     -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
   "drop"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
   "eqInt"  -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
+  "lessInt"-> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
   "eqStr"  -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
   "length" -> return $ mkFunType [typeTok] (cnPredef "Int")
   "occur"  -> return $ mkFunType [typeTok,typeTok] (cnPredef "PBool")
-  "plus"   -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PInt")
+  "plus"   -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "Int")
 ----  "read"   -> (P : Type) -> Tok -> P
 ----  "show"   -> (P : Type) -> P -> Tok
   "take"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
@@ -51,6 +53,7 @@ appPredefined t = case t of
       ("eqStr",K s,    K t) -> if s == t then predefTrue else predefFalse
       ("occur",K s,    K t) -> if substring s t then predefTrue else predefFalse
       ("eqInt",EInt i, EInt j) -> if i==j then predefTrue else predefFalse
+      ("lessInt",EInt i, EInt j) -> if i<j then predefTrue else predefFalse
       ("plus", EInt i, EInt j) -> EInt $ i+j
       ("show", _, t) -> K $ prt t
       ("read", _, K s) -> str2tag s --- because of K, only works for atomic tags

src/GF/Grammar/Lookup.hs

@@ -78,6 +78,8 @@ lookupFirstTag gr m c = do
 
 allParamValues :: SourceGrammar -> Type -> Err [Term]
 allParamValues cnc ptyp = case ptyp of
+     App (Q (IC "Predef") (IC "Ints")) (EInt n) -> 
+       return [EInt i | i <- [0..n]]
      QC p c -> lookupParamValues cnc p c
      RecType r -> do
        let (ls,tys) = unzip r

src/GF/Grammar/MMacros.hs

@@ -272,3 +272,15 @@ string2var :: String -> Ident
 string2var s = case s of
   c:'_':i -> identV (readIntArg i,[c]) ---
   _ -> zIdent s
+
+-- reindex variables so that they tell nesting depth level
+
+reindexTerm :: Term -> Term
+reindexTerm = qualif (0,[]) where
+  qualif dg@(d,g) t = case t of
+    Abs x b    -> let x' = ind x d in Abs x' $ qualif (d+1, (x,x'):g) b
+    Prod x a b -> let x' = ind x d in Prod x' (qualif dg a) $ qualif (d+1, (x,x'):g) b
+    Vr x       -> Vr $ look x g
+    _ -> composSafeOp (qualif dg) t
+  look x  = maybe x id . lookup x --- if x is not in scope it is unchanged
+  ind x d = identC $ prIdent x ++ "_" ++ show d

src/GF/Grammar/Macros.hs

@@ -271,6 +271,7 @@ typeStrs  = srt "Strs"
 
 typeString = constPredefRes "String"
 typeInt = constPredefRes "Int"
+typeInts i = App (constPredefRes "Ints") (EInt i)
 
 constPredefRes s = Q (IC "Predef") (zIdent s)
 

src/GF/Grammar/PatternMatch.hs

@@ -79,6 +79,7 @@ isInConstantForm trm = case trm of
     R r      -> all (isInConstantForm . snd . snd) r
     K _      -> True
     Alias _ _ t -> isInConstantForm t
+    EInt _   -> True
     _       -> False ---- isInArgVarForm trm
 
 varsOfPatt :: Patt -> [Ident]

src/GF/Infra/Option.hs

@@ -208,6 +208,7 @@ useName        = aOpt "name"
 useAbsName     = aOpt "abs"
 useCncName     = aOpt "cnc"
 useResName     = aOpt "res"
+useFile        = aOpt "file"
 
 markLin        = aOpt "mark"
 markOptXML     = oArg "xml"

src/GF/Shell/CommandL.hs

@@ -4,6 +4,7 @@ import Operations
 import UseIO
 
 import CMacros
+import Values (Tree)
 
 import GetTree
 import ShellState
@@ -13,6 +14,7 @@ import Commands
 
 import Char
 import List (intersperse)
+import Monad (foldM)
 
 import UTF8
 
@@ -39,6 +41,23 @@ editLoop env state resume = do
 
     editLoop env' state' resume
 
+-- execute a command script and return a tree
+
+execCommandHistory :: CEnv -> String -> IO (CEnv,Tree)
+execCommandHistory env s = do
+  let env'  = startEditEnv env
+  let state = initSStateEnv env'
+  (env',state') <- foldM exec (env,state) $ lines s
+  return $ (env',treeSState state')
+
+ where
+
+  exec (env,state) l = do
+    let c = pCommand l
+    execCommand env c state
+
+
+
 getCommand :: IO Command
 getCommand = do
   s <- getLine
@@ -101,6 +120,7 @@ pCommand = pCommandWords . words where
     "off":lang: _ -> CCEnvOff lang 
     "pfile" :f:_  -> CCEnvRefineParse f
     "tfile" :f:_  -> CCEnvRefineWithTree f
+    "save":l:f:_  -> CCEnvSave l f
 
 -- openstring file
 -- pfile file

src/GF/Shell/Commands.hs

@@ -96,6 +96,7 @@ data Command =
 -- other commands using IO
  | CCEnvRefineWithTree String
  | CCEnvRefineParse String
+ | CCEnvSave String FilePath
 
 isQuit CQuit = True
 isQuit _ = False
@@ -160,6 +161,12 @@ execCommand env c s = case c of
   CCEnvOn  name -> return (languageOn  (language name) env,s)
   CCEnvOff name -> return (languageOff (language name) env,s)
 
+  CCEnvSave lang file -> do
+    let str = optLinearizeTreeVal opts (stateGrammarOfLang env (language lang)) $ treeSState s
+    writeFile file str
+    let msg = ["wrote file" +++ file]
+    return (env,changeMsg msg s)
+
 -- this command is improved by the use of IO
   CRefineRandom -> do
     g <- newStdGen

src/GF/Shell/ShellCommands.hs

@@ -167,7 +167,7 @@ optionsOfCommand co = case co of
 
   CHelp _ -> opts "all filter length lexer unlexer printer transform depth number"
 
-  CImpure ICEditSession -> opts "f"
+  CImpure ICEditSession -> both "f" "file"
   CImpure ICTranslateSession -> both "f langs" "cat"
 
   _ -> none

src/GF/UseGrammar/Custom.hs

@@ -267,6 +267,9 @@ customTermCommand =
                                    (uniqueRefinements (grammar g) (tree2loc t)))
   ,(strCI "context",    \g t -> err (const [t]) (return . loc2tree)
                                    (contextRefinements (grammar g) (tree2loc t)))
+  ,(strCI "reindex",    \g t -> let gr = grammar g in
+                                  err (const [t]) return 
+                                    (exp2termCommand gr (return . MM.reindexTerm) t))
 ---  ,(strCI "delete",     \g t -> [MM.mExp0])
 -- add your own term commands here
   ]