From: <cli...@li...> - 2006-11-17 20:08:17
|
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/tests iofkts.tst,1.37,1.38 ChangeLog,1.484,1.485 (Sam Steingold) 2. clisp/src io.d,1.299,1.300 NEWS,1.352,1.353 ChangeLog,1.5454,1.5455 (Sam Steingold) 3. clisp/src io.d,1.300,1.301 (Sam Steingold) 4. clisp Makefile.devel,1.159,1.160 (Sam Steingold) 5. clisp/tests number2.tst,1.33,1.34 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Fri, 17 Nov 2006 05:27:53 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/tests iofkts.tst,1.37,1.38 ChangeLog,1.484,1.485 To: cli...@li... Message-ID: <E1G...@ma...> Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv2903/tests Modified Files: iofkts.tst ChangeLog Log Message: fixed bug #[ 1483768 ]: automatic pretty-printing of symbols in conses fixed bug #[ 1598053 ]: PPRINT dispatch not honored for nested objects (pretty_print_call): removed (pr_enter_1): call pr_xxx directly (prin_object_ki): abstracted from prin_object and pprin_object (prin_object, pprin_object): use prin_object_ki (prin_object_dispatch_low): renamed from prin_object_dispatch (prin_object_dispatch_pretty): converted from pretty_print_call (prin_object_dispatch): call either of the above Index: iofkts.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/iofkts.tst,v retrieving revision 1.37 retrieving revision 1.38 diff -u -d -r1.37 -r1.38 --- iofkts.tst 27 Jul 2006 19:59:30 -0000 1.37 +++ iofkts.tst 17 Nov 2006 05:27:50 -0000 1.38 @@ -775,6 +775,16 @@ (funcall (pprint-dispatch 42) s 42))) T +;; http://sourceforge.net/tracker/index.php?func=detail&aid=1598053&group_id=1355&atid=101355 +;; https://sourceforge.net/tracker/index.php?func=detail&aid=1483768&group_id=1355&atid=101355 +(flet ((my-symbol-pprint (stream obj) + (let ((*print-pretty* nil)) + (princ "++" stream) (princ obj stream) (princ "++" stream)))) + (let ((*print-pprint-dispatch* (copy-pprint-dispatch))) + (set-pprint-dispatch 'symbol #'my-symbol-pprint) + (princ-to-string '(a (b (c (d) e) f) g)))) +"(++A++ (++B++ (++C++ (++D++) ++E++) ++F++) ++G++)" + (progn (defclass c1 () ((a :initarg a) (b :initarg b) (c :initarg c))) (defclass c2 (c1) ((aa :initarg aa) (bb :initarg bb) (cc :initarg cc))) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.484 retrieving revision 1.485 diff -u -d -r1.484 -r1.485 --- ChangeLog 10 Nov 2006 15:35:35 -0000 1.484 +++ ChangeLog 17 Nov 2006 05:27:51 -0000 1.485 @@ -1,3 +1,8 @@ +2006-11-17 Sam Steingold <sd...@gn...> + + * iofkts.tst: test for [ 1483768, 1598053 ]: repect PPRINT + dispatch for nested objects, not just the top-level + 2006-11-10 Bruno Haible <br...@cl...> * clos.tst: Add test for TYPEP and SUBTYPEP on incomplete and undefined ------------------------------ Message: 2 Date: Fri, 17 Nov 2006 05:27:53 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src io.d,1.299,1.300 NEWS,1.352,1.353 ChangeLog,1.5454,1.5455 To: cli...@li... Message-ID: <E1G...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv2903/src Modified Files: io.d NEWS ChangeLog Log Message: fixed bug #[ 1483768 ]: automatic pretty-printing of symbols in conses fixed bug #[ 1598053 ]: PPRINT dispatch not honored for nested objects (pretty_print_call): removed (pr_enter_1): call pr_xxx directly (prin_object_ki): abstracted from prin_object and pprin_object (prin_object, pprin_object): use prin_object_ki (prin_object_dispatch_low): renamed from prin_object_dispatch (prin_object_dispatch_pretty): converted from pretty_print_call (prin_object_dispatch): call either of the above Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.352 retrieving revision 1.353 diff -u -d -r1.352 -r1.353 --- NEWS 9 Nov 2006 02:05:41 -0000 1.352 +++ NEWS 17 Nov 2006 05:27:51 -0000 1.353 @@ -12,6 +12,8 @@ * Bug fixes: + Fixed rounding of long floats [even+1/2]. [ 1589311 ] + Fixed stdio when running without a TTY, e.g., under SSH. [ 1592343 ] + + ANSI compliance: PPRINT dispatch is now respected for nested + objects, not just the top-level. [ 1483768, 1598053 ] 2.41 (2006-10-13) Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.299 retrieving revision 1.300 diff -u -d -r1.299 -r1.300 --- io.d 13 Nov 2006 01:29:28 -0000 1.299 +++ io.d 17 Nov 2006 05:27:51 -0000 1.300 @@ -6452,28 +6452,6 @@ # ------------------------ Entering the printer ------------------------------- -# check whether the object is a valid Dispatch Table and contains some entries -#define DISPATCH_TABLE_VALID_P(dt) \ - (mconsp(dt) && eq(Car(dt),S(print_pprint_dispatch)) && !nullp(Cdr(dt))) -# call the appropriate function -local void pretty_print_call (const gcv_object_t* stream_, object obj, pr_routine_t* pr_xxx_default) { - var object ppp_disp = Symbol_value(S(print_pprint_dispatch)); - if (!boundp(Symbol_value(S(prin_pprinter))) /* been here already! */ - && DISPATCH_TABLE_VALID_P(ppp_disp)) { - /* Call (PPRINT-DISPATCH obj): */ - pushSTACK(obj); /* save */ - pushSTACK(obj); funcall(S(pprint_dispatch),1); - obj = popSTACK(); /* restore */ - if (!nullp(value2)) { - pushSTACK(*stream_); pushSTACK(obj); funcall(value1,2); - return; - } - } - /* Default printing: */ - (*pr_xxx_default)(stream_,obj); -} -#undef DISPATCH_TABLE_VALID_P - /* UP: return the number of spaces available on the current line in this stream NIL means unlimited can trigger GC */ @@ -6564,7 +6542,7 @@ if (stream_get_read_eval(*stream_)) # adopt READ-EVAL-Bit TheStream(STACK_0)->strmflags |= bit(strmflags_reval_bit_B); # print object to the new stream: - pretty_print_call(&STACK_0,STACK_1,pr_xxx); + pr_xxx(&STACK_0,STACK_1); var bool skip_first_nl = false; var bool modus_single_p; { # print content of the new stream to the old stream: @@ -6667,7 +6645,7 @@ dynamic_unbind(S(prin_lm)); dynamic_unbind(S(prin_l1)); } else { # already a PPHELP-stream - pretty_print_call(stream_,obj,pr_xxx); + pr_xxx(stream_,obj); } } else { # *PRINT-PRETTY* = NIL. # if *stream_ is a PPHELP-Stream, it must be replaced by a @@ -6861,27 +6839,28 @@ local pr_routine_t pr_cclosure_codevector; local pr_routine_t pr_stream; -# UP: prints object to Stream. -# prin_object(&stream,obj); -# > obj: object -# > stream: stream -# < stream: stream -# can trigger GC -local maygc void prin_object (const gcv_object_t* stream_, object obj) { +/* UP: prints object to Stream. + prin_object_ki(&stream,obj,pr_routine); + > obj: object + > stream: stream + > pr_routine: printer + < stream: stream + can trigger GC */ +local maygc void prin_object_ki (const gcv_object_t* stream_, object obj, + pr_routine_t *printer) { restart_it: - # test for keyboard-interrupt: - interruptp({ - pushSTACK(obj); # save obj in the STACK; the stream is safe - pushSTACK(S(print)); tast_break(); # PRINT call break-loop - obj = popSTACK(); # move obj back + interruptp({ /* test for keyboard-interrupt: */ + pushSTACK(obj); /* save obj in the STACK; the stream is safe */ + pushSTACK(S(print)); tast_break(); /* PRINT call break-loop */ + obj = popSTACK(); /* move obj back */ goto restart_it; }); - # test for stack overflow: - check_SP(); check_STACK(); - # handle circularity: - pr_circle(stream_,obj,&prin_object_dispatch); + check_SP(); check_STACK(); /* test for stack overflow */ + pr_circle(stream_,obj,printer); /* handle circularity */ } -local void prin_object_dispatch (const gcv_object_t* stream_, object obj) { +local maygc void prin_object (const gcv_object_t* stream_, object obj) +{ prin_object_ki(stream_,obj,&prin_object_dispatch); } +local void prin_object_dispatch_low (const gcv_object_t* stream_, object obj) { # branch according to type-info: #ifdef TYPECODES switch (typecode(obj)) { @@ -6961,7 +6940,29 @@ NOTREACHED; #endif } - +/* call the appropriate function */ +local void prin_object_dispatch_pretty (const gcv_object_t* stream_, object obj) +{ var object ppp_disp = Symbol_value(S(print_pprint_dispatch)); + if (!boundp(Symbol_value(S(prin_pprinter))) /* been here already! */ + /* check whether ppp_disp is a valid non-empty Dispatch Table */ + && mconsp(ppp_disp) && eq(Car(ppp_disp),S(print_pprint_dispatch)) + && !nullp(Cdr(ppp_disp))) { + /* Call (PPRINT-DISPATCH obj): */ + pushSTACK(obj); /* save */ + pushSTACK(obj); funcall(S(pprint_dispatch),1); + obj = popSTACK(); /* restore */ + if (!nullp(value2)) { + pushSTACK(*stream_); pushSTACK(obj); funcall(value1,2); + return; + } + } + prin_object_dispatch_low(stream_,obj); /* default printing */ +} +local void maygc prin_object_dispatch (const gcv_object_t* stream_, object obj) +{ if (!nullpSv(print_pretty)) + prin_object_dispatch_pretty(stream_,obj); + else prin_object_dispatch_low(stream_,obj); +} # ------------- PRINT-Routines for various data-types -------------------- @@ -9449,6 +9450,23 @@ CHECK_PRINT_READABLY(obj); write_sstring_case(stream_,O(printstring_internal_weak_hashed_alist)); break; +#ifdef MULTITHREAD + case Rectype_Thread: + CHECK_PRINT_READABLY(obj); + pr_unreadably(stream_,TheThread(obj)->xth_name, + &O(printstring_thread),prin_object); + break; + case Rectype_Mutex: + CHECK_PRINT_READABLY(obj); + pr_unreadably(stream_,TheMutex(obj)->xmu_name, + &O(printstring_mutex),prin_object); + break; + case Rectype_Exemption: + CHECK_PRINT_READABLY(obj); + pr_unreadably(stream_,TheExemption(obj)->xco_name, + &O(printstring_exemption),prin_object); + break; +#endif default: pushSTACK(S(print)); fehler(serious_condition, @@ -10066,20 +10084,8 @@ local pr_routine_t pprin_object; local pr_routine_t pprin_object_dispatch; -local void pprin_object (const gcv_object_t* stream_,object obj) { - restart_it: - # test for keyboard-interrupt: - interruptp({ - pushSTACK(obj); # save obj in the STACK; the stream is safe - pushSTACK(S(print)); tast_break(); # PRINT call break-loop - obj = popSTACK(); # move obj back - goto restart_it; - }); - # test for stack overflow: - check_SP(); check_STACK(); - # handle circularity: - pr_circle(stream_,obj,&pprin_object_dispatch); -} +local void pprin_object (const gcv_object_t* stream_,object obj) +{ prin_object_ki(stream_,obj,&pprin_object_dispatch); } # SYS::*PRIN-PPRINTER* == the lisp function local void pprin_object_dispatch (const gcv_object_t* stream_,object obj) { LEVEL_CHECK; Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5454 retrieving revision 1.5455 diff -u -d -r1.5454 -r1.5455 --- ChangeLog 14 Nov 2006 02:55:04 -0000 1.5454 +++ ChangeLog 17 Nov 2006 05:27:51 -0000 1.5455 @@ -1,3 +1,15 @@ +2006-11-17 Sam Steingold <sd...@gn...> + + fixed bug #[ 1483768 ]: automatic pretty-printing of symbols in conses + fixed bug #[ 1598053 ]: PPRINT dispatch not honored for nested objects + * io.d (pretty_print_call): removed + (pr_enter_1): call pr_xxx directly + (prin_object_ki): abstracted from prin_object and pprin_object + (prin_object, pprin_object): use prin_object_ki + (prin_object_dispatch_low): renamed from prin_object_dispatch + (prin_object_dispatch_pretty): converted from pretty_print_call + (prin_object_dispatch): call either of the above + 2006-11-13 Magnus Henoch <ma...@fr...> Sam Steingold <sd...@gn...> ------------------------------ Message: 3 Date: Fri, 17 Nov 2006 05:28:54 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src io.d,1.300,1.301 To: cli...@li... Message-ID: <E1G...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv3288/src Modified Files: io.d Log Message: oops Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.300 retrieving revision 1.301 diff -u -d -r1.300 -r1.301 --- io.d 17 Nov 2006 05:27:51 -0000 1.300 +++ io.d 17 Nov 2006 05:28:52 -0000 1.301 @@ -9450,23 +9450,6 @@ CHECK_PRINT_READABLY(obj); write_sstring_case(stream_,O(printstring_internal_weak_hashed_alist)); break; -#ifdef MULTITHREAD - case Rectype_Thread: - CHECK_PRINT_READABLY(obj); - pr_unreadably(stream_,TheThread(obj)->xth_name, - &O(printstring_thread),prin_object); - break; - case Rectype_Mutex: - CHECK_PRINT_READABLY(obj); - pr_unreadably(stream_,TheMutex(obj)->xmu_name, - &O(printstring_mutex),prin_object); - break; - case Rectype_Exemption: - CHECK_PRINT_READABLY(obj); - pr_unreadably(stream_,TheExemption(obj)->xco_name, - &O(printstring_exemption),prin_object); - break; -#endif default: pushSTACK(S(print)); fehler(serious_condition, ------------------------------ Message: 4 Date: Fri, 17 Nov 2006 05:29:33 +0000 From: Sam Steingold <sd...@us...> Subject: clisp Makefile.devel,1.159,1.160 To: cli...@li... Message-ID: <E1G...@ma...> Update of /cvsroot/clisp/clisp In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv3647 Modified Files: Makefile.devel Log Message: (GPG): use gpg2 Index: Makefile.devel =================================================================== RCS file: /cvsroot/clisp/clisp/Makefile.devel,v retrieving revision 1.159 retrieving revision 1.160 diff -u -d -r1.159 -r1.160 --- Makefile.devel 18 Oct 2006 04:13:09 -0000 1.159 +++ Makefile.devel 17 Nov 2006 05:29:31 -0000 1.160 @@ -448,7 +448,7 @@ rm -f $(TOPNAME) # http://www.gnu.org/prep/maintain/html_node/Automated-Upload-Procedure.html -GPG=gpg --use-agent --yes +GPG=gpg2 --use-agent --yes gnu-distrib : $(SRC_DIST1) force mkdir -p $(ARCHIVE) cp -f src/NEWS SUMMARY $(ARCHIVE) ------------------------------ Message: 5 Date: Fri, 17 Nov 2006 05:37:06 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/tests number2.tst,1.33,1.34 To: cli...@li... Message-ID: <E1G...@ma...> Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv6452/tests Modified Files: number2.tst Log Message: 1246248: (log internal-time-units-per-second) Index: number2.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/number2.tst,v retrieving revision 1.33 retrieving revision 1.34 diff -u -d -r1.33 -r1.34 --- number2.tst 9 Nov 2006 02:05:41 -0000 1.33 +++ number2.tst 17 Nov 2006 05:37:04 -0000 1.34 @@ -484,3 +484,6 @@ :for (x3 x4) = (multiple-value-list (round (float x 1s0))) :unless (and (= x1 x3) (= x2 x4)) :collect (list x x1 x2 x3 x4)) NIL + +;; https://sourceforge.net/tracker/index.php?func=detail&aid=1246248&group_id=1355&atid=101355 +(numberp (log internal-time-units-per-second)) ------------------------------ ------------------------------------------------------------------------- Take Surveys. Earn Cash. Influence the Future of IT Join SourceForge.net's Techsay panel and you'll get the chance to share your opinions on IT & business topics through brief surveys - and earn cash http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 7, Issue 11 **************************************** |