mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-20 11:32:35 -08:00
Code Issues Projects Releases Packages Wiki Activity

Replaced most uses of FEtype_error_cons with FEwrong_type_*_arg

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-02-25 17:17:00 +01:00
parent 2c2c329b09
commit 0bd19734d7
2 changed files with 11 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/c/interpreter.d
View file

@ -333,13 +333,15 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
}
CASE(OP_CAR); {
if (ecl_unlikely(!LISTP(reg0))) FEtype_error_cons(reg0);
if (ecl_unlikely(!LISTP(reg0)))
FEwrong_type_only_arg(@'car', reg0, @'cons');
reg0 = CAR(reg0);
THREAD_NEXT;
}
CASE(OP_CDR); {
if (ecl_unlikely(!LISTP(reg0))) FEtype_error_cons(reg0);
if (ecl_unlikely(!LISTP(reg0)))
FEwrong_type_only_arg(@'cdr', reg0, @'cons');
reg0 = CDR(reg0);
THREAD_NEXT;
}

12
src/new-cmp/cmpfun.lsp
View file

@ -113,17 +113,19 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
,(if car-p "ECL_CONS_CAR(#0)=#1" "ECL_CONS_CDR(#0)=#1")
:one-liner t)))
(if (policy-assume-right-type env)
(main-form car-p cons value)
(let ((aux (gensym)))
`(let ((,aux ,cons))
(declare (:read-only ,aux))
(when (atom ,aux)
(error-not-a-cons ,aux))
(error-not-a 'rplaca 1 ,aux 'cons))
(locally (declare (optimize (safety 0)))
,(main-form car-p aux value))))
(main-form car-p cons value))))
,(main-form car-p aux value)))))))
(defmacro error-not-a-cons (object)
`(c-inline (,object) (:object) :void "FEtype_error_cons(#0);" :one-liner nil))
(defmacro error-not-a (name ndx object type)
`(c-inline (name ,ndx ,object 'cons)
(:object :index :object :object) :void
"FEwrong_type_nth_arg(#0,#1,#2,#3);" :one-liner nil))
(define-compiler-macro rplaca (&whole form cons value &environment env)
(if (policy-open-code-accessors env)