describe bug, was: Re: [Maxima] First step toward a 5.9.2 release
- Subject: describe bug, was: Re: [Maxima] First step toward a 5.9.2 release
- From: Camm Maguire
- Date: 01 Apr 2005 17:46:03 -0500
Greetings!
Here is a preliminary patch against CVS head, which we could backport
to stable if needed.
1) Support for pre-compiled regexps
2) info syntax fix.
3) make use of 1) in gcl_info.lsp
4) Follow maxima's logic for multiple info entries
TODO
1) libc POSIX regex -> eliminate old o/regexp.c
NOTES:
1) maxima's cl-info.lsp with the defuns surrounded by (let (()) )
results in uncompiled closures, at least on gcl, which is
needlessly slow. You might want to make use of load-time-value as
in this patch.
Take care,
=============================================================================
Index: o/regexp.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/regexp.c,v
retrieving revision 1.3
diff -u -r1.3 regexp.c
--- o/regexp.c 15 Feb 2003 00:38:28 -0000 1.3
+++ o/regexp.c 1 Apr 2005 22:40:57 -0000
@@ -230,7 +230,7 @@
* of the structure of the compiled regexp.
*/
static regexp *
-regcomp(char *exp)
+regcomp(char *exp,int *sz)
{
register regexp *r;
register char *scan;
@@ -255,7 +255,8 @@
FAIL("regexp too big");
/* Allocate space. */
- r = (regexp *)malloc(sizeof(regexp) + (unsigned)regsize);
+ *sz=sizeof(regexp) + (unsigned)regsize;
+ r = (regexp *)alloc_relblock(*sz);
if (r == NULL)
FAIL("out of space");
cvs diff: I know nothing about o/regexp.c.ori
cvs diff: I know nothing about o/regexp.c.~1.3.~
cvs diff: I know nothing about o/regexp.h.ori
Index: o/regexpr.c
===================================================================
RCS file: /cvsroot/gcl/gcl/o/regexpr.c,v
retrieving revision 1.9
diff -u -r1.9 regexpr.c
--- o/regexpr.c 5 Aug 2004 22:21:59 -0000 1.9
+++ o/regexpr.c 1 Apr 2005 22:40:58 -0000
@@ -61,6 +61,35 @@
RETURN1(make_fixnum(-1));
}
+DEFUN_NEW("COMPILE-REGEXP",object,fScompile_regexp,SI,1,1,NONE,OO,OO,OO,OO,(object p),
+ "Provide handle to export pre-compiled regexp's to string-match") {
+
+ char *tmp;
+ object res;
+
+ if (type_of(p)!= t_string && type_of(p)!=t_symbol)
+ not_a_string_or_symbol(p);
+
+ if (!(tmp=alloca(p->st.st_fillp+1)))
+ FEerror("out of C stack",0);
+ memcpy(tmp,p->st.st_self,p->st.st_fillp);
+ tmp[p->st.st_fillp]=0;
+
+ res=alloc_object(t_vector);
+ res->v.v_displaced=Cnil;
+ res->v.v_hasfillp=1;
+ res->v.v_elttype=aet_uchar;
+ res->v.v_adjustable=0;
+ res->v.v_offset=0;
+ if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim)))
+ FEerror("regcomp failure",0);
+ res->v.v_fillp=res->v.v_dim;
+
+ RETURN1(res);
+
+}
+
+
DEFUN_NEW("STRING-MATCH",object,fSstring_match,SI,2,4,NONE,OO,OI,IO,OO,(object pattern,object string,...),
"Match regexp PATTERN in STRING starting in string starting at START \
and ending at END. Return -1 if match not found, otherwise \
@@ -73,13 +102,14 @@
int i,ans,nargs=VFUN_NARGS,len,start,end;
static char buf[400],case_fold;
- static regexp *compiled_regexp;
+ static regexp *saved_compiled_regexp;
va_list ap;
object v = sSAmatch_dataA->s.s_dbind;
char **pp,*str,save_c=0;
unsigned np;
- if (type_of(pattern)!= t_string && type_of(pattern)!=t_symbol)
+ if (type_of(pattern)!= t_string && type_of(pattern)!=t_symbol &&
+ type_of(pattern)!=t_vector)
not_a_string_or_symbol(string);
if (type_of(string)!= t_string && type_of(string)!=t_symbol)
not_a_string_or_symbol(string);
@@ -109,30 +139,21 @@
}
{
+
+ regexp *compiled_regexp=saved_compiled_regexp;
+
BEGIN_NO_INTERRUPT;
case_fold_search = sSAcase_fold_searchA->s.s_dbind != sLnil ? 1 : 0;
- if (case_fold != case_fold_search || len != strlen(buf) || memcmp(pattern->ust.ust_self,buf,len)) {
+
+ if (type_of(pattern)==t_vector)
+
+ compiled_regexp=(void *)pattern->ust.ust_self;
- char *tmp=len+1ust.ust_self,buf,len))
- case_fold = case_fold_search;
- memcpy(tmp,pattern->st.st_self,len);
- tmp[len]=0;
-
- if (compiled_regexp) {
- free((void *)compiled_regexp);
- compiled_regexp = 0;
- }
-
- if (!(compiled_regexp=regcomp(tmp))) {
- END_NO_INTERRUPT;
- RETURN1(make_fixnum(-1));
- }
+ compiled_regexp=saved_compiled_regexp=(regexp *)fScompile_regexp(pattern)->v.v_self;
- }
str=string->st.st_self;
np=page(str);
cvs diff: I know nothing about o/regexpr.c.ori
cvs diff: I know nothing about o/regexpr.c.~1.9.~
cvs diff: I know nothing about o/regexpr.ini
cvs diff: I know nothing about o/regexpr.o
Index: lsp/gcl_info.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/lsp/gcl_info.lsp,v
retrieving revision 1.4
diff -u -r1.4 gcl_info.lsp
--- lsp/gcl_info.lsp 13 Aug 2004 15:29:59 -0000 1.4
+++ lsp/gcl_info.lsp 1 Apr 2005 22:41:00 -0000
@@ -11,7 +11,8 @@
`(slooP::sloop while ,test do ,@ body))
(defmacro f (op x y)
`(the ,(if (get op 'compiler::predicate) 't 'fixnum)
- (,op (the fixnum ,x) (the fixnum ,y)))))
+ (,op (the fixnum ,x) (the fixnum ,y))))
+(defmacro fcr (x) `(load-time-value (compile-regexp ,x))))
(eval-when (compile eval load)
(defun sharp-u-reader (stream subchar arg)
@@ -31,10 +32,13 @@
(vector-push-extend ch tem)))
tem))
-
(set-dispatch-macro-character #\# #\u 'sharp-u-reader)
+
)
+(defconstant +crlu+ (compile-regexp #u" "))
+(defconstant +crnp+ (compile-regexp #u"[ ]"))
+
(defvar *info-data* nil)
(defvar *current-info-data* nil)
@@ -67,11 +71,11 @@
(declare (fixnum lim))
(let ((s (file-to-string file)) (i 0))
(declare (fixnum i) (string s))
- (cond ((f >= (string-match #u" [ \n]+Indirect:" s 0) 0)
+ (cond ((f >= (string-match (fcr #u" [ \n]+Indirect:") s 0) 0)
(setq i (match-end 0))
- (setq lim (string-match #u" " s i))
+ (setq lim (string-match +crlu+ s i))
(while
- (f >= (string-match #u"\n([^\n]+): ([0-9]+)" s i lim) 0)
+ (f >= (string-match (fcr #u"\n([^\n]+): ([0-9]+)") s i lim) 0)
(setq i (match-end 0))
(setq files
(cons(cons
@@ -79,9 +83,9 @@
(get-match s 1)
)
files)))))
- (cond ((f >= (si::string-match #u" [\n ]+Tag Table:" s i) 0)
+ (cond ((f >= (si::string-match (fcr #u" [\n ]+Tag Table:") s i) 0)
(setq i (si::match-end 0))
- (cond ((f >= (si::string-match " " s i) 0)
+ (cond ((f >= (si::string-match +crlu+ s i) 0)
(setq tags (subseq s i (si::match-end 0)))))))
(if files (or tags (info-error "Need tags if have multiple files")))
(list* tags (nreverse files))))
@@ -89,29 +93,30 @@
(defun re-quote-string (x &aux (i 0) (len (length x)) ch
(extra 0) )
(declare (fixnum i len extra))
- (declare (string x))
- (let (tem)
- (tagbody
- AGAIN
- (while (< i len)
- (setq ch (aref x i))
- (cond ((position ch "\\()[]+.*|^$?")
- (cond (tem
- (vector-push-extend #\\ tem))
- (t (incf extra)))))
- (if tem
- (vector-push-extend ch tem))
- (setq i (+ i 1)))
- (cond (tem )
- ((> extra 0)
- (setq tem
- (make-array (f + (length x) extra)
- :element-type 'string-char :fill-pointer 0))
- (setq i 0)
- (go AGAIN))
- (t (setq tem x)))
- )
- tem))
+ (let ((x (if (stringp x) x (string x))))
+ (declare (string x))
+ (let (tem)
+ (tagbody
+ AGAIN
+ (while (< i len)
+ (setq ch (aref x i))
+ (cond ((position ch "\\()[]+.*|^$?")
+ (cond (tem
+ (vector-push-extend #\\ tem))
+ (t (incf extra)))))
+ (if tem
+ (vector-push-extend ch tem))
+ (setq i (+ i 1)))
+ (cond (tem )
+ ((> extra 0)
+ (setq tem
+ (make-array (f + (length x) extra)
+ :element-type 'string-char :fill-pointer 0))
+ (setq i 0)
+ (go AGAIN))
+ (t (setq tem x)))
+ )
+ tem)))
(defun get-match (string i)
(subseq string (match-beginning i) (match-end i)))
@@ -289,15 +294,15 @@
(let* ((info-subfile (info-subfile n))
(s (info-get-file (cdr info-subfile)))
(end (- n (car info-subfile))))
- (while (f >= (string-match #u" " s i end) 0)
+ (while (f >= (string-match +crlu+ s i end) 0)
(setq i (match-end 0)))
(setq i (- i 1))
(if (f >= (string-match
- #u" [\n ][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n" s i) 0)
+ (fcr #u" [\n ][^\n]*Node:[ \t]+([^\n\t,]+)[\n\t,][^\n]*\n") s i) 0)
(let* ((i (match-beginning 0))
(beg (match-end 0))
(name (get-match s 1))
- (end(if (f >= (string-match "[ ]" s beg) 0)
+ (end(if (f >= (string-match +crnp+ s beg) 0)
(match-beginning 0)
(length s)))
(node (list* s beg end i name info-subfile
@@ -323,7 +328,7 @@
(setq position-pattern (car name) name (cdr name)))))
(or (stringp name) (info-error "bad arg"))
(waiting *info-window*)
- (cond ((f >= (string-match "^\\(([^(]+)\\)([^)]*)" name) 0)
+ (cond ((f >= (string-match (fcr "^\\(([^(]+)\\)([^)]*)") name) 0)
;; (file)node
(setq file (get-match name 1))
(setq name (get-match name 2))
@@ -348,7 +353,7 @@
s start) 0)
(let* ((i (match-beginning 0))
(beg (match-end 0))
- (end(if (f >= (string-match "[ ]" s beg) 0)
+ (end(if (f >= (string-match +crnp+ s beg) 0)
(match-beginning 0)
(length s)))
(node (list* s beg end i name info-subfile
@@ -363,7 +368,7 @@
(f >= (setq subnode
(string-match
(si::string-concatenate
- #u"\n - [A-Za-z ]+: "
+ #u"\n -+ [A-Za-z ]+: "
position-pattern #u"[ \n]")
s beg end)) 0)
(f >= (string-match position-pattern s beg end) 0))
@@ -378,9 +383,13 @@
(let ((e
(if (and (>= subnode 0)
(f >=
- (string-match #u"\n\n - [A-Z]"
- s (+ beg 1
- initial-offset)
+ (string-match
+ (fcr #u"\n -+ [a-zA-Z]")
+ s
+ (let* ((bg (+ beg 1 initial-offset))
+ (sd (string-match (fcr #u"\n ") s bg end))
+ (nb (if (minusp sd) bg sd)))
+ nb)
end)
0))
(match-beginning 0)
=============================================================================
Robert Dodier writes:
> --- "Vadim V. Zhytnikov" wrote:
>
> > Wolfgang just committed the fix into Maxima CVS.
> > The problem was not with new Maxima info layout
> > but with new texinfo version. Robert, could you
> > verify after this fix describe well for you?
> > The also should not forget to switch to Maxima's
> > describe for gcl at least temporary.
>
> I have updated the source code on my machine and rebuilt
> with gcl and clisp. I find that the clisp version works
> correctly -- "? limit", then choosing 2 gives just item 2.
> Likewise for some other cases I tried.
>
> As you know the gcl version uses the built-in gcl info
> system when *PROMPT-PREFIX* and *PROMPT-SUFFIX* are empty,
> and otherwise falls back on src/cl-info.lisp.
> I find that the "? limit", then choose 2, yields a mess
> of irrelevant text when the built-in gcl info system is
> used. Setting *PROMPT-PREFIX* to "FOO" (to cause Maxima
> to use cl-info.lisp), then "? limit" and choose 2, yields
> the correct output (but much more slowly).
>
> gcl version is 2.6.6, makeinfo is 4.5, clisp is 2.31.
>
> Hope this helps,
> Robert Dodier
>
>
>
> __________________________________
> Do you Yahoo!?
> Make Yahoo! your home page
> http://www.yahoo.com/r/hs
>
>
>
--
Camm Maguire camm@enhanced.com
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah