aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog10
-rw-r--r--src/boot/ast.boot6
-rw-r--r--src/boot/initial-env.lisp16
-rw-r--r--src/boot/strap/tokens.clisp4
-rw-r--r--src/boot/strap/translator.clisp12
-rw-r--r--src/boot/tokens.boot4
-rw-r--r--src/boot/translator.boot12
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/scan.boot3
-rw-r--r--src/interp/vmlisp.lisp4
-rw-r--r--src/lisp/core.lisp.in12
11 files changed, 42 insertions, 43 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index a785fd16..1b5e08d8 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2011-05-12 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * boot/initial-env.lisp (MAKE-HASHTABLE): Remove.
+ (BEVC-MAKE-FULL): Likewise.
+ (MAKE-BVEC): Likewise.
+ * boot/tokens.boot (shoeKeyTableCons): Adjust.
+ (shoePunCons): Likewise.
+ (shoeDfu): Likewise.
+ (shoeXref): Likewise.
+
2011-05-07 Gabriel Dos Reis <gdr@cs.tamu.edu>
* algebra/table.spad.pamphlet (HashTable): Use tableValue instead
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index d757cda4..b7b50c51 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -315,9 +315,11 @@ bfUntil p==
g:=bfGenSymbol()
[[[g],[nil],[['SETQ,g,p]],[],[g],[]]]
-bfIterators x==["ITERATORS",:x]
+bfIterators x ==
+ ["ITERATORS",:x]
-bfCross x== ["CROSS",:x]
+bfCross x ==
+ ["CROSS",:x]
bfLp(iters,body)==
iters is ["ITERATORS",:.] => bfLp1(rest iters,body)
diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp
index 9596211a..1f050115 100644
--- a/src/boot/initial-env.lisp
+++ b/src/boot/initial-env.lisp
@@ -86,14 +86,6 @@
(shoeprettyprin0 x stream)
(terpri stream))
-(defun MAKE-HASHTABLE (id1)
- (let ((test (case id1
- ((EQ ID) #'eq)
- (CVEC #'equal)
- ((UEQUAL EQUAL) #'equal)
- (otherwise (error "bad arg to make-hashtable")))))
- (make-hash-table :test test)))
-
(defun HKEYS (table)
(let (keys)
(maphash #'(lambda (key val)
@@ -122,14 +114,6 @@
(position table cvec
:test-not #'(lambda (x y) (position y x))
:start sint)))
-
-(defun bvec-make-full (n x)
- (make-array (list n)
- :element-type 'bit
- :initial-element x))
-
-(defun make-bvec (n)
- (bvec-make-full n 0))
(defun |shoeReadLisp| (s n)
(multiple-value-list (read-from-string s nil nil :start n)))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 2891cea0..8080f322 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -58,7 +58,7 @@
(PROG (|KeyTable|)
(RETURN
(PROGN
- (SETQ |KeyTable| (MAKE-HASHTABLE 'CVEC))
+ (SETQ |KeyTable| (|makeTable| #'EQUAL))
(LET ((|bfVar#2| |shoeKeyWords|) (|st| NIL))
(LOOP
(COND
@@ -136,7 +136,7 @@
(RETURN
(PROGN
(SETQ |listing| (HKEYS |shoeKeyTable|))
- (SETQ |a| (MAKE-BVEC 256))
+ (SETQ |a| (|makeBitVector| 256))
(LET ((|i| 0))
(LOOP
(COND
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 0d3d6a67..312bca9e 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -842,11 +842,11 @@
(RETURN
(COND
((NULL |a|) (|shoeNotFound| |fn|))
- (T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
+ (T (SETQ |$lispWordTable| (|makeTable| #'EQ))
(DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
(SETF (|tableValue| |$lispWordTable| |i|) T))
- (SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
- (SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootDefined| (|makeTable| #'EQ))
+ (SETQ |$bootUsed| (|makeTable| #'EQ))
(SETQ |$bootDefinedTwice| NIL) (SETQ |$GenVarCounter| 0)
(SETQ |$bfClamming| NIL)
(|shoeDefUse| (|shoeTransformStream| |a|))
@@ -1144,11 +1144,11 @@
(RETURN
(COND
((NULL |a|) (|shoeNotFound| |fn|))
- (T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
+ (T (SETQ |$lispWordTable| (|makeTable| #'EQ))
(DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
(SETF (|tableValue| |$lispWordTable| |i|) T))
- (SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
- (SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootDefined| (|makeTable| #'EQ))
+ (SETQ |$bootUsed| (|makeTable| #'EQ))
(SETQ |$GenVarCounter| 0) (SETQ |$bfClamming| NIL)
(|shoeDefUse| (|shoeTransformStream| |a|))
(SETQ |out| (CONCAT |fn| ".xref"))
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index f0dbe004..905f4426 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -128,7 +128,7 @@ shoeKeyWords == [ _
shoeKeyTableCons()==
- KeyTable:=MAKE_-HASHTABLE("CVEC")
+ KeyTable := makeTable function valueEq?
for st in shoeKeyWords repeat
tableValue(KeyTable,first st) := second st
KeyTable
@@ -170,7 +170,7 @@ shoeDict:=shoeDictCons()
shoePunCons()==
listing := HKEYS shoeKeyTable
- a := MAKE_-BVEC 256
+ a := makeBitVector 256
for i in 0..255 repeat
bitmask(a,i) := 0
for k in listing repeat
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index d258a78d..151b4f73 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -525,10 +525,10 @@ $lispWordTable := nil
shoeDfu(a,fn)==
a=nil => shoeNotFound fn
- $lispWordTable: local := MAKE_-HASHTABLE ("EQ")
+ $lispWordTable: local := makeTable function symbolEq?
DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),tableValue($lispWordTable,i) := true)
- $bootDefined: local :=MAKE_-HASHTABLE "EQ"
- $bootUsed:local := MAKE_-HASHTABLE "EQ"
+ $bootDefined: local := makeTable function symbolEq?
+ $bootUsed:local := makeTable function symbolEq?
$bootDefinedTwice: local := nil
$GenVarCounter: local := 0
$bfClamming: local := false
@@ -642,10 +642,10 @@ XREF fn==
shoeXref(a,fn)==
a = nil => shoeNotFound fn
- $lispWordTable: local := MAKE_-HASHTABLE ("EQ")
+ $lispWordTable: local := makeTable function symbolEq?
DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),tableValue($lispWordTable,i) := true)
- $bootDefined: local := MAKE_-HASHTABLE "EQ"
- $bootUsed: local := MAKE_-HASHTABLE "EQ"
+ $bootDefined: local := makeTable function symbolEq?
+ $bootUsed: local := makeTable function symbolEq?
$GenVarCounter: local := 0
$bfClamming: local := false
shoeDefUse shoeTransformStream a
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 356f80d8..fbfc9efe 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -458,7 +458,7 @@ $VMsideEffectFreeOperators ==
$simpleVMoperators ==
append($VMsideEffectFreeOperators,
['STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse!,
- '%strstc,"MAKE-FULL-CVEC","BVEC-MAKE-FULL"])
+ '%strstc,"MAKE-FULL-CVEC"])
++ Return true if the `form' is semi-simple with respect to
++ to the list of operators `ops'.
diff --git a/src/interp/scan.boot b/src/interp/scan.boot
index 8b49fa4a..23533311 100644
--- a/src/interp/scan.boot
+++ b/src/interp/scan.boot
@@ -192,8 +192,7 @@ scanDict:=scanDictCons()
scanPunCons()==
listing := HKEYS scanKeyTable
- a := MAKE_-BVEC 256
--- SETSIZE(a,256)
+ a := makeBitVector 256
for i in 0..255 repeat
bitmask(a,i) := 0
for k in listing repeat
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index ff5ff941..4159b32d 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1578,7 +1578,3 @@
(defun QUOREM (i j r) ; never used, refed in parini.boot
(multiple-value-bind (x y) (truncate i j)
(rplaca (the cons r) x) (rplacd (the cons r) y)))
-
-(defun MAKE-BVEC (n)
- (make-array (list n) :element-type 'bit :initial-element 0))
-
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index 49396264..74f43cf1 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -83,8 +83,9 @@
"%SimpleArray"
;; Some common data structures
- "tableValue" ; value associated with a key in a table
- "tableLength" ; number of entries in the table.
+ "makeTable" ; construct a hash table with a given comp function
+ "tableValue" ; value associated with a key in a table
+ "tableLength" ; number of entries in the table.
"tableRemove!" ; remove an entry from a table
;; IO
@@ -132,6 +133,7 @@
"%ByteArray"
"makeByteArray"
+ "makeBitVector"
"makeString"
"%hasFeature"
@@ -454,6 +456,9 @@
(t -1))))
;; -*- Hash table -*-
+(defmacro |makeTable| (cmp)
+ `(make-hash-table :test ,cmp))
+
(defmacro |tableValue| (ht k)
`(gethash ,k ,ht))
@@ -1303,6 +1308,9 @@
:element-type '(unsigned-byte 8)
:initial-element 0))
+(defmacro |makeBitVector| (n)
+ `(make-array ,n :element-type 'bit :initial-element 0))
+
(defun |makeString| (n &optional (c (code-char 0)))
(make-string n :initial-element c))
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 14:26:32 +0000