Menu
▾
▴
clisp-cvs digest, Vol 1 #720 - 10 msgs
|
From: <cli...@li...> - 2004-10-02 04:52:47
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src defmacro.lisp,1.28,1.29 ChangeLog,1.3605,1.3606 (Bruno Haible) 2. clisp/src genclisph.d,1.149,1.150 (Bruno Haible) 3. clisp/src TODO,1.19,1.20 (Bruno Haible) 4. clisp/src sequence.d,1.84,1.85 defseq.lisp,1.3,1.4 ChangeLog,1.3606,1.3607 (Bruno Haible) 5. clisp/src sequence.d,1.85,1.86 array.d,1.93,1.94 constsym.d,1.270,1.271 type.lisp,1.63,1.64 ChangeLog,1.3607,1.3608 (Bruno Haible) 6. clisp/src type.lisp,1.64,1.65 ChangeLog,1.3608,1.3609 (Bruno Haible) 7. clisp/src sequence.d,1.86,1.87 (Bruno Haible) 8. clisp/modules/bindings/glibc linux.lisp,1.11,1.12 (Jörg Höhle) 9. clisp/src ChangeLog,1.3609,1.3610 (Jörg Höhle) 10. clisp/src ChangeLog,1.3610,1.3611 (Sam Steingold) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src defmacro.lisp,1.28,1.29 ChangeLog,1.3605,1.3606 Date: Fri, 01 Oct 2004 11:20:23 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12257/src Modified Files: defmacro.lisp ChangeLog Log Message: Avoid producing macroexpansions that contain literal strings (since these strings will end up duplicated in many .fas files). Index: defmacro.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defmacro.lisp,v retrieving revision 1.28 retrieving revision 1.29 diff -u -d -r1.28 -r1.29 --- defmacro.lisp 22 Aug 2004 10:48:25 -0000 1.28 +++ defmacro.lisp 1 Oct 2004 11:20:18 -0000 1.29 @@ -47,6 +47,13 @@ (TEXT "The macro ~S may not be called with ~S arguments: ~S") (car macro-form) (1- (length macro-form)) macro-form)) +(defun macro-nonnull-element-error (macro-form macro-name element) + (error-of-type 'source-program-error + :form macro-form + :detail element + (TEXT "~S: ~S does not match lambda list element ~:S") + macro-name element '())) + (proclaim '(special %whole-form ;; the whole source form being macroexpanded or compiled @@ -280,16 +287,12 @@ (cons (cdr h) (cdr exp)) (list 'cdr exp))) -(defun empty-pattern (name accessexp wholevar &aux (g (gensym))) - (setq %let-list (cons `(,g ,(cons-car accessexp)) %let-list) - %null-tests (cons - `(if ,g - (error-of-type 'source-program-error - :form ,wholevar - :detail ,g - (TEXT "~S: ~S does not match lambda list element ~:S") - ',name ,g '())) - %null-tests))) +(defun empty-pattern (name accessexp wholevar) + (let ((g (gensym))) + (setq %let-list (cons `(,g ,(cons-car accessexp)) %let-list)) + (setq %null-tests + (cons `(WHEN ,g (MACRO-NONNULL-ELEMENT-ERROR ,wholevar ',name ,g)) + %null-tests)))) (defun analyze1 (lambdalist accessexp name wholevar) (do ((listr lambdalist (cdr listr)) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3605 retrieving revision 1.3606 diff -u -d -r1.3605 -r1.3606 --- ChangeLog 29 Sep 2004 12:16:20 -0000 1.3605 +++ ChangeLog 1 Oct 2004 11:20:18 -0000 1.3606 @@ -1,5 +1,10 @@ 2004-09-29 Bruno Haible <br...@cl...> + * defmacro.lisp (macro-nonnull-element-error): New function. + (empty-pattern): Use it in the macroexpansion. + +2004-09-29 Bruno Haible <br...@cl...> + * fill-out.lisp (stream-start-s-expression, stream-end-s-expression): No need for EVAL-WHEN (COMPILE). * format.lisp (formatter-main-1): Don't call STREAM-START-S-EXPRESSION --__--__-- Message: 2 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src genclisph.d,1.149,1.150 Date: Fri, 01 Oct 2004 11:20:53 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12481/src Modified Files: genclisph.d Log Message: Comments. Index: genclisph.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/genclisph.d,v retrieving revision 1.149 retrieving revision 1.150 diff -u -d -r1.149 -r1.150 --- genclisph.d 15 Sep 2004 14:04:37 -0000 1.149 +++ genclisph.d 1 Oct 2004 11:20:49 -0000 1.150 @@ -7,9 +7,10 @@ #include "lispbibl.c" /* - * Print numbers as strings, like with printf(). - * Only numbers of type `unsigned long long' need work. - * We avoid presuming <stdarg.h> or <varargs.h>. + * Printing of strings with embedded numbers, like with printf(). + * The major difference is that the numbers can also be of type + * 'unsigned long long' (which printf() does not support in a portable way). + * We don't even need to assume the existence of <stdarg.h>. */ typedef struct { --__--__-- Message: 3 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src TODO,1.19,1.20 Date: Fri, 01 Oct 2004 11:21:15 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12588/src Modified Files: TODO Log Message: Another item. Index: TODO =================================================================== RCS file: /cvsroot/clisp/clisp/src/TODO,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- TODO 27 Sep 2004 00:13:46 -0000 1.19 +++ TODO 1 Oct 2004 11:21:13 -0000 1.20 @@ -33,6 +33,12 @@ Embeddability: additional API in spvw.d; global error handler; example. +Remove all unnecessary MACROEXPAND calls from compiler.lisp. When a macro +is also a special form or a compiler macro, the special form handler or +the compiler should be used, not the regular macro, for efficiency reasons. +Use macroexpand-form instead. + + Better error checking in get-setf-expansion for long defsetf --__--__-- Message: 4 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src sequence.d,1.84,1.85 defseq.lisp,1.3,1.4 ChangeLog,1.3606,1.3607 Date: Fri, 01 Oct 2004 11:22:38 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12674/src Modified Files: sequence.d defseq.lisp ChangeLog Log Message: Merge the two sequence types 1 and BIT-VECTOR into one. Index: defseq.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defseq.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- defseq.lisp 1 Apr 2003 22:07:17 -0000 1.3 +++ defseq.lisp 1 Oct 2004 11:22:34 -0000 1.4 @@ -64,43 +64,25 @@ #'vector-fe-init-end ) ) -(%defseq - (vector - 'BIT-VECTOR - #'vector-init - #'vector-upd - #'vector-endtest - #'vector-fe-init - #'vector-fe-upd - #'vector-fe-endtest - #'bit - #'sys::store - #'identity - #'vector-length - #'make-bit-vector - #'bit - #'sys::store - #'vector-init-start - #'vector-fe-init-end -) ) - (mapc #'(lambda (n &aux (eltype (list 'UNSIGNED-BYTE n))) (%defseq (vector - n ; n steht für `(VECTOR (UNSIGNED-BYTE ,n)) + n ; n stands for `(VECTOR (UNSIGNED-BYTE ,n)) #'vector-init #'vector-upd #'vector-endtest #'vector-fe-init #'vector-fe-upd #'vector-fe-endtest - #'aref + (if (= n 1) #'bit #'aref) #'sys::store #'identity #'vector-length - #'(lambda (length) (make-array length :element-type eltype)) - #'aref + (if (= n 1) + #'make-bit-vector + #'(lambda (length) (make-array length :element-type eltype))) + (if (= n 1) #'bit #'aref) #'sys::store #'vector-init-start #'vector-fe-init-end Index: sequence.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/sequence.d,v retrieving revision 1.84 retrieving revision 1.85 diff -u -d -r1.84 -r1.85 --- sequence.d 28 Sep 2004 13:13:58 -0000 1.84 +++ sequence.d 1 Oct 2004 11:22:23 -0000 1.85 @@ -155,9 +155,8 @@ if (eq(name,S(simple_string)) || eq(name,S(base_string)) || eq(name,S(simple_base_string))) { name = S(string); goto expanded_unconstrained; } - if (eq(name,S(bit_vector))) { goto expanded_unconstrained; } - if (eq(name,S(simple_bit_vector))) - { name = S(bit_vector); goto expanded_unconstrained; } + if (eq(name,S(bit_vector)) || eq(name,S(simple_bit_vector))) + { name = fixnum(1); goto expanded_unconstrained; } if (eq(name,S(array)) || eq(name,S(simple_array))) { name = S(vector); goto expanded_unconstrained; } goto expanded_unconstrained; # sonstige Symbole können DEFSTRUCT-Typen sein @@ -172,7 +171,7 @@ || eq(name1,S(base_string)) || eq(name1,S(simple_base_string))) { name = S(string); goto expanded_maybe_constrained; } if (eq(name1,S(bit_vector)) || eq(name1,S(simple_bit_vector))) - { name = S(bit_vector); goto expanded_maybe_constrained; } + { name = fixnum(1); goto expanded_maybe_constrained; } if (false) { expanded_maybe_constrained: if (consp(name2) && integerp(Car(name2))) @@ -206,8 +205,6 @@ name = S(vector); goto expanded; } else if (atype==Atype_Char) { # (VECTOR CHARACTER) name = S(string); goto expanded; - } else if (atype==Atype_Bit) { # (VECTOR BIT) - name = S(bit_vector); goto expanded; } else if (atype == Atype_NIL) { /* (VECTOR NIL) */ name = Fixnum_0; goto expanded; } else { # (VECTOR (UNSIGNED-BYTE n)) @@ -277,14 +274,14 @@ break; case Array_type_sstring: name = S(string); break; # Typ STRING - case Array_type_sbvector: case Array_type_bvector: - name = S(bit_vector); break; # Typ BIT-VECTOR + case Array_type_sbvector: case Array_type_sb2vector: case Array_type_sb4vector: case Array_type_sb8vector: case Array_type_sb16vector: case Array_type_sb32vector: # Typ n, bedeutet (VECTOR (UNSIGNED-BYTE n)) name = fixnum(bit(sbNvector_atype(seq))); break; + case Array_type_bvector: case Array_type_b2vector: case Array_type_b4vector: case Array_type_b8vector: @@ -2405,8 +2402,8 @@ } else goto other; } - elif (eq(type,S(vector)) || eq(type,S(string)) || eq(type,S(bit_vector)) || posfixnump(type)) { - # Typ [GENERAL-]VECTOR, STRING, BIT-VECTOR, Byte-VECTOR + elif (eq(type,S(vector)) || eq(type,S(string)) || posfixnump(type)) { + # Typ [GENERAL-]VECTOR, STRING, (UNSIGNED-BYTE n)-VECTOR # Noch überprüfen, ob sequence wirklich ein Vektor ist. var object sequence = *(stackptr STACKop 0); if (!(vectorp(sequence))) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3606 retrieving revision 1.3607 diff -u -d -r1.3606 -r1.3607 --- ChangeLog 1 Oct 2004 11:20:18 -0000 1.3606 +++ ChangeLog 1 Oct 2004 11:22:34 -0000 1.3607 @@ -1,3 +1,10 @@ +2004-09-30 Bruno Haible <br...@cl...> + + * sequence.d (valid_type1, get_seq_type): Use sequence type 1 instead + of BIT-VECTOR. + (delete_help): Simplify accordingly. + * defseq.lisp (BIT-VECTOR): Remove. Replaced by sequence type 1. + 2004-09-29 Bruno Haible <br...@cl...> * defmacro.lisp (macro-nonnull-element-error): New function. --__--__-- Message: 5 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src sequence.d,1.85,1.86 array.d,1.93,1.94 constsym.d,1.270,1.271 type.lisp,1.63,1.64 ChangeLog,1.3607,1.3608 Date: Fri, 01 Oct 2004 11:24:51 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13054/src Modified Files: sequence.d array.d constsym.d type.lisp ChangeLog Log Message: Try harder to determine the sequence type from a given type specifier. Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.270 retrieving revision 1.271 diff -u -d -r1.270 -r1.271 --- constsym.d 23 Sep 2004 13:09:20 -0000 1.270 +++ constsym.d 1 Oct 2004 11:24:48 -0000 1.271 @@ -1370,6 +1370,7 @@ LISPSYM(array,"ARRAY",lisp) /* type in SEQUENCE, PREDTYPE */ LISPSYM(simple_array,"SIMPLE-ARRAY",lisp) /* type in SEQUENCE, PREDTYPE */ LISPSYM(sequence,"SEQUENCE",lisp) /* type for SEQUENCE */ +LISPSYM(subtype_sequence,"SUBTYPE-SEQUENCE",system) /* function for SEQUENCE */ LISPSYM(package_error,"PACKAGE-ERROR",lisp) /* type for PACKAGE */ LISPSYM(Kinternal,"INTERNAL",keyword) /* INTERN result in PACKAGE */ LISPSYM(Kexternal,"EXTERNAL",keyword) /* INTERN result in PACKAGE */ Index: type.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/type.lisp,v retrieving revision 1.63 retrieving revision 1.64 diff -u -d -r1.63 -r1.64 --- type.lisp 30 Aug 2004 15:56:33 -0000 1.63 +++ type.lisp 1 Oct 2004 11:24:48 -0000 1.64 @@ -1000,6 +1000,146 @@ (type-null '(and integer character)) |# +;; Determines a sequence kind (an atom, as defined in defseq.lisp: one of +;; LIST - stands for LIST +;; VECTOR - stands for (VECTOR T) +;; STRING - stands for (VECTOR CHARACTER) +;; 1, 2, 4, 8, 16, 32 - stands for (VECTOR (UNSIGNED-BYTE n)) +;; 0 - stands for (VECTOR NIL)) +;; that indicates the sequence type meant by the given type. Other possible +;; return values are +;; SEQUENCE - denoting a type whose intersection with (OR LIST VECTOR) is not +;; subtype of LIST or VECTOR, or +;; NIL - indicating a type whose intersection with (OR LIST VECTOR) is empty. +;; When the type is (OR (VECTOR eltype1) ... (VECTOR eltypeN)), the chosen +;; element type is the smallest element type that contains all of eltype1 ... +;; eltypeN. +;; +;; User-defined sequence types are not supported here. +;; +;; This implementation inlines the (tail-recursive) canonicalize-type +;; function. Its advantage is that it doesn't cons as much. Also it employs +;; some heuristics and does not have the full power of SUBTYPEP. +(defun subtype-sequence (type) + (setq type (expand-deftype type)) + (cond ((symbolp type) + (case type + ((LIST CONS NULL) 'LIST) + ((NIL) 'NIL) + ((BIT-VECTOR SIMPLE-BIT-VECTOR) '1) + ((STRING SIMPLE-STRING BASE-STRING SIMPLE-BASE-STRING) 'STRING) + ((VECTOR SIMPLE-VECTOR ARRAY SIMPLE-ARRAY) 'VECTOR) + ((SEQUENCE) 'SEQUENCE) + (t 'NIL))) + ((and (consp type) (symbolp (first type))) + (unless (and (list-length type) (null (cdr (last type)))) + (typespec-error 'subtypep type)) + (case (first type) + (MEMBER ; (MEMBER &rest objects) + (let ((kind 'NIL)) + (dolist (x (rest type)) + (setq kind (sequence-type-union kind (type-of-sequence x)))) + kind)) + (EQL ; (EQL object) + (unless (eql (length type) 2) + (typespec-error 'subtypep type)) + (type-of-sequence (second type))) + (OR ; (OR type*) + (let ((kind 'NIL)) + (dolist (x (rest type)) + (setq kind (sequence-type-union kind (subtype-sequence x)))) + kind)) + (AND ; (AND type*) + (let ((kind 'SEQUENCE)) + (dolist (x (rest type)) + (setq kind (sequence-type-intersection kind (subtype-sequence x)))) + kind)) + ((SIMPLE-BIT-VECTOR BIT-VECTOR) ; (SIMPLE-BIT-VECTOR &optional size) + (when (cddr type) + (typespec-error 'subtypep type)) + '1) + ((SIMPLE-STRING STRING SIMPLE-BASE-STRING BASE-STRING) ; (SIMPLE-STRING &optional size) + (when (cddr type) + (typespec-error 'subtypep type)) + 'STRING) + (SIMPLE-VECTOR ; (SIMPLE-VECTOR &optional size) + (when (cddr type) + (typespec-error 'subtypep type)) + 'VECTOR) + ((VECTOR ARRAY SIMPLE-ARRAY) ; (VECTOR &optional el-type size), (ARRAY &optional el-type dimensions) + (when (cdddr type) + (typespec-error 'subtypep type)) + (let ((el-type (if (cdr type) (second type) '*))) + (if (eq el-type '*) + 'VECTOR + (let ((eltype (upgraded-array-element-type el-type))) + (cond ((eq eltype 'T) 'VECTOR) + ((eq eltype 'CHARACTER) 'STRING) + ((eq eltype 'BIT) '1) + ((and (consp eltype) (eq (first eltype) 'UNSIGNED-BYTE)) (second eltype)) + ((eq eltype 'NIL) '0) + (t (error (TEXT "~S is not up-to-date with ~S for element type ~S") + 'subtypep-sequence 'upgraded-array-element-type eltype))))))) + ((CONS) ; (CONS &optional cartype cdrtype) + (when (cdddr type) + (typespec-error 'subtypep type)) + 'LIST) + (t 'NIL))) + ((clos::class-p type) + (if (and (clos::built-in-class-p type) + (eq (get (clos:class-name type) 'CLOS::CLOSCLASS) type)) + (subtype-sequence (clos:class-name type)) + 'NIL)) + ((clos::eql-specializer-p type) + (type-of-sequence (clos::eql-specializer-singleton type))) + (t 'NIL))) +(defun type-of-sequence (x) + (cond ((listp x) 'LIST) + ((vectorp x) + (let ((eltype (array-element-type x))) + (cond ((eq eltype 'T) 'VECTOR) + ((eq eltype 'CHARACTER) 'STRING) + ((eq eltype 'BIT) '1) + ((and (consp eltype) (eq (first eltype) 'UNSIGNED-BYTE)) (second eltype)) + ((eq eltype 'NIL) '0) + (t (error (TEXT "~S is not up-to-date with ~S for element type ~S") + 'type-of-sequence 'array-element-type eltype))))) + (t 'NIL))) +(defun sequence-type-union (t1 t2) + (cond ; Simple general rules. + ((eql t1 t2) t1) + ((eq t1 'NIL) t2) + ((eq t2 'NIL) t1) + ; Now the union of two different types. + ((or (eq t1 'SEQUENCE) (eq t2 'SEQUENCE)) 'SEQUENCE) + ((or (eq t1 'LIST) (eq t2 'LIST)) + ; union of LIST and a vector type + 'SEQUENCE) + ((or (eq t1 'VECTOR) (eq t2 'VECTOR)) 'VECTOR) + ((eql t1 0) t2) + ((eql t2 0) t1) + ((or (eq t1 'STRING) (eq t2 'STRING)) + ; union of STRING and an integer-vector type + 'VECTOR) + (t (max t1 t2)))) +(defun sequence-type-intersection (t1 t2) + (cond ; Simple general rules. + ((eql t1 t2) t1) + ((or (eq t1 'NIL) (eq t2 'NIL)) 'NIL) + ; Now the intersection of two different types. + ((eq t1 'SEQUENCE) t2) + ((eq t2 'SEQUENCE) t1) + ((or (eq t1 'LIST) (eq t2 'LIST)) + ; intersection of LIST and a vector type + 'NIL) + ((eq t1 'VECTOR) t2) + ((eq t2 'VECTOR) t1) + ((or (eql t1 0) (eql t2 0)) '0) + ((or (eq t1 'STRING) (eq t2 'STRING)) + ; intersection of STRING and an integer-vector type + '0) + (t (min t1 t2)))) + ;; ============================================================================ (defun type-expand (typespec &optional once-p) Index: sequence.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/sequence.d,v retrieving revision 1.85 retrieving revision 1.86 diff -u -d -r1.85 -r1.86 --- sequence.d 1 Oct 2004 11:22:23 -0000 1.85 +++ sequence.d 1 Oct 2004 11:24:47 -0000 1.86 @@ -232,7 +232,12 @@ name = TheClass(name)->classname; goto expanded_unconstrained; # other classes could be DEFSTRUCT defined types }, {}); - return NIL; + /* Call (SYS::SUBTYPE-SEQUENCE name): */ + pushSTACK(name); funcall(S(subtype_sequence),1); + if (eq(value1,S(sequence)) || eq(value1,NIL)) + return NIL; + name = value1; + /* TODO: Extract possible length constraints from the type specifier. */ expanded_unconstrained: pushSTACK(unbound); # no length constraint expanded: Index: array.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/array.d,v retrieving revision 1.93 retrieving revision 1.94 diff -u -d -r1.93 -r1.94 --- array.d 20 Sep 2004 10:58:44 -0000 1.93 +++ array.d 1 Oct 2004 11:24:47 -0000 1.94 @@ -88,7 +88,7 @@ /* Function: Canonicalizes an array element-type and returns its element type code. ** When this function is changed, also update UPGRADED-ARRAY-ELEMENT-TYPE - ** in type.lisp! + ** and SUBTYPE-SEQUENCE in type.lisp! eltype_code(element_type) > element_type: type specifier < result: element type code Atype_xxx Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3607 retrieving revision 1.3608 diff -u -d -r1.3607 -r1.3608 --- ChangeLog 1 Oct 2004 11:22:34 -0000 1.3607 +++ ChangeLog 1 Oct 2004 11:24:48 -0000 1.3608 @@ -1,5 +1,12 @@ 2004-09-30 Bruno Haible <br...@cl...> + * sequence.d (valid_type1): Call SYS::SUBTYPE-SEQUENCE as a last + chance to determine the sequence type. + * type.lisp (subtype-sequence, type-of-sequence, sequence-type-union, + sequence-type-intersection): New functions. + +2004-09-30 Bruno Haible <br...@cl...> + * sequence.d (valid_type1, get_seq_type): Use sequence type 1 instead of BIT-VECTOR. (delete_help): Simplify accordingly. --__--__-- Message: 6 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src type.lisp,1.64,1.65 ChangeLog,1.3608,1.3609 Date: Fri, 01 Oct 2004 11:25:38 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13267/src Modified Files: type.lisp ChangeLog Log Message: Improved error checking. Index: type.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/type.lisp,v retrieving revision 1.64 retrieving revision 1.65 diff -u -d -r1.64 -r1.65 --- type.lisp 1 Oct 2004 11:24:48 -0000 1.64 +++ type.lisp 1 Oct 2004 11:25:35 -0000 1.65 @@ -876,6 +876,8 @@ (let ((low 0) (high 0)) (yes))) ; wlog! (t (no)))) ((and (consp type) (symbolp (first type))) + (unless (and (list-length type) (null (cdr (last type)))) + (typespec-error 'subtypep type)) (case (first type) (MEMBER ; (MEMBER &rest objects) ;; All elements must be of type INTEGER. Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3608 retrieving revision 1.3609 diff -u -d -r1.3608 -r1.3609 --- ChangeLog 1 Oct 2004 11:24:48 -0000 1.3608 +++ ChangeLog 1 Oct 2004 11:25:35 -0000 1.3609 @@ -1,5 +1,10 @@ 2004-09-30 Bruno Haible <br...@cl...> + * type.lisp (subtype-integer): Signal an error if the argument is a + circular or dotted list. + +2004-09-30 Bruno Haible <br...@cl...> + * sequence.d (valid_type1): Call SYS::SUBTYPE-SEQUENCE as a last chance to determine the sequence type. * type.lisp (subtype-sequence, type-of-sequence, sequence-type-union, --__--__-- Message: 7 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src sequence.d,1.86,1.87 Date: Fri, 01 Oct 2004 11:48:08 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18048 Modified Files: sequence.d Log Message: Use sequence type 1 instead of BIT-VECTOR. Index: sequence.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/sequence.d,v retrieving revision 1.86 retrieving revision 1.87 diff -u -d -r1.86 -r1.87 --- sequence.d 1 Oct 2004 11:24:47 -0000 1.86 +++ sequence.d 1 Oct 2004 11:48:06 -0000 1.87 @@ -226,7 +226,7 @@ if (eq(name,O(class_string))) { name = S(string); goto expanded_unconstrained; } if (eq(name,O(class_bit_vector))) - { name = S(bit_vector); goto expanded_unconstrained; } + { name = fixnum(1); goto expanded_unconstrained; } if (eq(name,O(class_array))) { name = S(vector); goto expanded_unconstrained; } name = TheClass(name)->classname; --__--__-- Message: 8 From: Jörg Höhle <ho...@us...> To: cli...@li... Subject: clisp/modules/bindings/glibc linux.lisp,1.11,1.12 Date: Fri, 01 Oct 2004 13:14:39 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/bindings/glibc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1895/modules/bindings/glibc Modified Files: linux.lisp Log Message: linux.lisp: revise seed48 and exec* Index: linux.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/bindings/glibc/linux.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- linux.lisp 27 Sep 2004 00:19:51 -0000 1.11 +++ linux.lisp 1 Oct 2004 13:14:36 -0000 1.12 @@ -19,7 +19,7 @@ cl:aref cl:ash cl:coerce cl:compile cl:defconstant cl:dotimes cl:eval cl:fill cl:floor cl:gensym cl:let cl:load cl:load-time-value cl:logand cl:logbitp cl:logior cl:lognot cl:mod cl:multiple-value-bind cl:not - cl:or cl:progn cl:setf cl:t cl:zerop cl:+ cl:- cl:* cl:= cl:1- + cl:or cl:&rest cl:progn cl:setf cl:t cl:zerop cl:+ cl:- cl:* cl:= cl:1- ffi:bitsizeof ffi:boolean ffi:cast ffi:char ffi:character ffi:c-array ffi:c-array-max ffi:c-array-ptr ffi:c-function ffi:c-ptr ffi:c-ptr-null ffi:c-pointer ffi:c-string ffi:c-struct ffi:deref ffi::foreign-value @@ -608,10 +608,8 @@ (:return-type long)) (def-call-out srand48 (:arguments (seedval long)) (:return-type nil)) -;(def-call-out seed48 (:arguments (seed16v (c-ptr (c-array ushort 3)))) -; (:return-type (c-ptr (c-array ushort 3)) :none)) (def-call-out seed48 (:arguments (seed16v (c-ptr (c-array ushort 3)))) - (:return-type (c-ptr ushort) :none)) + (:return-type (c-ptr (c-array ushort 3)) :none)) (def-call-out lcong48 (:arguments (param (c-ptr (c-array ushort 7)))) (:return-type nil)) @@ -1116,61 +1114,32 @@ (:arguments (path c-string) (argv (c-array-ptr c-string)) (envp (c-array-ptr c-string))) (:return-type int) - (:name "execv")) + (:name "execve")) (def-call-out execvp (:arguments (file c-string) (argv (c-array-ptr c-string))) (:return-type int) (:name "execvp")) -(def-call-out execle0 - (:arguments (path c-string) (argv0 c-string) (null c-string) - (envp c-pointer)) - (:return-type int) (:name "execle")) -(def-call-out execle1 - (:arguments (path c-string) (argv0 c-string) (argv1 c-string) - (null c-string) (envp c-pointer)) - (:return-type int) (:name "execle")) -(def-call-out execle2 - (:arguments (path c-string) (argv0 c-string) (argv1 c-string) - (argv2 c-string) (null c-string) (envp c-pointer)) - (:return-type int) (:name "execle")) -(def-call-out execle3 - (:arguments (path c-string) (argv0 c-string) (argv1 c-string) - (argv2 c-string) (argv3 c-string) (null c-string) - (envp c-pointer)) - (:return-type int) (:name "execle")) -(def-call-out execl0 - (:arguments (path c-string) (argv0 c-string) (null c-string)) - (:return-type int) (:name "execl")) +; Foreign language interfaces should use the execv* series of functions, +; not the C varargs convenience functions. +(defun execl (path &rest args) + (execv path (coerce args 'vector))) +(defun execlp (file &rest args) + (execvp file (coerce args 'vector))) + +; Provide these stubs so the execl/p/e names become registered (def-call-out execl1 (:arguments (path c-string) (argv0 c-string) (argv1 c-string) (null c-string)) (:return-type int) (:name "execl")) -(def-call-out execl2 - (:arguments (path c-string) (argv0 c-string) (argv1 c-string) - (argv2 c-string) (null c-string)) - (:return-type int) (:name "execl")) -(def-call-out execl3 - (:arguments (path c-string) (argv0 c-string) (argv1 c-string) - (argv2 c-string) (argv3 c-string) (null c-string)) - (:return-type int) (:name "execl")) -;(def-call-out execvp (:arguments (path c-string) (argv c-pointer)) ; ?? -; (:return-type int)) -(def-call-out execlp0 - (:arguments (path c-string) (argv0 c-string) (null c-string)) - (:return-type int) (:name "execlp")) (def-call-out execlp1 (:arguments (path c-string) (argv0 c-string) (argv1 c-string) (null c-string)) (:return-type int) (:name "execlp")) -(def-call-out execlp2 - (:arguments (path c-string) (argv0 c-string) (argv1 c-string) - (argv2 c-string) (null c-string)) - (:return-type int) (:name "execlp")) -(def-call-out execlp3 +(def-call-out execle1 (:arguments (path c-string) (argv0 c-string) (argv1 c-string) - (argv2 c-string) (argv3 c-string) (null c-string)) - (:return-type int) (:name "execlp")) + (null c-string) (envp c-pointer)) + (:return-type int) (:name "execle")) (def-call-out nice (:arguments (increment int)) (:return-type int)) --__--__-- Message: 9 From: Jörg Höhle <ho...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.3609,1.3610 Date: Fri, 01 Oct 2004 13:14:38 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1895/src Modified Files: ChangeLog Log Message: linux.lisp: revise seed48 and exec* Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3609 retrieving revision 1.3610 diff -u -d -r1.3609 -r1.3610 --- ChangeLog 1 Oct 2004 11:25:35 -0000 1.3609 +++ ChangeLog 1 Oct 2004 13:14:34 -0000 1.3610 @@ -72,6 +72,15 @@ * sequence.d (valid_type1): Recognize also built-in class objects. * clos-class3.lisp: Pass <list> to %defclos as well. +2004-09-28 Jörg Höhle <ho...@us...> + + * modules/bindings/glibc/linux.lisp: + (seed48): provide exact definition now that prototyes are not + written to the C output file anymore (see *output-c-functions*). + The limitation in ffi::to-c-typedecl still exists: it produces + uint16 (* (seed48) (uint16 (* arg2163)[3]))[3] as prototype... + (execl,execlp): use DEFUN-based interface, call execv/p. + 2004-09-19 Bruno Haible <br...@cl...> Support for user-defined DEFGENERIC options. --__--__-- Message: 10 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.3610,1.3611 Date: Fri, 01 Oct 2004 21:46:55 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7985/src Modified Files: ChangeLog Log Message: formatting Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3610 retrieving revision 1.3611 diff -u -d -r1.3610 -r1.3611 --- ChangeLog 1 Oct 2004 13:14:34 -0000 1.3610 +++ ChangeLog 1 Oct 2004 21:46:51 -0000 1.3611 @@ -7,8 +7,8 @@ * sequence.d (valid_type1): Call SYS::SUBTYPE-SEQUENCE as a last chance to determine the sequence type. - * type.lisp (subtype-sequence, type-of-sequence, sequence-type-union, - sequence-type-intersection): New functions. + * type.lisp (subtype-sequence, type-of-sequence, sequence-type-union) + (sequence-type-intersection): New functions. 2004-09-30 Bruno Haible <br...@cl...> --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |