From d7abce535075910edbd16db165588b6c99c37e77 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 2 Nov 2008 03:16:09 +0000
Subject: 	* interp/g-util.boot: Import "ggreater". 	*
 interp/category.boot: Import "g-cndata" 	* interp/c-util.boot: Import
 "g-opt". 	* interp/Makefile.pamphlet: Adjust Make rules.

---
 src/ChangeLog                |   7 +++
 src/driver/main.c            |   2 +-
 src/interp/Makefile.in       |   6 +-
 src/interp/Makefile.pamphlet |   6 +-
 src/interp/c-util.boot       |   4 +-
 src/interp/category.boot     |   1 +
 src/interp/g-opt.boot        |   4 ++
 src/interp/g-util.boot       | 131 +++++++++++++++++++++++++------------------
 src/interp/ggreater.lisp     |   2 +
 src/interp/i-intern.boot     |  38 -------------
 src/interp/i-output.boot     |  20 +++++++
 src/interp/i-util.boot       |   2 -
 src/interp/parsing.lisp      |   2 +-
 src/interp/spad.lisp         |   4 --
 14 files changed, 121 insertions(+), 108 deletions(-)

diff --git a/src/ChangeLog b/src/ChangeLog
index 1da82e2b..22f73eab 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,10 @@
+2008-11-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/g-util.boot: Import "ggreater".
+	* interp/category.boot: Import "g-cndata"
+	* interp/c-util.boot: Import "g-opt".
+	* interp/Makefile.pamphlet: Adjust Make rules.
+
 2008-11-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	Fix AW/2212001
diff --git a/src/driver/main.c b/src/driver/main.c
index 22c33779..6f758cfd 100644
--- a/src/driver/main.c
+++ b/src/driver/main.c
@@ -34,7 +34,7 @@
 /* This program is a driver for the OpenAxiom core executable.
    It pretends to be the OpenAxiom interpreter when, in fact, the actual
    work is done by the Core Executable.  It also occasionally masquerades
-   as the seesion manager.  */
+   as the session manager.  */
 
 
 #include <stdlib.h>
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 4c3441a0..8cff46d0 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -316,7 +316,7 @@ package.$(FASLEXT): clam.$(FASLEXT)
 database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
 		cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT)
 functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT)
-category.$(FASLEXT): g-util.$(FASLEXT)
+category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT)
 cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT)
 compat.$(FASLEXT): pathname.$(FASLEXT)
 simpbool.$(FASLEXT): macros.$(FASLEXT)
@@ -409,12 +409,12 @@ g-timer.$(FASLEXT): macros.$(FASLEXT) g-util.$(FASLEXT)
 msgdb.$(FASLEXT): g-util.$(FASLEXT)
 g-boot.$(FASLEXT): def.$(FASLEXT) g-util.$(FASLEXT)
 g-error.$(FASLEXT): diagnostics.$(FASLEXT) g-util.$(FASLEXT)
-c-util.$(FASLEXT): g-util.$(FASLEXT)
+c-util.$(FASLEXT): g-util.$(FASLEXT) g-opt.$(FASLEXT)
 pathname.$(FASLEXT): nlib.$(FASLEXT)
 hashcode.$(FASLEXT): g-util.$(FASLEXT)
 pspad2.$(FASLEXT): pspad1.$(FASLEXT)
 pspad1.$(FASLEXT): macros.$(FASLEXT)
-g-util.$(FASLEXT): macros.$(FASLEXT) sys-utility.$(FASLEXT)
+g-util.$(FASLEXT): ggreater.$(FASLEXT) macros.$(FASLEXT) sys-utility.$(FASLEXT)
 g-cndata.$(FASLEXT): sys-macros.$(FASLEXT)
 compress.$(FASLEXT): sys-macros.$(FASLEXT)
 msg.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index f46eab6c..af5850ae 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -565,7 +565,7 @@ package.$(FASLEXT): clam.$(FASLEXT)
 database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
 		cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT)
 functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT)
-category.$(FASLEXT): g-util.$(FASLEXT)
+category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT)
 cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT)
 compat.$(FASLEXT): pathname.$(FASLEXT)
 simpbool.$(FASLEXT): macros.$(FASLEXT)
@@ -658,12 +658,12 @@ g-timer.$(FASLEXT): macros.$(FASLEXT) g-util.$(FASLEXT)
 msgdb.$(FASLEXT): g-util.$(FASLEXT)
 g-boot.$(FASLEXT): def.$(FASLEXT) g-util.$(FASLEXT)
 g-error.$(FASLEXT): diagnostics.$(FASLEXT) g-util.$(FASLEXT)
-c-util.$(FASLEXT): g-util.$(FASLEXT)
+c-util.$(FASLEXT): g-util.$(FASLEXT) g-opt.$(FASLEXT)
 pathname.$(FASLEXT): nlib.$(FASLEXT)
 hashcode.$(FASLEXT): g-util.$(FASLEXT)
 pspad2.$(FASLEXT): pspad1.$(FASLEXT)
 pspad1.$(FASLEXT): macros.$(FASLEXT)
-g-util.$(FASLEXT): macros.$(FASLEXT) sys-utility.$(FASLEXT)
+g-util.$(FASLEXT): ggreater.$(FASLEXT) macros.$(FASLEXT) sys-utility.$(FASLEXT)
 g-cndata.$(FASLEXT): sys-macros.$(FASLEXT)
 compress.$(FASLEXT): sys-macros.$(FASLEXT)
 msg.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT)
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 170f16f8..c0ccee94 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -33,6 +33,7 @@
 
 
 import g_-util
+import g_-opt
 namespace BOOT
 
 module c_-util where
@@ -464,7 +465,8 @@ isFunction(x,e) ==
  
 isLiteral: (%Symbol,%Env) -> %Boolean
 isLiteral(x,e) == 
-  get(x,"isLiteral",e)
+  get(x,"isLiteral",e) => true
+  false
  
 
 makeLiteral: (%Symbol,%Env) -> %Thing
diff --git a/src/interp/category.boot b/src/interp/category.boot
index c9f56468..d9250a22 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -33,6 +33,7 @@
 
 
 import g_-util
+import g_-cndata
 namespace BOOT
 
 --%
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 7ef701c4..8bf239fe 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -379,6 +379,10 @@ optEQ u ==
     -- That undoes some weird work in Boolean to do with the definition of true
     u
   u
+
+lispize x == first optimize [x]
+ 
+--% optimizer hash table
  
 for x in '( (call         optCall) _
            (SEQ          optSEQ)_
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index a856ca2d..f06675df 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -32,6 +32,7 @@
 -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 
+import ggreater
 import macros
 import sys_-utility
 namespace BOOT
@@ -61,7 +62,7 @@ PPtoFile(x, fname) ==
 get: (%Thing,%Symbol,%List) -> %Thing
 get0: (%Thing,%Symbol,%List) -> %Thing
 get1: (%Thing,%Symbol,%List) -> %Thing
-get2: (%Thing,%Symbol,%List) -> %Thing
+get2: (%Thing,%Symbol) -> %Thing
 
 get(x,prop,e) ==
   $InteractiveMode => get0(x,prop,e)
@@ -79,27 +80,31 @@ get1(x,prop,e) ==
   not atom x => get(QCAR x,prop,e)
   prop="modemap" and $insideCapsuleFunctionIfTrue=true =>
     LASSOC("modemap",getProplist(x,$CapsuleModemapFrame))
-      or get2(x,prop,e)
-  LASSOC(prop,getProplist(x,e)) or get2(x,prop,e)
+      or get2(x,prop)
+  LASSOC(prop,getProplist(x,e)) or get2(x,prop)
 
-get2(x,prop,e) ==
+get2(x,prop) ==
   prop="modemap" and IDENTP x and constructor? x =>
     (u := getConstructorModemapFromDB x) => [u]
     nil
   nil
 
 ++ Update properties of an entity in an environment.
