diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/boot/ast.boot | 6 | ||||
| -rw-r--r-- | src/boot/initial-env.lisp | 16 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 4 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 12 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 4 | ||||
| -rw-r--r-- | src/boot/translator.boot | 12 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 2 | ||||
| -rw-r--r-- | src/interp/scan.boot | 3 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp | 4 | ||||
| -rw-r--r-- | src/lisp/core.lisp.in | 12 |
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)) |