From 0bd19734d7bd4ae76b2938ed64a589e17a6da125 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Thu, 25 Feb 2010 17:17:00 +0100 Subject: [PATCH] Replaced most uses of FEtype_error_cons with FEwrong_type_*_arg --- src/c/interpreter.d | 6 ++++-- src/new-cmp/cmpfun.lsp | 12 +++++++----- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 45f932ef9..9c6c759ca 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -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; } diff --git a/src/new-cmp/cmpfun.lsp b/src/new-cmp/cmpfun.lsp index f1b0a779f..5025d0c52 100644 --- a/src/new-cmp/cmpfun.lsp +++ b/src/new-cmp/cmpfun.lsp @@ -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)