-put: (%Thing,%Symbol,%Thing,%List) -> %List
-addBinding: (%Thing,%List,%List) -> %List
-augProplistOf: (%Thing,%Symbol,%Thing,%List) -> %List
-augProplist: (%List,%Thing,%Thing) -> %List
+put: (%Thing,%Symbol,%Thing,%Env) -> %Env
+addBinding: (%Thing,%List,%Env) -> %Env
+addBindingInteractive: (%Thing, %List, %Env) -> %Env
+augProplistOf: (%Thing,%Symbol,%Thing,%Env) -> %List
+augProplist: (%List,%Symbol,%Thing) -> %List
+augProplistInteractive: (%List,%Symbol,%Thing) -> %List
+putIntSymTab: (%Thing,%Symbol,%Form,%Env) -> %Env
+addIntSymTabBinding: (%Thing,%List,%Env) -> %Env
 
 put(x,prop,val,e) ==
   $InteractiveMode and not EQ(e,$CategoryFrame) =>
     putIntSymTab(x,prop,val,e)
   --e must never be $CapsuleModemapFrame
-  null atom x => put(first x,prop,val,e)
-  newProplist:= augProplistOf(x,prop,val,e)
+  not atom x => put(first x,prop,val,e)
+  newProplist := augProplistOf(x,prop,val,e)
   prop="modemap" and $insideCapsuleFunctionIfTrue=true =>
     SAY ["**** modemap PUT on CapsuleModemapFrame: ",val]
     $CapsuleModemapFrame:=
@@ -108,6 +113,28 @@ put(x,prop,val,e) ==
     e
   addBinding(x,newProplist,e)
 
+putIntSymTab(x,prop,val,e) ==
+  null atom x => putIntSymTab(first x,prop,val,e)
+  pl0 := pl := search(x,e)
+  pl :=
+    null pl => [[prop,:val]]
+    u := ASSQ(prop,pl) =>
+      RPLACD(u,val)
+      pl
+    lp := LASTPAIR pl
+    u := [[prop,:val]]
+    RPLACD(lp,u)
+    pl
+  EQ(pl0,pl) => e
+  addIntSymTabBinding(x,pl,e)
+
+addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) ==
+  -- change proplist of var in e destructively
+  u := ASSQ(var,curContour) =>
+    RPLACD(u,proplist)
+    e
+  RPLAC(CAAR e,[[var,:proplist],:curContour])
+  e
 
 --% Syntax manipulation
 
@@ -315,7 +342,7 @@ dropLeadingBlanks str ==
   nb := NIL
   i := 0
   while (i < l) and not nb repeat
-    if SCHAR(str,i) ^= " " then nb := i
+    if SCHAR(str,i) ^= char " " then nb := i
     else i := i + 1
   nb = 0 => str
   nb => SUBSTRING(str,nb,NIL)
