* boot/tokens.boot: Don't translate setDifference.

	* boot/initial-env.lisp (SETDIFFERNECE): Remove.
	* boot/translator.boot (evalBootFile): Rename form EVAL-BOOT-FILE.
	* boot/utility.boot (setDifference): Define.
	* interp/unlisp.lisp (ListMemberQ?): Remove.
	(ListRemoveQ): Likewise.
	(AlistAssocQ): Likewise.

14 files changed, 63 insertions, 41 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 47f9999e..7bbfc32e 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2011-04-22  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/tokens.boot: Don't translate setDifference.
+	* boot/initial-env.lisp (SETDIFFERNECE): Remove.
+	* boot/translator.boot (evalBootFile): Rename form EVAL-BOOT-FILE.
+	* boot/utility.boot (setDifference): Define.
+	* interp/unlisp.lisp (ListMemberQ?): Remove.
+	(ListRemoveQ): Likewise.
+	(AlistAssocQ): Likewise.
+
 2011-04-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* boot/utility.boot (copyList): Define.
diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp
index 7e2deef9..3496cdd8 100644
--- a/src/boot/initial-env.lisp
+++ b/src/boot/initial-env.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2010, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -74,9 +74,6 @@
 
 (defvar *lisp-source-filetype* "lisp")
 
