From: Chris Hanson Date: Sat, 19 Jan 1991 04:21:33 +0000 (+0000) Subject: Changes for new parser, which corresponds to RCS 5.5. X-Git-Tag: 20090517-FFI~10963 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b2e087bab4563f34a8dab17630c535ec130d52a4;p=mit-scheme.git Changes for new parser, which corresponds to RCS 5.5. --- diff --git a/v7/src/rcs/format.scm b/v7/src/rcs/format.scm index bfeca9b14..f28ca9803 100644 --- a/v7/src/rcs/format.scm +++ b/v7/src/rcs/format.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/format.scm,v 1.1 1991/01/18 19:07:22 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/format.scm,v 1.2 1991/01/19 04:21:02 cph Exp $ -Copyright (c) 1987 Massachusetts Institute of Technology +Copyright (c) 1987, 1991 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -35,7 +35,6 @@ MIT in each case. |# ;;;; RCS Format (declare (usual-integrations)) -(declare (integrate-external "object")) (define (rcs/format rcstext) (let ((head (rcstext/head rcstext))) @@ -62,41 +61,45 @@ MIT in each case. |# (define (format/lock lock) (write-string " ") - (write (car lock)) + (write-string (car lock)) (write-string ": ") (write-string (delta/number (cdr lock)))) (define (format/user user) (write-string " ") - (write user)) + (write-string user)) (define (format/symbol symbol) (write-string " ") - (write (car symbol)) + (write-string (car symbol)) (write-string ": ") (write-string (delta/number (cdr symbol)))) - + (define (format/delta-trunk head) (let loop ((delta head)) (if delta - (begin (format/delta delta) - (loop (delta/next delta)))))) + (begin + (format/delta delta) + (loop (delta/next delta)))))) (define (format/delta-tree head) (if head - (begin (format/delta-tree (delta/next head)) - (format/delta-forest (delta/branches head))))) + (begin + (format/delta-tree (delta/next head)) + (format/delta-forest (delta/branches head))))) (define (format/delta-forest branches) (if (not (null? branches)) - (begin (format/delta-forest (cdr branches)) - (format/delta-branch (car branches)) - (format/delta-tree (car branches))))) + (begin + (format/delta-forest (cdr branches)) + (format/delta-branch (car branches)) + (format/delta-tree (car branches))))) (define (format/delta-branch branch) (if branch - (begin (format/delta-branch (delta/next branch)) - (format/delta branch)))) + (begin + (format/delta-branch (delta/next branch)) + (format/delta branch)))) (define (format/delta delta) (write-string "----------------------------\nrevision ") @@ -104,9 +107,9 @@ MIT in each case. |# (write-string "\ndate: ") (format/date (delta/date delta)) (write-string "; author: ") - (write (delta/author delta)) + (write-string (delta/author delta)) (write-string "; state: ") - (write (delta/state delta)) + (write-string (delta/state delta)) (newline) (write-string (delta/log delta))) diff --git a/v7/src/rcs/logmer.scm b/v7/src/rcs/logmer.scm index fa19136dd..b92d6ded7 100644 --- a/v7/src/rcs/logmer.scm +++ b/v7/src/rcs/logmer.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/logmer.scm,v 1.1 1991/01/18 19:07:39 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/logmer.scm,v 1.2 1991/01/19 04:21:08 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1991 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -35,7 +35,6 @@ MIT in each case. |# ;;;; RCS Log Merge (declare (usual-integrations)) -(declare (integrate-external "object")) (define trace-port false) @@ -92,9 +91,9 @@ MIT in each case. |# (write-string "\ndate: ") (write-string (date->string (delta/date delta))) (write-string "; author: ") - (write (delta/author delta)) + (write-string (delta/author delta)) (write-string "; state: ") - (write (delta/state delta)) + (write-string (delta/state delta)) (newline)) (define (compress-entries entries) @@ -152,7 +151,7 @@ MIT in each case. |# (write-string (pathname->string pathname) trace-port))) (let ((deltas (rcstext->deltas (rcs/read-file pathname 'LOG-ONLY)))) (for-each (lambda (delta) - (delta/set-log! delta + (set-delta/log! delta (let ((log (string-trim (delta/log delta)))) (if (string-null? log) empty-log-message diff --git a/v7/src/rcs/make.scm b/v7/src/rcs/make.scm index 72ec18ddf..b2f1f1091 100644 --- a/v7/src/rcs/make.scm +++ b/v7/src/rcs/make.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/make.scm,v 1.1 1991/01/18 19:07:51 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/make.scm,v 1.2 1991/01/19 04:21:14 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1991 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -36,5 +36,6 @@ MIT in each case. |# (declare (usual-integrations)) +(load-option 'hash-table) (package/system-loader "rcs" '() 'QUERY) -(add-identification! "RCS" 1 0) \ No newline at end of file +(add-identification! "RCS" 2 0) \ No newline at end of file diff --git a/v7/src/rcs/object.scm b/v7/src/rcs/object.scm index b8d928b69..fe39d5e7a 100644 --- a/v7/src/rcs/object.scm +++ b/v7/src/rcs/object.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/object.scm,v 1.1 1991/01/18 19:08:04 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/object.scm,v 1.2 1991/01/19 04:21:19 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1991 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -36,86 +36,43 @@ MIT in each case. |# (declare (usual-integrations)) -(define-integrable (rcstext/make head access symbols locks strict? comment - description) - (vector rcstext/tag head access symbols locks strict? comment description)) - -(define rcstext/tag - "rcstext") - -(define-integrable (rcstext/head rcstext) (vector-ref rcstext 1)) -(define-integrable (rcstext/access rcstext) (vector-ref rcstext 2)) -(define-integrable (rcstext/symbols rcstext) (vector-ref rcstext 3)) -(define-integrable (rcstext/locks rcstext) (vector-ref rcstext 4)) -(define-integrable (rcstext/strict? rcstext) (vector-ref rcstext 5)) -(define-integrable (rcstext/comment rcstext) (vector-ref rcstext 6)) -(define-integrable (rcstext/description rcstext) (vector-ref rcstext 7)) - -(define-integrable (rcstext/set-head! rcstext head) - (vector-set! rcstext 1 head)) - -(define-integrable (rcstext/set-access! rcstext access) - (vector-set! rcstext 2 access)) - -(define-integrable (rcstext/set-symbols! rcstext symbols) - (vector-set! rcstext 3 symbols)) - -(define-integrable (rcstext/set-locks! rcstext locks) - (vector-set! rcstext 4 locks)) - -(define-integrable (rcstext/set-strict?! rcstext strict?) - (vector-set! rcstext 5 strict?)) - -(define-integrable (rcstext/set-comment! rcstext comment) - (vector-set! rcstext 6 comment)) - -(define-integrable (rcstext/set-description! rcstext description) - (vector-set! rcstext 7 description)) - -(define-integrable (delta/make number) - (vector delta/tag number false false false false false false false)) - -(define delta/tag - "delta") - -(define-integrable (delta/number delta) (vector-ref delta 1)) -(define-integrable (delta/date delta) (vector-ref delta 2)) -(define-integrable (delta/author delta) (vector-ref delta 3)) -(define-integrable (delta/state delta) (vector-ref delta 4)) -(define-integrable (delta/branches delta) (vector-ref delta 5)) -(define-integrable (delta/next delta) (vector-ref delta 6)) -(define-integrable (delta/log delta) (vector-ref delta 7)) -(define-integrable (delta/text delta) (vector-ref delta 8)) - -(define-integrable (delta/set-number! delta number) - (vector-set! delta 1 number)) - -(define-integrable (delta/set-date! delta date) - (vector-set! delta 2 date)) - -(define-integrable (delta/set-author! delta author) - (vector-set! delta 3 author)) - -(define-integrable (delta/set-state! delta state) - (vector-set! delta 4 state)) - -(define-integrable (delta/set-branches! delta branches) - (vector-set! delta 5 branches)) - -(define-integrable (delta/set-next! delta next) - (vector-set! delta 6 next)) - -(define-integrable (delta/set-log! delta log) - (vector-set! delta 7 log)) - -(define-integrable (delta/set-text! delta text) - (vector-set! delta 8 text)) - -(unparser/set-tagged-vector-method! - delta/tag - (unparser/standard-method "DELTA" - (lambda (state delta) - (unparse-string state (delta/number delta))))) +(define rcstext-rtd + (make-record-type + "rcstext" + '(head branch access symbols locks strict? comment expand description))) + +(define make-rcstext (record-constructor rcstext-rtd)) +(define rcstext/head (record-accessor rcstext-rtd 'head)) +(define rcstext/branch (record-accessor rcstext-rtd 'branch)) +(define rcstext/access (record-accessor rcstext-rtd 'access)) +(define rcstext/symbols (record-accessor rcstext-rtd 'symbols)) +(define rcstext/locks (record-accessor rcstext-rtd 'locks)) +(define rcstext/strict? (record-accessor rcstext-rtd 'strict?)) +(define rcstext/comment (record-accessor rcstext-rtd 'comment)) +(define rcstext/expand (record-accessor rcstext-rtd 'expand)) +(define rcstext/description (record-accessor rcstext-rtd 'description)) + +(define delta-rtd + (make-record-type "rcsdelta" + '(number date author state branches next log text))) + +(define make-delta (record-constructor delta-rtd)) +(define delta/number (record-accessor delta-rtd 'number)) +(define delta/date (record-accessor delta-rtd 'date)) +(define delta/author (record-accessor delta-rtd 'author)) +(define delta/state (record-accessor delta-rtd 'state)) +(define delta/branches (record-accessor delta-rtd 'branches)) +(define delta/next (record-accessor delta-rtd 'next)) +(define set-delta/next! (record-updater delta-rtd 'next)) +(define delta/log (record-accessor delta-rtd 'log)) +(define set-delta/log! (record-updater delta-rtd 'log)) +(define delta/text (record-accessor delta-rtd 'text)) +(define set-delta/text! (record-updater delta-rtd 'text)) + +(set-record-type-unparser-method! delta-rtd + (unparser/standard-method 'rcsdelta + (lambda (state delta) + (unparse-string state (delta/number delta))))) (define (date/make year month day hour minute second) (vector diff --git a/v7/src/rcs/rcs.pkg b/v7/src/rcs/rcs.pkg index ce98044c0..d3f21fa67 100644 --- a/v7/src/rcs/rcs.pkg +++ b/v7/src/rcs/rcs.pkg @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/rcs.pkg,v 1.1 1991/01/18 19:09:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/rcs.pkg,v 1.2 1991/01/19 04:21:25 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1991 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -47,7 +47,7 @@ MIT in each case. |# rcs/format)) (define-package (rcs parser) - (files "parser") + (files "nparse") (parent (rcs)) (export (rcs) rcs/read-file diff --git a/v7/src/rcs/rcs.sf b/v7/src/rcs/rcs.sf index 446e9a4d2..cff8d0f44 100644 --- a/v7/src/rcs/rcs.sf +++ b/v7/src/rcs/rcs.sf @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/rcs.sf,v 1.1 1991/01/18 19:10:09 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/rcs/Attic/rcs.sf,v 1.2 1991/01/19 04:21:33 cph Exp $ -Copyright (c) 1988, 1989 Massachusetts Institute of Technology +Copyright (c) 1988, 1989, 1991 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -33,7 +33,6 @@ promotional, or sales literature without prior written consent from MIT in each case. |# (fluid-let ((sf/default-syntax-table system-global-syntax-table)) - (sf-conditionally "object") (sf-directory ".")) ;; Guarantee that the package modeller is loaded.