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

Simplified the code for type assertions in the compiler

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-11-30 10:23:36 +01:00
parent 8723188e73
commit f32174203b
1 changed files with 17 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

41
src/cmp/cmptype-assert.lsp
View file

@ -40,30 +40,23 @@
(subtypep var-type type))
return (c2expr form)))
(defconstant +simple-type-assertions+
'((cons . "if (ecl_unlikely(ECL_ATOM(#0))) FEtype_error_cons(#0);")
(array . "if (ecl_unlikely(!ECL_ARRAYP(#0))) FEtype_error_array(#0);")
(list . "if (ecl_unlikely(!ECL_LISTP(#0))) FEtype_error_list(#0);")
(sequence . "if (ecl_unlikely(!(ECL_LISTP(#0) || ECL_VECTORP(#0))))
FEtype_error_sequence(#0);")
(vector . "if (ecl_unlikely(!ECL_VECTORP(#0))) FEtype_error_vector(#0);")))
(defun simple-type-assertion (value type env)
(case type
(cons
`(ffi:c-inline (,value) (:object) :void
"@0;if (ecl_unlikely(ECL_ATOM(#0))) FEtype_error_cons(#0);"
:one-liner nil))
(array
`(ffi:c-inline (,value) (:object) :void
"if (ecl_unlikely(!ECL_ARRAYP(#0))) FEtype_error_array(#0);"
:one-liner nil))
(list
`(ffi:c-inline (,value) (:object) :void
"if (ecl_unlikely(!ECL_LISTP(#0))) FEtype_error_list(#0);"
:one-liner nil))
(sequence
`(ffi:c-inline (,value) (:object) :void
"if (ecl_unlikely(!(ECL_LISTP(#0) || ECL_VECTORP(#0))))
FEtype_error_sequence(#0);"
:one-liner nil))
(otherwise
`(ffi:c-inline
((typep ,value ',type) ',type ,value)
(:bool :object :object) :void
"if (ecl_unlikely(!(#0)))
(let ((simple-form (cdr (assoc type +simple-type-assertions+))))
(if simple-form
`(ffi:c-inline (,value) (:object) :void ,simple-form
:one-liner nil)
`(ffi:c-inline
((typep ,value ',type) ',type ,value)
(:bool :object :object) :void
"if (ecl_unlikely(!(#0)))
FEwrong_type_argument(#1,#2);" :one-liner nil))))
(defun expand-type-assertion (value type env compulsory)
@ -130,7 +123,7 @@
(defun c2checked-value (c1form type value let-form)
(c2expr (if (subtypep (c1form-primary-type value) type)
value
let-form)))
let-form)))
(defmacro optional-type-assertion (&whole whole value type &environment env)
"If safety settings are high enough, generates a type check on an