-(defun setdifference (x y)
-  (set-difference x y))
-
 (defun |shoeInputFile| (filespec )
   (open filespec :direction :input :if-does-not-exist nil))
 
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 36d45495..ad885aaa 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1542,7 +1542,8 @@
         (SETQ |$dollarVars| NIL)
         (|shoeCompTran1| |body|)
         (SETQ |$locVars|
-              (SETDIFFERENCE (SETDIFFERENCE |$locVars| |$fluidVars|)
+              (|setDifference|
+                  (|setDifference| |$locVars| |$fluidVars|)
                   (|shoeATOMs| |args|)))
         (SETQ |body|
               (PROGN
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index d19d76d8..6843b904 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -237,7 +237,6 @@
                   (LIST '|rest| 'CDR) (LIST '|sameObject?| 'EQ)
                   (LIST '|scalarEq?| 'EQL) (LIST '|scalarEqual?| 'EQL)
                   (LIST '|second| 'CADR)
-                  (LIST '|setDifference| 'SETDIFFERENCE)
                   (LIST '|setIntersection| 'INTERSECTION)
                   (LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION)
                   (LIST '|strconc| 'CONCAT) (LIST '|stringChar| 'SCHAR)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 5aff56f2..cff321ef 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -13,6 +13,8 @@
 
 (PROVIDE "translator")
 
+(EXPORT '|evalBootFile|)
+
 (DEFPARAMETER |$currentModuleName| NIL)
 
 (DEFPARAMETER |$foreignsDefsForCLisp| NIL)
@@ -228,7 +230,7 @@
     (T (|shoePCompileTrees| (|shoeTransformStream| |a|))
        (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED")))))
 
-(DEFUN EVAL-BOOT-FILE (|fn|)
+(DEFUN |evalBootFile| (|fn|)
   (PROG (|outfn| |infn| |b|)
     (RETURN
       (PROGN
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 4f9a741f..38951dd9 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -7,8 +7,8 @@
 
 (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?|
              |scalarMember?| |listMember?| |reverse| |reverse!|
-             |lastNode| |append!| |copyList| |substitute|
-             |substitute!|))
+             |lastNode| |append!| |copyList| |substitute| |substitute!|
+             |setDifference|))
 
 (DEFUN |objectMember?| (|x| |l|)
   (LOOP
@@ -142,3 +142,23 @@
            (T (CONS |h| |t|))))
         (T |s|)))))
 
+(DEFUN |setDifference| (|x| |y|)
+  (PROG (|a| |l| |p|)
+    (RETURN
+      (COND
+        ((NULL |x|) NIL)
+        ((NULL |y|) |x|)
+        (T (SETQ |l| (SETQ |p| (LIST NIL)))
+           (LET ((|bfVar#1| |x|))
+             (LOOP
+               (COND
+                 ((ATOM |bfVar#1|) (RETURN NIL))
+                 (T (AND (CONSP |bfVar#1|)
+                         (PROGN (SETQ |a| (CAR |bfVar#1|)) T)
+                         (NOT (|objectMember?| |a| |y|))
+                         (PROGN
+                           (RPLACD |p| (LIST |a|))
+                           (SETQ |p| (CDR |p|))))))
+               (SETQ |bfVar#1| (CDR |bfVar#1|))))
+           (CDR |l|))))))
+
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 3843b785..0ac85387 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -298,7 +298,6 @@ for i in [ _
   ["scalarEq?",   "EQL" ] , _
   ["scalarEqual?","EQL" ] , _
   ["second",      "CADR"] , _
-  ["setDifference", "SETDIFFERENCE"]  , _
   ["setIntersection", "INTERSECTION"]  , _
   ["setPart",   "SETELT"]  , _
   ["setUnion",   "UNION"]  , _
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index ef5cff04..d7bb643d 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -39,7 +39,7 @@ import pile
 import parser
 import ast
 namespace BOOTTRAN
-module translator
+module translator (evalBootFile)
 
 ++ If non nil, holds the name of the current module being translated.
 $currentModuleName := nil
@@ -163,7 +163,7 @@ shoeMc(a,fn)==
   shoePCompileTrees shoeTransformStream a
   shoeConsole strconc(fn,'" COMPILED AND LOADED")
  
-EVAL_-BOOT_-FILE fn ==
+evalBootFile fn ==
    b := _*PACKAGE_*
    IN_-PACKAGE '"BOOTTRAN"
    infn:=shoeAddbootIfNec fn
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 6527a07a..0b15569c 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -34,7 +34,7 @@ import initial_-env
 namespace BOOTTRAN
 module utility (objectMember?, symbolMember?, stringMember?,
   charMember?, scalarMember?, listMember?, reverse, reverse!,
-  lastNode, append!, copyList, substitute, substitute!)
+  lastNode, append!, copyList, substitute, substitute!, setDifference)
 
 --% membership operators
 
@@ -46,7 +46,6 @@ objectMember?(x,l) ==
       l := rest l
     return sameObject?(x,l)
 
-
 symbolMember?(s,l) ==
   repeat
     l = nil => return false
@@ -154,3 +153,13 @@ substitute(y,x,s) ==
     [h,:t]
   s
   
+--% set operations
+
+setDifference(x,y) ==
+  x = nil => nil
+  y = nil => x
+  l := p := [nil]
+  for [a,:.] in tails x | not objectMember?(a,y) repeat
+    p.rest := [a]
+    p := rest p
+  rest l
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 607e6e39..487f85e7 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -336,17 +336,17 @@ orderPredTran(oldList,sig,skip) ==
 --  pp oldList
 
   --(3b) newList= list of ofCat/isDom entries that don't depend on
-  while oldList repeat
+  while oldList ~= nil repeat
     for x in oldList repeat
       if (x is ['ofCategory,v,body]) or (x is ['isDomain,v,body]) then
-        indepvl:=listOfPatternIds v
-        depvl:=listOfPatternIds body
+        indepvl := listOfPatternIds v
+        depvl := listOfPatternIds body
       else
         indepvl := listOfPatternIds x
         depvl := nil
       (INTERSECTIONQ(indepvl,dependList) = nil) =>
-        dependList:= setDifference(dependList,depvl)
-        newList:= [:newList,x]
+        dependList := setDifference(dependList,depvl)
+        newList := [:newList,x]
 --  sayBrightlyNT "newList="
 --  pp newList
 
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 1d7a12d6..acca5b76 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1245,12 +1245,12 @@ orderByDependency(vl,dl) ==
   for v in vl for d in dl | symbolMember?(v,d) repeat
     (SAY(v," depends on itself"); fatalError:= true)
   fatalError => userError '"Parameter specification error"
-  until (null vl) repeat
+  until vl = nil repeat
     newl:=
       [v for v in vl for d in dl | null intersection(d,vl)] or return nil
     orderedVarList:= [:newl,:orderedVarList]
-    vl':= setDifference(vl,newl)
-    dl':= [setDifference(d,newl) for x in vl for d in dl
+    vl' := setDifference(vl,newl)
+    dl' := [setDifference(d,newl) for x in vl for d in dl
              | symbolMember?(x,vl')]
     vl := vl'
     dl := dl'
diff --git a/src/interp/incl.boot b/src/interp/incl.boot
index 8bfe69d9..578f3ff2 100644
--- a/src/interp/incl.boot
+++ b/src/interp/incl.boot
@@ -166,11 +166,11 @@ fileNameStrings fn==
  
 ifCond(s, info) ==
   word := makeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset)
-  ListMemberQ?(word, $inclAssertions)
+  symbolMember?(word,$inclAssertions)
  
 assertCond(s, info) ==
   word := makeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset)
-  if not ListMemberQ?(word, $inclAssertions) then
+  if not symbolMember?(word,$inclAssertions) then
     $inclAssertions := [word, :$inclAssertions]
  
  
diff --git a/src/interp/macex.boot b/src/interp/macex.boot
index d25074f6..fdc0c5ff 100644
--- a/src/interp/macex.boot
+++ b/src/interp/macex.boot
@@ -86,8 +86,7 @@ macLambdaParameterHandling( replist , pform )  ==
     for p in pfParts pform repeat macLambdaParameterHandling( replist , p )
 
 macSubstituteId( replist , pform ) ==
-    ex := AlistAssocQ( pfIdSymbol pform , replist )
-    ex => 
+    ex := symbolAssoc( pfIdSymbol pform , replist ) =>
         RPLPAIR(pform,rest ex)
         pform
     pform 
diff --git a/src/interp/unlisp.lisp b/src/interp/unlisp.lisp
index 38804adc..bf41d526 100644
--- a/src/interp/unlisp.lisp
+++ b/src/interp/unlisp.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -124,23 +124,9 @@
     'string )) )
 
 ;;;
-;;; Lists
-;;;
-
-
-(defun |ListMemberQ?| (ob l)
-  (member ob l :test #'eq) )
-
-(defun |ListRemoveQ| (ob l)
-  (remove ob l :test #'eq :count 1) )
-
-;;;
 ;;; Association lists
 ;;;
 
-(defun |AlistAssocQ| (key l)
-  (assoc key l :test #'eq) )
-
 (defun |AlistRemoveQ| (key l)
   (let ((pr (assoc key l :test #'eq)))
        (if pr