diff --git a/src/CHANGELOG b/src/CHANGELOG index 404b12a58..1087d95c8 100755 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -58,6 +58,9 @@ ECL 11.7.1: - ECL implements CDR 6 (ext:*inspector-hook*) as described in http://cdr.eurolisp.org/document/6/index.html + - ECL implements CDR 5 (Sub-interval Numerical Types) as described in + http://cdr.eurolisp.org/document/5/index.html + - ECL ships libffi together with its source tree, much like GMP and GC. - On POSIX platforms ECL traps SIGCHLD and uses it to update the status of diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 176fc2f60..71c4c1ee2 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -2062,5 +2062,99 @@ cl_symbols[] = { {SYS_ "GET-CDATA", SI_ORDINARY, si_get_cdata, 1, OBJNULL}, {SYS_ "ADD-CDATA", SI_ORDINARY, si_add_cdata, 2, OBJNULL}, +/* + * CDR-5 http://cdr.eurolisp.org/document/5/extra-num-types.html + */ + +{EXT_ "NEGATIVE-FIXNUM", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-FIXNUM", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-FIXNUM", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-FIXNUM", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-FIXNUM-P", EXT_ORDINARY, ECL_NAME(si_negative_fixnum_p), 1, OBJNULL}, +{EXT_ "POSITIVE-FIXNUM-P", EXT_ORDINARY, ECL_NAME(si_positive_fixnum_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-FIXNUM-P", EXT_ORDINARY, ECL_NAME(si_non_negative_fixnum_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-FIXNUM-P", EXT_ORDINARY, ECL_NAME(si_non_positive_fixnum_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-INTEGER", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-INTEGER", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-INTEGER", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-INTEGER", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-INTEGER-P", EXT_ORDINARY, ECL_NAME(si_negative_integer_p), 1, OBJNULL}, +{EXT_ "POSITIVE-INTEGER-P", EXT_ORDINARY, ECL_NAME(si_positive_integer_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-INTEGER-P", EXT_ORDINARY, ECL_NAME(si_non_negative_integer_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-INTEGER-P", EXT_ORDINARY, ECL_NAME(si_non_positive_integer_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-RATIONAL", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-RATIONAL", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-RATIONAL", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-RATIONAL", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-RATIONAL-P", EXT_ORDINARY, ECL_NAME(si_negative_rational_p), 1, OBJNULL}, +{EXT_ "POSITIVE-RATIONAL-P", EXT_ORDINARY, ECL_NAME(si_positive_rational_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-RATIONAL-P", EXT_ORDINARY, ECL_NAME(si_non_negative_rational_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-RATIONAL-P", EXT_ORDINARY, ECL_NAME(si_non_positive_rational_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-RATIO", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-RATIO", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-RATIO", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-RATIO", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-RATIO-P", EXT_ORDINARY, ECL_NAME(si_negative_ratio_p), 1, OBJNULL}, +{EXT_ "POSITIVE-RATIO-P", EXT_ORDINARY, ECL_NAME(si_positive_ratio_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-RATIO-P", EXT_ORDINARY, ECL_NAME(si_non_negative_ratio_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-RATIO-P", EXT_ORDINARY, ECL_NAME(si_non_positive_ratio_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-REAL", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-REAL", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-REAL", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-REAL", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-REAL-P", EXT_ORDINARY, ECL_NAME(si_negative_real_p), 1, OBJNULL}, +{EXT_ "POSITIVE-REAL-P", EXT_ORDINARY, ECL_NAME(si_positive_real_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-REAL-P", EXT_ORDINARY, ECL_NAME(si_non_negative_real_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-REAL-P", EXT_ORDINARY, ECL_NAME(si_non_positive_real_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_negative_float_p), 1, OBJNULL}, +{EXT_ "POSITIVE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_positive_float_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_negative_float_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_positive_float_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-SHORT-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-SHORT-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-SHORT-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-SHORT-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-SHORT-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_negative_short_float_p), 1, OBJNULL}, +{EXT_ "POSITIVE-SHORT-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_positive_short_float_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-SHORT-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_negative_short_float_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-SHORT-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_positive_short_float_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-SINGLE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-SINGLE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-SINGLE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-SINGLE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-SINGLE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_negative_single_float_p), 1, OBJNULL}, +{EXT_ "POSITIVE-SINGLE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_positive_single_float_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-SINGLE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_negative_single_float_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-SINGLE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_positive_single_float_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-DOUBLE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-DOUBLE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-DOUBLE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-DOUBLE-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-DOUBLE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_negative_double_float_p), 1, OBJNULL}, +{EXT_ "POSITIVE-DOUBLE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_positive_double_float_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-DOUBLE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_negative_double_float_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-DOUBLE-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_positive_double_float_p), 1, OBJNULL}, + +{EXT_ "NEGATIVE-LONG-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-NEGATIVE-LONG-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NON-POSITIVE-LONG-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "POSITIVE-LONG-FLOAT", EXT_ORDINARY, NULL, -1, OBJNULL}, +{EXT_ "NEGATIVE-LONG-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_negative_long_float_p), 1, OBJNULL}, +{EXT_ "POSITIVE-LONG-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_positive_long_float_p), 1, OBJNULL}, +{EXT_ "NON-NEGATIVE-LONG-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_negative_long_float_p), 1, OBJNULL}, +{EXT_ "NON-POSITIVE-LONG-FLOAT-P", EXT_ORDINARY, ECL_NAME(si_non_positive_long_float_p), 1, OBJNULL}, + /* Tag for end of list */ {NULL, CL_ORDINARY, NULL, -1, OBJNULL}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 07ff16246..aec7025c2 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -2062,5 +2062,99 @@ cl_symbols[] = { {SYS_ "GET-CDATA","si_get_cdata"}, {SYS_ "ADD-CDATA","si_add_cdata"}, +/* + * CDR-5 http://cdr.eurolisp.org/document/5/extra-num-types.html + */ + +{EXT_ "NEGATIVE-FIXNUM",NULL}, +{EXT_ "NON-NEGATIVE-FIXNUM",NULL}, +{EXT_ "NON-POSITIVE-FIXNUM",NULL}, +{EXT_ "POSITIVE-FIXNUM",NULL}, +{EXT_ "NEGATIVE-FIXNUM-P","ECL_NAME(si_negative_fixnum_p)"}, +{EXT_ "POSITIVE-FIXNUM-P","ECL_NAME(si_positive_fixnum_p)"}, +{EXT_ "NON-NEGATIVE-FIXNUM-P","ECL_NAME(si_non_negative_fixnum_p)"}, +{EXT_ "NON-POSITIVE-FIXNUM-P","ECL_NAME(si_non_positive_fixnum_p)"}, + +{EXT_ "NEGATIVE-INTEGER",NULL}, +{EXT_ "NON-NEGATIVE-INTEGER",NULL}, +{EXT_ "NON-POSITIVE-INTEGER",NULL}, +{EXT_ "POSITIVE-INTEGER",NULL}, +{EXT_ "NEGATIVE-INTEGER-P","ECL_NAME(si_negative_integer_p)"}, +{EXT_ "POSITIVE-INTEGER-P","ECL_NAME(si_positive_integer_p)"}, +{EXT_ "NON-NEGATIVE-INTEGER-P","ECL_NAME(si_non_negative_integer_p)"}, +{EXT_ "NON-POSITIVE-INTEGER-P","ECL_NAME(si_non_positive_integer_p)"}, + +{EXT_ "NEGATIVE-RATIONAL",NULL}, +{EXT_ "NON-NEGATIVE-RATIONAL",NULL}, +{EXT_ "NON-POSITIVE-RATIONAL",NULL}, +{EXT_ "POSITIVE-RATIONAL",NULL}, +{EXT_ "NEGATIVE-RATIONAL-P","ECL_NAME(si_negative_rational_p)"}, +{EXT_ "POSITIVE-RATIONAL-P","ECL_NAME(si_positive_rational_p)"}, +{EXT_ "NON-NEGATIVE-RATIONAL-P","ECL_NAME(si_non_negative_rational_p)"}, +{EXT_ "NON-POSITIVE-RATIONAL-P","ECL_NAME(si_non_positive_rational_p)"}, + +{EXT_ "NEGATIVE-RATIO",NULL}, +{EXT_ "NON-NEGATIVE-RATIO",NULL}, +{EXT_ "NON-POSITIVE-RATIO",NULL}, +{EXT_ "POSITIVE-RATIO",NULL}, +{EXT_ "NEGATIVE-RATIO-P","ECL_NAME(si_negative_ratio_p)"}, +{EXT_ "POSITIVE-RATIO-P","ECL_NAME(si_positive_ratio_p)"}, +{EXT_ "NON-NEGATIVE-RATIO-P","ECL_NAME(si_non_negative_ratio_p)"}, +{EXT_ "NON-POSITIVE-RATIO-P","ECL_NAME(si_non_positive_ratio_p)"}, + +{EXT_ "NEGATIVE-REAL",NULL}, +{EXT_ "NON-NEGATIVE-REAL",NULL}, +{EXT_ "NON-POSITIVE-REAL",NULL}, +{EXT_ "POSITIVE-REAL",NULL}, +{EXT_ "NEGATIVE-REAL-P","ECL_NAME(si_negative_real_p)"}, +{EXT_ "POSITIVE-REAL-P","ECL_NAME(si_positive_real_p)"}, +{EXT_ "NON-NEGATIVE-REAL-P","ECL_NAME(si_non_negative_real_p)"}, +{EXT_ "NON-POSITIVE-REAL-P","ECL_NAME(si_non_positive_real_p)"}, + +{EXT_ "NEGATIVE-FLOAT",NULL}, +{EXT_ "NON-NEGATIVE-FLOAT",NULL}, +{EXT_ "NON-POSITIVE-FLOAT",NULL}, +{EXT_ "POSITIVE-FLOAT",NULL}, +{EXT_ "NEGATIVE-FLOAT-P","ECL_NAME(si_negative_float_p)"}, +{EXT_ "POSITIVE-FLOAT-P","ECL_NAME(si_positive_float_p)"}, +{EXT_ "NON-NEGATIVE-FLOAT-P","ECL_NAME(si_non_negative_float_p)"}, +{EXT_ "NON-POSITIVE-FLOAT-P","ECL_NAME(si_non_positive_float_p)"}, + +{EXT_ "NEGATIVE-SHORT-FLOAT",NULL}, +{EXT_ "NON-NEGATIVE-SHORT-FLOAT",NULL}, +{EXT_ "NON-POSITIVE-SHORT-FLOAT",NULL}, +{EXT_ "POSITIVE-SHORT-FLOAT",NULL}, +{EXT_ "NEGATIVE-SHORT-FLOAT-P","ECL_NAME(si_negative_short_float_p)"}, +{EXT_ "POSITIVE-SHORT-FLOAT-P","ECL_NAME(si_positive_short_float_p)"}, +{EXT_ "NON-NEGATIVE-SHORT-FLOAT-P","ECL_NAME(si_non_negative_short_float_p)"}, +{EXT_ "NON-POSITIVE-SHORT-FLOAT-P","ECL_NAME(si_non_positive_short_float_p)"}, + +{EXT_ "NEGATIVE-SINGLE-FLOAT",NULL}, +{EXT_ "NON-NEGATIVE-SINGLE-FLOAT",NULL}, +{EXT_ "NON-POSITIVE-SINGLE-FLOAT",NULL}, +{EXT_ "POSITIVE-SINGLE-FLOAT",NULL}, +{EXT_ "NEGATIVE-SINGLE-FLOAT-P","ECL_NAME(si_negative_single_float_p)"}, +{EXT_ "POSITIVE-SINGLE-FLOAT-P","ECL_NAME(si_positive_single_float_p)"}, +{EXT_ "NON-NEGATIVE-SINGLE-FLOAT-P","ECL_NAME(si_non_negative_single_float_p)"}, +{EXT_ "NON-POSITIVE-SINGLE-FLOAT-P","ECL_NAME(si_non_positive_single_float_p)"}, + +{EXT_ "NEGATIVE-DOUBLE-FLOAT",NULL}, +{EXT_ "NON-NEGATIVE-DOUBLE-FLOAT",NULL}, +{EXT_ "NON-POSITIVE-DOUBLE-FLOAT",NULL}, +{EXT_ "POSITIVE-DOUBLE-FLOAT",NULL}, +{EXT_ "NEGATIVE-DOUBLE-FLOAT-P","ECL_NAME(si_negative_double_float_p)"}, +{EXT_ "POSITIVE-DOUBLE-FLOAT-P","ECL_NAME(si_positive_double_float_p)"}, +{EXT_ "NON-NEGATIVE-DOUBLE-FLOAT-P","ECL_NAME(si_non_negative_double_float_p)"}, +{EXT_ "NON-POSITIVE-DOUBLE-FLOAT-P","ECL_NAME(si_non_positive_double_float_p)"}, + +{EXT_ "NEGATIVE-LONG-FLOAT",NULL}, +{EXT_ "NON-NEGATIVE-LONG-FLOAT",NULL}, +{EXT_ "NON-POSITIVE-LONG-FLOAT",NULL}, +{EXT_ "POSITIVE-LONG-FLOAT",NULL}, +{EXT_ "NEGATIVE-LONG-FLOAT-P","ECL_NAME(si_negative_long_float_p)"}, +{EXT_ "POSITIVE-LONG-FLOAT-P","ECL_NAME(si_positive_long_float_p)"}, +{EXT_ "NON-NEGATIVE-LONG-FLOAT-P","ECL_NAME(si_non_negative_long_float_p)"}, +{EXT_ "NON-POSITIVE-LONG-FLOAT-P","ECL_NAME(si_non_positive_long_float_p)"}, + /* Tag for end of list */ {NULL,NULL}}; diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 62a569924..2e7fe7be9 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -1333,6 +1333,60 @@ (proclamation si:pointer (t) unsigned-byte) (proclamation si:foreign-data-p (t) gen-bool :pure) +;;; +;;; CDR-5 http://cdr.eurolisp.org/document/5/extra-num-types.html +;;; + +(proclamation ext:negative-fixnum-p (t) gen-bool :pure) +(proclamation ext:non-negative-fixnum-p (t) gen-bool :pure) +(proclamation ext:non-positive-fixnum-p (t) gen-bool :pure) +(proclamation ext:positive-fixnum-p (t) gen-bool :pure) + +(proclamation ext:negative-integer-p (t) gen-bool :pure) +(proclamation ext:non-negative-integer-p (t) gen-bool :pure) +(proclamation ext:non-positive-integer-p (t) gen-bool :pure) +(proclamation ext:positive-integer-p (t) gen-bool :pure) + +(proclamation ext:negative-rational-p (t) gen-bool :pure) +(proclamation ext:non-negative-rational-p (t) gen-bool :pure) +(proclamation ext:non-positive-rational-p (t) gen-bool :pure) +(proclamation ext:positive-rational-p (t) gen-bool :pure) + +(proclamation ext:negative-ratio-p (t) gen-bool :pure) +(proclamation ext:non-negative-ratio-p (t) gen-bool :pure) +(proclamation ext:non-positive-ratio-p (t) gen-bool :pure) +(proclamation ext:positive-ratio-p (t) gen-bool :pure) + +(proclamation ext:negative-real-p (t) gen-bool :pure) +(proclamation ext:non-negative-real-p (t) gen-bool :pure) +(proclamation ext:non-positive-real-p (t) gen-bool :pure) +(proclamation ext:positive-real-p (t) gen-bool :pure) + +(proclamation ext:negative-float-p (t) gen-bool :pure) +(proclamation ext:non-negative-float-p (t) gen-bool :pure) +(proclamation ext:non-positive-float-p (t) gen-bool :pure) +(proclamation ext:positive-float-p (t) gen-bool :pure) + +(proclamation ext:negative-short-float-p (t) gen-bool :pure) +(proclamation ext:non-negative-short-float-p (t) gen-bool :pure) +(proclamation ext:non-positive-short-float-p (t) gen-bool :pure) +(proclamation ext:positive-short-float-p (t) gen-bool :pure) + +(proclamation ext:negative-single-float-p (t) gen-bool :pure) +(proclamation ext:non-negative-single-float-p (t) gen-bool :pure) +(proclamation ext:non-positive-single-float-p (t) gen-bool :pure) +(proclamation ext:positive-single-float-p (t) gen-bool :pure) + +(proclamation ext:negative-double-float-p (t) gen-bool :pure) +(proclamation ext:non-negative-double-float-p (t) gen-bool :pure) +(proclamation ext:non-positive-double-float-p (t) gen-bool :pure) +(proclamation ext:positive-double-float-p (t) gen-bool :pure) + +(proclamation ext:negative-long-float-p (t) gen-bool :pure) +(proclamation ext:non-negative-long-float-p (t) gen-bool :pure) +(proclamation ext:non-positive-long-float-p (t) gen-bool :pure) +(proclamation ext:positive-long-float-p (t) gen-bool :pure) + ))) ; eval-when (loop for i in '#.(mapcar #'rest +proclamations+) diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp index b533fa664..93a39c136 100644 --- a/src/cmp/sysfun.lsp +++ b/src/cmp/sysfun.lsp @@ -870,7 +870,7 @@ (in-package "SI") (defvar c::*in-all-symbols-functions* - '(;; arraylib.lsp + `(;; arraylib.lsp make-array vector array-dimensions array-in-bounds-p array-row-major-index bit sbit bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor bit-andc1 bit-andc2 bit-orc1 bit-orc2 bit-not @@ -916,11 +916,9 @@ ;; pprint.lsp pprint-fill copy-pprint-dispatch pprint-dispatch pprint-linear pprint-newline pprint-tab pprint-tabular - set-pprint-dispatch pprint-indent . - #-clos - nil + set-pprint-dispatch pprint-indent #+clos - (;; combin.lsp + ,@'(;; combin.lsp method-combination-error invalid-method-error ;; standard-instance-access ; this function is a synonym for si:instance-ref @@ -933,6 +931,28 @@ slot-exists-p need-to-make-load-form-p ) + + ;; cdr-5 + ext:negative-fixnum-p ext:non-negative-fixnum-p + ext:non-positive-fixnum-p ext:positive-fixnum-p + ext:negative-integer-p ext:non-negative-integer-p + ext:non-positive-integer-p ext:positive-integer-p + ext:negative-rational-p ext:non-negative-rational-p + ext:non-positive-rational-p ext:positive-rational-p + ext:negative-ratio-p ext:non-negative-ratio-p + ext:non-positive-ratio-p ext:positive-ratio-p + ext:negative-real-p ext:non-negative-real-p + ext:non-positive-real-p ext:positive-real-p + ext:negative-float-p ext:non-negative-float-p + ext:non-positive-float-p ext:positive-float-p + ext:negative-short-float-p ext:non-negative-short-float-p + ext:non-positive-short-float-p ext:positive-short-float-p + ext:negative-single-float-p ext:non-negative-single-float-p + ext:non-positive-single-float-p ext:positive-single-float-p + ext:negative-double-float-p ext:non-negative-double-float-p + ext:non-positive-double-float-p ext:positive-double-float-p + ext:negative-long-float-p ext:non-negative-long-float-p + ext:non-positive-long-float-p ext:positive-long-float-p )) (proclaim @@ -953,6 +973,7 @@ si::fill-array-with-seq si::assert-failure si::traced-old-definition + #+formatter ,@'( format-princ format-prin1 format-print-named-character diff --git a/src/h/external.h b/src/h/external.h index 4e56212e2..9785c5751 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -2121,6 +2121,59 @@ extern ECL_API cl_object clos_standard_instance_set _ARGS((cl_narg narg, cl_obje #endif +/* + * CDR-5 + */ +extern ECL_API cl_object si_negative_fixnum_p(cl_object); +extern ECL_API cl_object si_non_negative_fixnum_p(cl_object); +extern ECL_API cl_object si_non_positive_fixnum_p(cl_object); +extern ECL_API cl_object si_positive_fixnum_p(cl_object); + +extern ECL_API cl_object si_negative_integer_p(cl_object); +extern ECL_API cl_object si_non_negative_integer_p(cl_object); +extern ECL_API cl_object si_non_positive_integer_p(cl_object); +extern ECL_API cl_object si_positive_integer_p(cl_object); + +extern ECL_API cl_object si_negative_rational_p(cl_object); +extern ECL_API cl_object si_non_negative_rational_p(cl_object); +extern ECL_API cl_object si_non_positive_rational_p(cl_object); +extern ECL_API cl_object si_positive_rational_p(cl_object); + +extern ECL_API cl_object si_negative_ratio_p(cl_object); +extern ECL_API cl_object si_non_negative_ratio_p(cl_object); +extern ECL_API cl_object si_non_positive_ratio_p(cl_object); +extern ECL_API cl_object si_positive_ratio_p(cl_object); + +extern ECL_API cl_object si_negative_real_p(cl_object); +extern ECL_API cl_object si_non_negative_real_p(cl_object); +extern ECL_API cl_object si_non_positive_real_p(cl_object); +extern ECL_API cl_object si_positive_real_p(cl_object); + +extern ECL_API cl_object si_negative_float_p(cl_object); +extern ECL_API cl_object si_non_negative_float_p(cl_object); +extern ECL_API cl_object si_non_positive_float_p(cl_object); +extern ECL_API cl_object si_positive_float_p(cl_object); + +extern ECL_API cl_object si_negative_short_float_p(cl_object); +extern ECL_API cl_object si_non_negative_short_float_p(cl_object); +extern ECL_API cl_object si_non_positive_short_float_p(cl_object); +extern ECL_API cl_object si_positive_short_float_p(cl_object); + +extern ECL_API cl_object si_negative_single_float_p(cl_object); +extern ECL_API cl_object si_non_negative_single_float_p(cl_object); +extern ECL_API cl_object si_non_positive_single_float_p(cl_object); +extern ECL_API cl_object si_positive_single_float_p(cl_object); + +extern ECL_API cl_object si_negative_double_float_p(cl_object); +extern ECL_API cl_object si_non_negative_double_float_p(cl_object); +extern ECL_API cl_object si_non_positive_double_float_p(cl_object); +extern ECL_API cl_object si_positive_double_float_p(cl_object); + +extern ECL_API cl_object si_negative_long_float_p(cl_object); +extern ECL_API cl_object si_non_negative_long_float_p(cl_object); +extern ECL_API cl_object si_non_positive_long_float_p(cl_object); +extern ECL_API cl_object si_positive_long_float_p(cl_object); + /* * LEGACY */ diff --git a/src/lsp/cdr-5.lsp b/src/lsp/cdr-5.lsp new file mode 100644 index 000000000..ca82b3ee4 --- /dev/null +++ b/src/lsp/cdr-5.lsp @@ -0,0 +1,341 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SYSTEM -*- +;;;; +;;;; Copyright (c) 2011, Juan Jose Garcia-Ripoll +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Library General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2 of the License, or (at your option) any later version. +;;;; +;;;; See file '../Copyright' for full details. + +(in-package "EXT") + +;;; +;;; List of symbols for symbols_list.h +;;; +#+(or) +(progn + (loop with *print-case* = :downcase + for i in '(fixnum integer rational ratio + real float short-float single-float + double-float long-float) + do (loop for j in '("negative-~a-p" "non-negative-~a-p" + "non-positive-~a-p" "positive-~a-p") + do (format t "ext:~? " j (list i))) + do (terpri)) + (loop for i in '(fixnum integer rational ratio + real float short-float single-float + double-float long-float) + for name = (substitute #\_ #\- (string-downcase i)) + do (loop for j in '("NEGATIVE-~A" "NON-NEGATIVE-~A" "NON-POSITIVE-~A" "POSITIVE-~A") + do (format t + "~%{EXT_ \"~?\", EXT_ORDINARY, NULL, -1, OBJNULL}," + j (list i))) + do (loop for j in + '("~%{EXT_ \"NEGATIVE-~A-P\", EXT_ORDINARY, ECL_NAME(si_negative_~A_p), 1, OBJNULL}," + "~%{EXT_ \"POSITIVE-~A-P\", EXT_ORDINARY, ECL_NAME(si_positive_~A_p), 1, OBJNULL}," + "~%{EXT_ \"NON-NEGATIVE-~A-P\", EXT_ORDINARY, ECL_NAME(si_non_negative_~A_p), 1, OBJNULL}," + "~%{EXT_ \"NON-POSITIVE-~A-P\", EXT_ORDINARY, ECL_NAME(si_non_positive_~A_p), 1, OBJNULL},") + do (format t j i name)) + do (terpri)) + (loop for i in '(fixnum integer rational ratio + real float short-float single-float + double-float long-float) + for name = (substitute #\_ #\- (string-downcase i)) + do (loop for j in '("negative" "non_negative" "non_positive" "positive") + do (format t "~%extern ECL_API cl_object si_~a_~a_p(cl_object);" j name)) + do (terpri)) + (loop with *print-case* = :downcase + for i in '(fixnum integer rational ratio + real float short-float single-float + double-float long-float) + do (loop for j in '("NEGATIVE-~A-P" "NON-NEGATIVE-~A-P" + "NON-POSITIVE-~A-P" "POSITIVE-~A-P") + for name = (format nil j (symbol-name i)) + for s = (intern name (find-package "EXT")) + do (print `(proclamation ,s (t) gen-bool :pure))) + do (terpri))) + +;;; +;;; Small integers +;;; + +(deftype negative-fixnum () + `(integer ,most-negative-fixnum -1)) + +(deftype non-positive-fixnum () + `(integer ,most-negative-fixnum 0)) + +(deftype non-negative-fixnum () + `(integer 0 , most-positive-fixnum)) + +(deftype positive-fixnum () + `(integer 1 ,most-positive-fixnum)) + +(defun negative-fixnum-p (p) + (and (si::fixnump p) (minusp (the fixnum p)))) + +(defun positive-fixnum-p (p) + (and (si::fixnump p) (plusp (the fixnum p)))) + +(defun non-negative-fixnum-p (p) + (and (si::fixnump p) (not (minusp (the fixnum p))))) + +(defun non-positive-fixnum-p (p) + (and (si::fixnump p) (not (plusp (the fixnum p))))) + +;;; +;;; Integers +;;; + +(deftype negative-integer () + '(integer * -1)) + +(deftype non-positive-integer () + '(integer * 0)) + +(deftype non-negative-integer () + '(integer 0 *)) + +(deftype positive-integer () + '(integer 1 *)) + +(defun negative-integer-p (p) + (and (integerp p) (minusp (the integer p)))) + +(defun positive-integer-p (p) + (and (integerp p) (plusp (the integer p)))) + +(defun non-negative-integer-p (p) + (and (integerp p) (not (minusp (the integer p))))) + +(defun non-positive-integer-p (p) + (and (integerp p) (not (plusp (the integer p))))) + +;;; +;;; Rationals +;;; + +(deftype negative-rational () + '(rational * (0))) + +(deftype non-positive-rational () + '(rational * 0)) + +(deftype non-negative-rational () + '(rational 0 *)) + +(deftype positive-rational () + '(rational (0) *)) + +(defun negative-rational-p (p) + (and (rationalp p) (minusp (the rational p)))) + +(defun positive-rational-p (p) + (and (rationalp p) (plusp (the rational p)))) + +(defun non-negative-rational-p (p) + (and (rationalp p) (not (minusp (the rational p))))) + +(defun non-positive-rational-p (p) + (and (rationalp p) (not (plusp (the rational p))))) + +;;; +;;; Ratios +;;; + +(defun ratiop (x) + (eq (type-of x) 'RATIO)) + +(defun positive-ratio-p (x) + (and (ratiop x) (plusp x))) + +(defun negative-ratio-p (x) + (and (ratiop x) (minusp x))) + +(deftype negative-ratio () + '(satisfies negative-ratio-p)) + +(deftype non-positive-ratio () + 'negative-ratio) + +(deftype non-negative-ratio () + 'positive-ratio) + +(deftype positive-ratio () + '(satisfies positive-ratio-p)) + +(defun non-negative-ratio-p (p) + (positive-ratio-p p)) + +(defun non-positive-ratio-p (p) + (negative-ratio-p p)) + +;;; +;;; Reals +;;; + +(deftype negative-real () + '(real * (0))) + +(deftype non-positive-real () + '(real * 0)) + +(deftype non-negative-real () + '(real 0 *)) + +(deftype positive-real () + '(real (0) *)) + +(defun negative-real-p (p) + (and (realp p) (minusp (the real p)))) + +(defun positive-real-p (p) + (and (realp p) (plusp (the real p)))) + +(defun non-negative-real-p (p) + (and (realp p) (not (minusp (the real p))))) + +(defun non-positive-real-p (p) + (and (realp p) (not (plusp (the real p))))) + +;;; +;;; Floats +;;; + +(deftype negative-float () + '(float * (0))) + +(deftype non-positive-float () + '(float * 0)) + +(deftype non-negative-float () + '(float 0 *)) + +(deftype positive-float () + '(float (0) *)) + +(defun negative-float-p (p) + (and (floatp p) (minusp (the float p)))) + +(defun positive-float-p (p) + (and (floatp p) (plusp (the float p)))) + +(defun non-negative-float-p (p) + (and (floatp p) (not (minusp (the float p))))) + +(defun non-positive-float-p (p) + (and (floatp p) (not (plusp (the float p))))) + +;;; +;;; SHORT-FLOAT +;;; + +(deftype negative-short-float () + '(short-float * (0S0))) + +(deftype non-positive-short-float () + '(short-float * 0S0)) + +(deftype non-negative-short-float () + '(short-float 0S0 *)) + +(deftype positive-short-float () + '(short-float (0S0) *)) + +(defun negative-short-float-p (p) + (and (short-floatp p) (minusp (the short-float p)))) + +(defun positive-short-float-p (p) + (and (short-floatp p) (plusp (the short-float p)))) + +(defun non-negative-short-float-p (p) + (and (short-floatp p) (not (minusp (the short-float p))))) + +(defun non-positive-short-float-p (p) + (and (short-floatp p) (not (plusp (the short-float p))))) + +;;; +;;; SINGLE-FLOAT +;;; + +(deftype negative-single-float () + '(single-float * (0F0))) + +(deftype non-positive-single-float () + '(single-float * 0F0)) + +(deftype non-negative-single-float () + '(single-float 0F0 *)) + +(deftype positive-single-float () + '(single-float (0F0) *)) + +(defun negative-single-float-p (p) + (and (single-floatp p) (minusp (the single-float p)))) + +(defun positive-single-float-p (p) + (and (single-floatp p) (plusp (the single-float p)))) + +(defun non-negative-single-float-p (p) + (and (single-floatp p) (not (minusp (the single-float p))))) + +(defun non-positive-single-float-p (p) + (and (single-floatp p) (not (plusp (the single-float p))))) + +;;; +;;; DOUBLE-FLOAT +;;; + +(deftype negative-double-float () + '(double-float * (0D0))) + +(deftype non-positive-double-float () + '(double-float * 0D0)) + +(deftype non-negative-double-float () + '(double-float 0D0 *)) + +(deftype positive-double-float () + '(double-float (0D0) *)) + +(defun negative-double-float-p (p) + (and (double-floatp p) (minusp (the double-float p)))) + +(defun positive-double-float-p (p) + (and (double-floatp p) (plusp (the double-float p)))) + +(defun non-negative-double-float-p (p) + (and (double-floatp p) (not (minusp (the double-float p))))) + +(defun non-positive-double-float-p (p) + (and (double-floatp p) (not (plusp (the double-float p))))) + +;;; +;;; LONG-FLOAT +;;; + +(deftype negative-long-float () + '(long-float * (0L0))) + +(deftype non-positive-long-float () + '(long-float * 0L0)) + +(deftype non-negative-long-float () + '(long-float 0L0 *)) + +(deftype positive-long-float () + '(long-float (0L0) *)) + +(defun negative-long-float-p (p) + (and (long-floatp p) (minusp (the long-float p)))) + +(defun positive-long-float-p (p) + (and (long-floatp p) (plusp (the long-float p)))) + +(defun non-negative-long-float-p (p) + (and (long-floatp p) (not (minusp (the long-float p))))) + +(defun non-positive-long-float-p (p) + (and (long-floatp p) (not (plusp (the long-float p))))) diff --git a/src/lsp/load.lsp.in b/src/lsp/load.lsp.in index 726c8b09d..c2d76ef7c 100644 --- a/src/lsp/load.lsp.in +++ b/src/lsp/load.lsp.in @@ -49,6 +49,7 @@ "src:lsp;module.lsp" "src:lsp;cmdline.lsp" "src:lsp;autoload.lsp" + "src:lsp;cdr-5.lsp" )) (mapc #'(lambda (x)