aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog10
-rw-r--r--src/boot/initial-env.lisp5
-rw-r--r--src/boot/strap/ast.clisp3
-rw-r--r--src/boot/strap/tokens.clisp1
-rw-r--r--src/boot/strap/translator.clisp4
-rw-r--r--src/boot/strap/utility.clisp24
-rw-r--r--src/boot/tokens.boot1
-rw-r--r--src/boot/translator.boot4
-rw-r--r--src/boot/utility.boot13
-rw-r--r--src/interp/database.boot10
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/incl.boot4
-rw-r--r--src/interp/macex.boot3
-rw-r--r--src/interp/unlisp.lisp16
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 06:47:27 +0000