@@ -493,10 +520,10 @@ formatUnabbreviatedTuple t ==
   [:t0,'",",:formatUnabbreviatedTuple QCDR t]
 
 formatUnabbreviated t ==
-  atom t =>
-    [t]
   null t =>
     ['"()"]
+  atom t =>
+    [t]
   t is [p,sel,arg] and p = ":" =>
     [sel,'": ",:formatUnabbreviated arg]
   t is ['Union,:args] =>
@@ -526,36 +553,16 @@ sublisNQ(al,e) ==
     EQ(a,u) and EQ(rest e,v) => e
     [u,:v]
 
--- function for turning strings in tex format
-
-str2Outform s ==
-  parse := ncParseFromString s or systemError '"String for TeX will not parse"
-  parse2Outform parse
-
-parse2Outform x ==
-  x is [op,:argl] =>
-    nargl := [parse2Outform y for y in argl]
-    op = 'construct => ['BRACKET,['ARGLST,:[parse2Outform y for y in argl]]]
-    op = 'brace and nargl is [[BRACKET,:r]] => ['BRACE,:r]
-    [op,:nargl]
-  x
-
-str2Tex s ==
-  outf := str2Outform s
-  val := coerceInt(objNew(wrap outf, '(OutputForm)), '(TexFormat))
-  val := objValUnwrap val
-  CAR val.1
-
 opOf: %Thing -> %Thing
 opOf x ==
   atom x => x
   first x
 
 
-getProplist: (%Thing,%List) -> %List
-search: (%Thing,%List) -> %List
+getProplist: (%Thing,%Env) -> %List
+search: (%Thing,%Env) -> %List
 searchCurrentEnv: (%Thing,%List) -> %List
-searchTailEnv: (%Thing,%List) -> %List
+searchTailEnv: (%Thing,%Env) -> %List
 
 getProplist(x,E) ==
   not atom x => getProplist(first x,E)
@@ -610,6 +617,20 @@ addBinding(var,proplist,e is [[curContour,:tailContour],:tailEnv]) ==
                  --Previous line should save some space
   [[[lx,:curContour],:tailContour],:tailEnv] where lx:= [var,:proplist]
 
+addBindingInteractive(var,proplist,e is [[curContour,:.],:.]) ==
+  -- change proplist of var in e destructively
+  u := ASSQ(var,curContour) =>
+    RPLACD(u,proplist)
+    e
+  RPLAC(CAAR e,[[var,:proplist],:curContour])
+  e
+
+augProplistInteractive(proplist,prop,val) ==
+  u := ASSQ(prop,proplist) =>
+    RPLACD(u,val)
+    proplist
+  [[prop,:val],:proplist]
+
 position(x,l) ==
   posn(x,l,0) where
     posn(x,l,n) ==
@@ -627,7 +648,7 @@ after(u,v) ==
   r
 
 
-$blank := char ('_ )
+$blank == char ('_ )
 
 trimString s ==
   leftTrim rightTrim s
@@ -695,24 +716,24 @@ $exposeFlag        := false     --if true, messages go to $outStream
 $exposeFlagHeading := false     --see htcheck.boot
 $checkingXmptex? := false       --see htcheck.boot
 $exposeDocHeading:= nil         --see htcheck.boot
-$charPlus := char '_+
-$charBlank:= (char '_ )
-$charLbrace:= char '_{
-$charRbrace:= char '_}
-$charBack := char '_\
-$charDash := char '_-
-
-$charTab            := CODE_-CHAR(9)
-$charNewline        := CODE_-CHAR(10)
-$charFauxNewline    := CODE_-CHAR(25)
-$stringNewline      := PNAME CODE_-CHAR(10)
-$stringFauxNewline  := PNAME CODE_-CHAR(25)
-
-$charExclusions := [char 'a, char 'A]
-$charQuote := char '_'
-$charSemiColon := char '_;
-$charComma     := char '_,
-$charPeriod    := char '_.
+$charPlus == char '_+
+$charBlank == (char '_ )
+$charLbrace == char '_{
+$charRbrace == char '_}
+$charBack == char '_\
+$charDash == char '_-
+
+$charTab            == CODE_-CHAR(9)
+$charNewline        == CODE_-CHAR(10)
+$charFauxNewline    == CODE_-CHAR(25)
+$stringNewline      == PNAME CODE_-CHAR(10)
+$stringFauxNewline  == PNAME CODE_-CHAR(25)
+
+$charExclusions == [char 'a, char 'A]
+$charQuote == char '_'
+$charSemiColon == char '_;
+$charComma     == char '_,
+$charPeriod    == char '_.
 $checkPrenAlist := [[char '_(,:char '_)],[char '_{,:char '_}],[char '_[,:char '_]]]
 $charEscapeList:= [char '_%,char '_#,$charBack]
 $charIdentifierEndings := [char '__, char '_!, char '_?]
diff --git a/src/interp/ggreater.lisp b/src/interp/ggreater.lisp
index c27ff31e..81d7ca60 100644
--- a/src/interp/ggreater.lisp
+++ b/src/interp/ggreater.lisp
@@ -204,5 +204,7 @@
 
 (defvar SORTGREATERP #'GGREATERP "default sorting predicate")
 
+(defun GLESSEQP (X Y) (NOT (GGREATERP X Y)))
 
+(defun LEXLESSEQP (X Y) (NOT (LEXGREATERP X Y)))
 
diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot
index 20a066fd..9f78f6d8 100644
--- a/src/interp/i-intern.boot
+++ b/src/interp/i-intern.boot
@@ -417,20 +417,6 @@ getValueFromSpecificEnvironment(id,mode,e) ==
     $failure
   $failure
 
-addBindingInteractive(var,proplist,e is [[curContour,:.],:.]) ==
-  -- change proplist of var in e destructively
-  u := ASSQ(var,curContour) =>
-    RPLACD(u,proplist)
-    e
-  RPLAC(CAAR e,[[var,:proplist],:curContour])
-  e
-
-augProplistInteractive(proplist,prop,val) ==
-  u := ASSQ(prop,proplist) =>
-    RPLACD(u,val)
-    proplist
-  [[prop,:val],:proplist]
-
 getFlag x == get("--flags--",x,$e)
 
 putFlag(flag,value) ==
@@ -465,30 +451,6 @@ fastSearchCurrentEnv(x,currentEnv) ==
   while (currentEnv:= QCDR currentEnv) repeat
     u:= QLASSQ(x,CAR currentEnv) => u
 
-putIntSymTab(x,prop,val,e) ==
-  null atom x => putIntSymTab(first x,prop,val,e)
-  pl0 := pl := search(x,e)
-  pl :=
-    null pl => [[prop,:val]]
-    u := ASSQ(prop,pl) =>
-      RPLACD(u,val)
-      pl
-    lp := LASTPAIR pl
-    u := [[prop,:val]]
-    RPLACD(lp,u)
-    pl
-  EQ(pl0,pl) => e
-  addIntSymTabBinding(x,pl,e)
-
-addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) ==
-  -- change proplist of var in e destructively
-  u := ASSQ(var,curContour) =>
-    RPLACD(u,proplist)
-    e
-  RPLAC(CAAR e,[[var,:proplist],:curContour])
-  e
-
-
 transformCollect [:itrl,body] ==
   -- syntactic transformation for COLLECT form, called from mkAtree1
   iterList:=[:iterTran1 for it in itrl] where iterTran1() ==
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 2a625592..be25b4ac 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -2677,3 +2677,23 @@ inputForm2String x ==
 inputForm2OutputForm x ==
   INTERN inputForm2String x
 
+-- function for turning strings in tex format
+
+str2Outform s ==
+  parse := ncParseFromString s or systemError '"String for TeX will not parse"
+  parse2Outform parse
+
+parse2Outform x ==
+  x is [op,:argl] =>
+    nargl := [parse2Outform y for y in argl]
+    op = 'construct => ['BRACKET,['ARGLST,:[parse2Outform y for y in argl]]]
+    op = 'brace and nargl is [[BRACKET,:r]] => ['BRACE,:r]
+    [op,:nargl]
+  x
+
+str2Tex s ==
+  outf := str2Outform s
+  val := coerceInt(objNew(wrap outf, '(OutputForm)), '(TexFormat))
+  val := objValUnwrap val
+  CAR val.1
+
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index dac2c3d8..8107c37b 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -190,8 +190,6 @@ isCapitalWord x ==
 --------------------> NEW DEFINITION (see interop.boot.pamphlet)
 domainEqual(a,b) == VECP a and VECP b and a.0 = b.0
  
-lispize x == first optimize [x]
- 
 $newCompilerUnionFlag := true
 
 orderUnionEntries l ==
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index 7a45c658..56ef77ea 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -381,7 +381,7 @@ the stack, then stack a NIL. Return the value of prod."
                              (mapcar #'(lambda (x) (internl metapfx (pname x)))
                                      (assocleft rs))))
          n unpfx-funlist)
-    (set flnam pfx-funlist)
+    (|setDynamicBinding| flnam pfx-funlist)
     (if (not (lessp (setq n (length metapfx)) 0))
         (setq unpfx-funlist
               (mapcar #'(lambda (x) 
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index e6d174dc..e50af9c6 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -393,10 +393,6 @@
                (|incrementTimeSum| ,oldkey)
                (return ,val)))))
 
-(defun GLESSEQP (X Y) (NOT (GGREATERP X Y)))
-
-(defun LEXLESSEQP (X Y) (NOT (LEXGREATERP X Y)))
-
 (defun SETELTFIRST (A B C) (declare (ignore b)) (RPLACA A C))
 
 (defun SETELTREST (A B C) (declare (ignore b)) (RPLACD A C))
-- 
cgit v1.2.3