mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 14:21:48 -08:00
Code Issues Projects Releases Packages Wiki Activity

find-built-in-tag now uses a hash table instead of an association list.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-12-10 19:31:04 +01:00
parent efc7413d28
commit df7de09d0b
1 changed files with 24 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

43
src/lsp/predlib.lsp
View file

@ -1158,7 +1158,7 @@ if not possible."
;; Note 2: All built in types listed here have to be symbols.
;;
#+ecl-min
(defconstant +built-in-types+
(defconstant +built-in-type-list+
'((SYMBOL)
(KEYWORD NIL SYMBOL)
(PACKAGE)
@ -1239,26 +1239,31 @@ if not possible."
(CODE-BLOCK)
))
(defconstant +built-in-types+
(ext:hash-table-fill
(make-hash-table :test 'eq :size 128)
'#.+built-in-type-list+))
(defun find-built-in-tag (name)
(declare (si::c-local))
(when (eq name T)
(return-from find-built-in-tag -1))
(dolist (i '#.+built-in-types+)
(declare (cons i))
(when (eq name (first i))
(let* ((alias (second i))
(strict-supertype (or (third i) 'T))
(tag))
(if alias
(setq tag (canonical-type alias))
(let* ((strict-supertype-tag (canonical-type strict-supertype)))
(setq tag (new-type-tag))
(unless (eq strict-supertype 't)
(extend-type-tag tag strict-supertype-tag))))
(push-type name tag)
(return-from find-built-in-tag tag)
)))
nil)
(let (record)
(cond ((eq name T)
-1)
((eq (setf record (gethash name +built-in-types+ name))
name)
nil)
(t
(let* ((alias (pop record))
tag)
(if alias
(setq tag (canonical-type alias))
(let* ((strict-supertype (or (first record) 'T))
(strict-supertype-tag (canonical-type strict-supertype)))
(setq tag (new-type-tag))
(unless (eq strict-supertype 't)
(extend-type-tag tag strict-supertype-tag))))
(push-type name tag)
tag)))))
(defun extend-type-tag (tag minimal-supertype-tag)
(declare (si::c-local))