|
From: Vadim V. Z. <vv...@us...> - 2001-12-09 14:17:58
|
Update of /cvsroot/maxima/maxima-pre59/src
In directory usw-pr-cvs1:/tmp/cvs-serv24516/src
Modified Files:
ChangeLog cl-info.lisp cmulisp-regex.lisp compile-clisp.lisp
compile-cmulisp.lisp macdes.lisp maxima-package.lisp
mdebug.lisp
Added Files:
clisp-regex.lisp
Log Message:
online info browsing (describe) for clisp and cmucl
--- NEW FILE: clisp-regex.lisp ---
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage "SI"
(:use "COMMON-LISP")
(:export
"STRING-MATCH"
"MATCH-END"
"MATCH-BEGINNING"
"*MATCH-DATA*"
"*CASE-FOLD-SEARCH*"))
)
(in-package "SI")
(defvar *match-data*)
(defvar *case-fold-search* nil)
#+nil
(defun string-match (pattern string
&optional (start 0) end)
"Search the string STRING for the first pattern that matches the
regexp PATTERN. The syntax used for the pattern is specified by
SYNTAX. The search may start in the string at START and ends at END,
which default to 0 and the end of the string.
If there is a match, returns the index of the start of the match and
an array of match-data. If there is no match, -1 is returned and
nil."
(let ((result
(multiple-value-list
#+case-fold-search
(regexp:match pattern string :start start :end end
:case-insensitive *case-fold-search*)
#+case-fold-search-not
(regexp:match pattern string :start start :end end
:case-sensitive (not *case-fold-search*))
)))
(setf *match-data* result)
(if (first result)
(regexp:match-start (first result))
-1)))
(defun string-match (pattern string
&optional (start 0) end)
"Search the string STRING for the first pattern that matches the
regexp PATTERN. The syntax used for the pattern is specified by
SYNTAX. The search may start in the string at START and ends at END,
which default to 0 and the end of the string.
If there is a match, returns the index of the start of the match and
an array of match-data. If there is no match, -1 is returned and
nil."
(let* ((compiled-pattern (regexp:regexp-compile pattern
#+case-fold-search *case-fold-search*
#+case-fold-search-not (not *case-fold-search*)
))
(result
(multiple-value-list
(regexp:regexp-exec compiled-pattern string
:start start :end end))))
(setf *match-data* result)
(if (first result)
(regexp:match-start (first result))
-1)))
(defun match-beginning (index &optional (match-data *match-data*))
(if (and match-data (< index (length match-data)))
(regexp:match-start (elt match-data index))
-1))
(defun match-end (index &optional (match-data *match-data*))
(if (and match-data (< index (length match-data)))
(regexp:match-end (elt match-data index))
-1))
Index: ChangeLog
===================================================================
RCS file: /cvsroot/maxima/maxima-pre59/src/ChangeLog,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** ChangeLog 2001/11/19 04:45:52 1.9
--- ChangeLog 2001/12/09 14:17:55 1.10
***************
*** 1,2 ****
--- 1,19 ----
+ 2001-12-09 Vadim V. Zhytnikov <vv...@ma...>
+
+ * New online info browsing code for clisp and cmulisp
+ by Raymond Toy. To make describe work with clisp you have
+ to compile clisp with REGEXP module and later invoke it
+ during maxima compilation and at run time with full
+ linking kit
+ clisp -K full
+ To make it work with cmulisp you need regex.o object
+ file. It's source regex.c/h is part of glibc and also
+ can be found in clisp sources. Before compiling maxima
+ with cmulisp edit compile-cmulisp.lisp, cmulisp-regex.lisp
+ and replace
+ /apps/.../regex-0.12/regex.o
+ by he path where regex.o resides on your system (value of
+ the *regex-lib* variable).
+
2001-11-19 Vadim V. Zhytnikov <vv...@ma...>
Index: cl-info.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima-pre59/src/cl-info.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** cl-info.lisp 2001/06/06 09:13:09 1.2
--- cl-info.lisp 2001/12/09 14:17:55 1.3
***************
*** 1,22 ****
! ;;; This is port of GCL's info.lsp to CMUCL. This should basically be
;;; portable Common Lisp, but I haven't tested it with anything else.
! (in-package "SI")
! (use-package "REGEX")
! (declaim (optimize (safety 3) (debug 3)))
(eval-when (compile eval)
(defmacro while (test &body body)
[...1001 lines suppressed...]
collect
! (and (f >= (match-beginning i) 0)
(get-match s i))))
!
! ;;; Local Variables: ***
! ;;; mode:lisp ***
! ;;; version-control:t ***
! ;;; comment-column:0 ***
! ;;; comment-start: ";;; " ***
! ;;; End: ***
--- 649,655 ----
(loop for i in l
collect
! (and (>= (match-beginning i) 0)
(get-match s i))))
! ||#
Index: cmulisp-regex.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima-pre59/src/cmulisp-regex.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** cmulisp-regex.lisp 2001/04/18 00:23:29 1.2
--- cmulisp-regex.lisp 2001/12/09 14:17:55 1.3
***************
*** 2,9 ****
;;; Alien interface to GNU regex, for CMUCL
;;;
;;;
! (in-package "REGEX")
(export '(
;; Constants
--- 2,70 ----
;;; Alien interface to GNU regex, for CMUCL
;;;
+ ;;; Copyright 2000, Raymond Toy
+ ;;;
+ ;;; This is a part of Maxima and therefore released under the GPL that
+ ;;; governs GPL.
;;;
+ ;;; It is intended that we support everything that GNU regex does, but
+ ;;; we're not quite there yet.
+ ;;;
! (eval-when (compile load eval)
! (defpackage "REGEXP"
! (:use "COMMON-LISP" "ALIEN" "C-CALL")
! (:export
! ;; Constants
! "+RE-BACKSLASH-ESCAPE-IN-LISTS+"
! "+RE-BK-PLUS-QM+"
! "+RE-CHAR-CLASSES+"
! "+RE-CONTEXT-INDEP-ANCHORS+"
! "+RE-CONTEXT-INDEP-OPS+"
! "+RE-CONTEXT-INVALID-OPS+"
! "+RE-DOT-NEWLINE+"
! "+RE-DOT-NOT-NULL+"
! "+RE-HAT-LISTS-NOT-NEWLINE+"
! "+RE-INTERVALS+"
! "+RE-LIMITED-OPS+"
! "+RE-NEWLINE-ALT+"
! "+RE-NO-BK-BRACES+"
! "+RE-NO-BK-PARENS+"
! "+RE-NO-BK-REFS+"
! "+RE-NO-BK-VBAR+"
! "+RE-NO-EMPTY-RANGES+"
! "+RE-UNMATCHED-RIGHT-PAREN-ORD+"
! ;; Common regexp syntaxes
! "+RE-SYNTAX-EMACS+"
! "+RE-SYNTAX-EGREP+"
! "+RE-SYNTAX-POSIX-COMMON+"
! "+RE-SYNTAX-POSIX-BASIC+"
! "+RE-SYNTAX-POSIX-EXTENDED+"
! "+RE-SYNTAX-SPENCER+"
! ;; Variables
! "*MATCH-DATA*"
! "*CASE-FOLD-SEARCH*"
! ;; Functions
! "MATCH-DATA-START"
! "MATCH-DATA-END"
! "RE-SET-SYNTAX"
! "COMPILE-PATTERN"
! "ALLOCATE-RE-REGS"
! "FREE-RE-REGS"
! "RE-NSUB"
! "LISPIFY-MATCH-DATA"
! "RE-SEARCH"
! "RE-REGFREE"
! "STRING-MATCH"
! "MATCH-BEGINNING"
! "MATCH-END"
! ))
!
! (defpackage "SI"
! (:use "COMMON-LISP" "REGEXP" "ALIEN"))
! ) ; end eval-when
+ (in-package "REGEXP")
+
+ #+nil
(export '(
;; Constants
***************
*** 47,53 ****
(use-package "C-CALL")
- #+nil
(eval-when (:load-toplevel :compile-toplevel :execute)
! (ext:load-foreign "/apps/gnu/src/regex-0.12/regex.o")
)
--- 108,118 ----
(use-package "C-CALL")
(eval-when (:load-toplevel :compile-toplevel :execute)
! (defvar *regex-lib*
! "/apps/gnu/src/regex-0.12/regex.o"
! "The full path to GNU regex.o")
! )
! (eval-when (:compile-toplevel :execute)
! (ext:load-foreign *regex-lib*)
)
***************
*** 109,116 ****
--- 174,188 ----
(regs (* re-registers)))
+ (declaim (inline re-set-syntax))
+ (def-alien-routine ("re_set_syntax" re-set-syntax) reg-syntax-t
+ (syntax reg-syntax-t))
+
+ ;; Note: for some reason, I can't set this directly to get the desired
+ ;; syntax. I need to use re_set_syntax instead, which works.
(def-alien-variable ("re_syntax_options" re-syntax-options) reg-syntax-t)
;;; POSIX interface
+ ;;; Not yet supported, but we really should since it's standardized.
#|
(def-alien-type regex-t re-pattern-buffer)
***************
*** 143,146 ****
--- 215,220 ----
|#
+ ;; Create all of the necessary constants defined in regex.h to define the syntax.
+
(macrolet ((frob (&rest name-desc-list)
`(progn
***************
*** 187,191 ****
--- 261,279 ----
(+re-unmatched-right-paren-ord+ "")))
+ ;; Define some common syntaxes.
+
(defconstant +re-syntax-emacs+ 0)
+
+ (defconstant +re-syntax-awk+
+ (logior +re-backslash-escape-in-lists+ +re-dot-not-null+
+ +re-no-bk-parens+ +re-no-bk-refs+
+ +re-no-bk-vbar+ +re-no-empty-ranges+
+ +re-unmatched-right-paren-ord+))
+
+ (defconstant +re-syntax-grep+
+ (logior +re-bk-plus-qm+ +re-char-classes+
+ +re-hat-lists-not-newline+ +re-intervals+
+ +re-newline-alt+))
+
(defconstant +re-syntax-egrep+
(logior +re-char-classes+ +re-context-indep-anchors+
***************
*** 201,204 ****
--- 289,295 ----
(logior +re-syntax-posix-common+ +re-bk-plus-qm+))
+ (defconstant +re-syntax-posix-minimal-basic+
+ (logior +re-syntax-posix-common+ +re-limited-ops+))
+
(defconstant +re-syntax-posix-extended+
(logior +re-syntax-posix-common+ +re-context-indep-anchors+
***************
*** 207,214 ****
--- 298,314 ----
+re-unmatched-right-paren-ord+))
+ (defconstant +re-syntax-posix-awk+
+ (logior +re-syntax-posix-extended+ +re-backslash-escape-in-lists+))
+
+ ;; This isn't defined regex.h, but GCL uses this syntax in its info
+ ;; reader. (Not 100% sure this is right, but is close enough for
+ ;; GCL's and maxima's use.)
(defconstant +re-syntax-spencer+
(logior +re-no-bk-parens+ +re-no-bk-vbar+))
+ ;;; This ends the raw GNU regex interface.
+ ;;; A simple slightly higher-level interface to GNU regex that might
+ ;;; be more appropriate for Lisp.
#+nil
(defun allocate-re-regs (compiled-pattern-buffer)
***************
*** 233,236 ****
--- 333,341 ----
regs))
+ ;; Return the number of matches and submatches found in the result
+ ;; pattern buffer after doing a search. Assumes the search was
+ ;; successful.
+ (defun re-nsub (pat-buf)
+ (1+ (slot (deref pat-buf) 're-nsub)))
(defun free-re-regs (re-regs)
***************
*** 327,338 ****
(make-match-data :start (deref start k) :end (deref end k))))
matches))
!
(defun string-match (pattern string
&optional (start 0) end
! (syntax +re-syntax-spencer+))
"Search the string STRING for the first pattern that matches the
regexp PATTERN. The syntax used for the pattern is specified by
SYNTAX. The search may start in the string at START and ends at END,
! which default to 0 and the end of the string.
If there is a match, returns the index of the start of the match and
--- 432,445 ----
(make-match-data :start (deref start k) :end (deref end k))))
matches))
!
! (in-package "SI")
! ;;; Define the interface needed by cl-info.
(defun string-match (pattern string
&optional (start 0) end
! (syntax +re-syntax-posix-basic+))
"Search the string STRING for the first pattern that matches the
regexp PATTERN. The syntax used for the pattern is specified by
SYNTAX. The search may start in the string at START and ends at END,
! which default to 0 and the end of the string, respectively.
If there is a match, returns the index of the start of the match and
***************
*** 340,353 ****
nil."
(declare (type string pattern string))
! (setf re-syntax-options syntax)
! (let* ((comp-result (compile-pattern pattern)))
;; Make sure we free up the space for the pattern buffer.
(unwind-protect
(progn
(cond (comp-result
! (let* ((re-regs (allocate-re-regs)))
;; Make sure we free up the space for the registers
(unwind-protect
(progn
(let ((search-result
(re-search comp-result string (length string)
--- 447,462 ----
nil."
(declare (type string pattern string))
! (re-set-syntax syntax)
! (let (comp-result)
;; Make sure we free up the space for the pattern buffer.
(unwind-protect
(progn
+ (setf comp-result (compile-pattern pattern))
(cond (comp-result
! (let (re-regs)
;; Make sure we free up the space for the registers
(unwind-protect
(progn
+ (setf re-regs (allocate-re-regs))
(let ((search-result
(re-search comp-result string (length string)
***************
*** 357,361 ****
(let ((matches
(lispify-match-data
! (1+ (slot (deref comp-result) 're-nsub))
re-regs)))
;; Save the last match in the global var
--- 466,470 ----
(let ((matches
(lispify-match-data
! (re-nsub comp-result)
re-regs)))
;; Save the last match in the global var
***************
*** 372,375 ****
--- 481,527 ----
(re-regfree comp-result)
(free-alien comp-result))))
+
+ ;; Memoized version
+ #+nil
+ (defvar *compiled-pattern-hashtable* (make-hash-table :test 'equal))
+
+ #+nil
+ (defun string-match (pattern string
+ &optional (start 0) end)
+ (declare (type string pattern string))
+ (setf re-syntax-options +re-syntax-posix-basic+)
+ (multiple-value-bind (comp-pattern foundp)
+ (gethash pattern *compiled-pattern-hashtable*)
+ (unless comp-pattern
+ ;; Compile up the pattern and save it away
+ (setf (gethash pattern *compiled-pattern-hashtable*)
+ (compile-pattern pattern))
+ (setf comp-pattern (gethash pattern *compiled-pattern-hashtable*)))
+ (unwind-protect
+ (progn
+ (cond (comp-pattern
+ (let* ((re-regs (allocate-re-regs)))
+ ;; Make sure we free up the space for the registers
+ (unwind-protect
+ (progn
+ (let ((search-result
+ (re-search comp-pattern string (length string)
+ start (or end (length string))
+ re-regs)))
+ (cond ((>= search-result 0)
+ (let ((matches
+ (lispify-match-data
+ (1+ (slot (deref comp-pattern) 're-nsub))
+ re-regs)))
+ ;; Save the last match in the global var
+ (setf *match-data* matches)
+ (values search-result matches)))
+ (t
+ (values search-result nil)))))
+ ;; Free up the re-register since we're done with it now.
+ (free-re-regs re-regs))))
+ (t
+ (setf *match-data* nil)
+ (values -1 nil)))))))
(defun match-beginning (index &optional (match-data *match-data*))
Index: compile-clisp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima-pre59/src/compile-clisp.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** compile-clisp.lisp 2001/11/19 04:45:52 1.9
--- compile-clisp.lisp 2001/12/09 14:17:55 1.10
***************
*** 1,3 ****
--- 1,6 ----
+ (defpackage "SI"
+ (:use "COMMON-LISP"))
+
(if (find-package "EXT")
(use-package "EXT"))
***************
*** 10,17 ****
--- 13,28 ----
(defun compile-maxima ()
(make::make :maxima :compile t)
+ (if (find-package "REGEXP")
+ (progn
+ (compile-file "clisp-regex")
+ (compile-file "cl-info") ))
)
(defun save-maxima ()
(make::make :maxima )
+ (if (find-package "REGEXP")
+ (progn
+ (load "clisp-regex")
+ (load "cl-info") ))
(gc)
(saveinitmem "maxima-clisp.mem"
Index: compile-cmulisp.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima-pre59/src/compile-cmulisp.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** compile-cmulisp.lisp 2001/04/27 17:05:59 1.10
--- compile-cmulisp.lisp 2001/12/09 14:17:55 1.11
***************
*** 20,28 ****
;; this is now in maxima package
! (defpackage "SI"
! (:use "COMMON-LISP" "ALIEN" "C-CALL"))
! (defvar si::*info-paths* nil)
!
! (defpackage "REGEX"
(:use "COMMON-LISP" "ALIEN" "C-CALL")
(:export
--- 20,24 ----
;; this is now in maxima package
! (defpackage "REGEXP"
(:use "COMMON-LISP" "ALIEN" "C-CALL")
(:export
***************
*** 46,50 ****
"+RE-NO-EMPTY-RANGES+"
"+RE-UNMATCHED-RIGHT-PAREN-ORD+"
! ";; COMMON REGEXP SYNTAXES"
"+RE-SYNTAX-EMACS+"
"+RE-SYNTAX-EGREP+"
--- 42,46 ----
"+RE-NO-EMPTY-RANGES+"
"+RE-UNMATCHED-RIGHT-PAREN-ORD+"
! ;; Common regexp syntaxes
"+RE-SYNTAX-EMACS+"
"+RE-SYNTAX-EGREP+"
***************
*** 59,62 ****
--- 55,66 ----
"MATCH-DATA-START"
"MATCH-DATA-END"
+ "RE-SET-SYNTAX"
+ "COMPILE-PATTERN"
+ "ALLOCATE-RE-REGS"
+ "FREE-RE-REGS"
+ "RE-NSUB"
+ "LISPIFY-MATCH-DATA"
+ "RE-SEARCH"
+ "RE-REGFREE"
"STRING-MATCH"
"MATCH-BEGINNING"
***************
*** 64,67 ****
--- 68,76 ----
))
+ (defpackage "SI"
+ (:use "COMMON-LISP" "REGEXP" "ALIEN"))
+ (defvar si::*info-paths* nil)
+
+
(push :main-files-loaded *features*)
(load "sysdef.lisp")
***************
*** 138,141 ****
--- 147,151 ----
;; define bye so that quit() will work in maxima
(defun bye () (ext:quit))
+ (defun quit () (ext:quit))
Index: macdes.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima-pre59/src/macdes.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** macdes.lisp 2001/04/19 06:06:10 1.6
--- macdes.lisp 2001/12/09 14:17:55 1.7
***************
*** 13,17 ****
(defvar $manual_demo "manual.demo")
! (DEFmspec $example (l) (setq l (cdr l))
(block
$example
--- 13,17 ----
(defvar $manual_demo "manual.demo")
! (defmspec $example (l) (setq l (cdr l))
(block
$example
***************
*** 119,136 ****
(setq x ($sconcat x))
(setq *INFO-PATHS*
! (cons (concatenate 'string *maxima-directory*
! "info/")
! *INFO-PATHS*))
! #+(or gcl cmulisp)
! (if (fboundp 'si::info)
! (return-from $describe (si::info x '("maxima.info"))))
!
"The documentation is now in INFO format and can be printed using
tex, or viewed using info or gnu emacs or using a web browser:
http://www.ma.utexas.edu/maxima/
! Versions of maxima built
! on GCL or CMULISP have a builtin info retrieval mechanism"
)
-
--- 119,135 ----
(setq x ($sconcat x))
(setq *INFO-PATHS*
! (cons (concatenate 'string *maxima-directory*
! "info/")
! *INFO-PATHS*))
! (if (and (find-package "SI")
! (fboundp (intern "INFO" "SI")))
! (return-from $describe (funcall (intern "INFO" "SI") x
! '("maxima.info") #-gcl *info-paths*)))
!
"The documentation is now in INFO format and can be printed using
tex, or viewed using info or gnu emacs or using a web browser:
http://www.ma.utexas.edu/maxima/
! Some versions of maxima built have a builtin info retrieval mechanism."
)
Index: maxima-package.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima-pre59/src/maxima-package.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** maxima-package.lisp 2001/11/19 04:45:52 1.7
--- maxima-package.lisp 2001/12/09 14:17:55 1.8
***************
*** 106,109 ****
--- 106,124 ----
(setf (symbol-function 'maxima::newline) (symbol-function 'si::newline))
+ ;; *info-paths* from cl-info.lisp
+ #+(or clisp cmu)
+ (import '( si::*info-paths* ) "MAXIMA" )
+
+ ;; detect which version of clisp REGEXP we have
+ #+clisp
+ (if (find-package "REGEXP")
+ (push (cond ((apply (intern "REGEXP-EXEC" "REGEXP")
+ (list (apply (intern "REGEXP-COMPILE" "REGEXP")
+ '("AAA" t))
+ "aaa"))
+ ':case-fold-search )
+ (t ':case-fold-search-not ))
+ *features* ))
+
;;redefined in commac lucid 2.1 does (functionp 'jiljay)-->t
(if (lisp::functionp 'dotimes) (push :shadow-functionp *features*))
Index: mdebug.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima-pre59/src/mdebug.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** mdebug.lisp 2001/04/19 06:06:10 1.6
--- mdebug.lisp 2001/12/09 14:17:55 1.7
***************
*** 312,316 ****
((and (eql #\? ch) (member next '(#\space #\tab)))
(let* ((line (string-trim '(#\space #\tab #\; #\$)
! (subseq (read-line stream eof-error-p eof-value) 2))))
`((displayinput) nil (($describe) ,line))))
(t (setq *last-dbm-command* nil)
--- 312,316 ----
((and (eql #\? ch) (member next '(#\space #\tab)))
(let* ((line (string-trim '(#\space #\tab #\; #\$)
! (subseq (read-line stream eof-error-p eof-value) 1))))
`((displayinput) nil (($describe) ,line))))
(t (setq *last-dbm-command* nil)
|