Had to shuffle packages due to broken package dependencies.

The whole thing is a disaster and should be completely re-factorised.
This commit is contained in:
shivers 1997-02-27 04:50:57 +00:00
parent 6a7ecc38a1
commit e989a744e4
9 changed files with 108 additions and 103 deletions

View File

@ -67,18 +67,3 @@ scheme_value df_re_match(long nargs, scheme_value *args)
return ret1;
}
scheme_value df_filter_stringvec(long nargs, scheme_value *args)
{
extern char *filter_stringvec(const char *, char const ** , int *);
scheme_value ret1;
char *r1;
int r2;
cig_check_nargs(3, nargs, "filter_stringvec");
r1 = filter_stringvec(cig_string_body(args[2]), (char const ** )AlienVal(args[1]), &r2);
ret1 = VECTOR_REF(*args,0);
{AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);}
VECTOR_REF(*args,1) = ENTER_FIXNUM(r2);
return ret1;
}

View File

@ -143,10 +143,10 @@
(reduce (lambda (index item)
(cond ((string? item)
(copy-string! ans index item)
(string-replace! ans index item)
(+ index (string-length item)))
(else (receive (si ei) (range item)
(copy-substring! ans index str si ei)
(substring-replace! ans index str si ei)
(+ index (- ei si))))))
0 items)
ans))))
@ -154,15 +154,6 @@
;;; Miscellaneous
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; I do this one in C, I'm not sure why:
;;; It is used by MATCH-FILES.
(define-foreign %filter-C-strings!
(filter_stringvec (string pattern) ((C "char const ** ~a") cvec))
static-string ; error message -- #f if no error.
integer) ; number of files that pass the filter.
;;; Convert a string into a regex pattern that matches that string exactly --
;;; in other words, quote the special chars with backslashes.

View File

@ -9,6 +9,3 @@ char *re_exec(scheme_value cr, const char *string, int start,
char *re_match(const char *re, const char *string, int start,
scheme_value start_vec, scheme_value end_vec,
int *hit);
char *filter_stringvec(const char *re, char const **stringvec,
int *nummatch);

View File

@ -179,24 +179,3 @@
(extensible-port-local-data fd/port)))
(else (display (substring s start end) fd/port))))) ; hack
(define (y-or-n? question . maybe-eof-value)
(let loop ((count *y-or-n-eof-count*))
(display question)
(display " (y/n)? ")
(let ((line (read-line)))
(cond ((eof-object? line)
(newline)
(if (= count 0)
(:optional maybe-eof-value (error "EOF in y-or-n?"))
(begin (display "I'll only ask another ")
(write count)
(display " times.")
(newline)
(loop (- count 1)))))
((< (string-length line) 1) (loop count))
((char=? (string-ref line 0) #\y) #t)
((char=? (string-ref line 0) #\n) #f)
(else (loop count))))))
(define *y-or-n-eof-count* 100)

View File

@ -213,7 +213,7 @@
read-string!
read-string/partial
read-string!/partial
write-string
(write-string (proc (:string &opt :value :exact-integer :exact-integer) :unspecific))
write-string/partial)))
@ -429,11 +429,7 @@
(define-interface scsh-string-interface
(compound-interface (export substitute-env-vars
index
rindex)
scsh-regexp-interface))
(export substitute-env-vars index rindex))
(define-interface scsh-file-names-interface
(export file-name-as-directory

View File

@ -52,54 +52,12 @@
(open defenum-package scheme)
(files (machine bufpol)))
(define-structures ((scsh-regexp-package scsh-regexp-interface)
(scsh-regexp-internals (export %filter-C-strings!)))
(open defrec-package
scsh-utilities
define-foreign-syntax
receiving
error-package
let-opt ; optional-arg parsing & defaulting
scheme)
(files re))
(define-structure char-set-package char-set-interface
(open error-package ascii scheme)
(files char-set))
(define-structure field-reader-package scsh-field-reader-interface
(open receiving ; receive
char-set-package
scsh-utilities
error-package ; error
scsh-level-0 ; regexes and delimited readers
let-opt ; optional-arg parsing & defaulting
scheme
)
(files fr))
(define-structures
((awk-expander-package (export expand-awk))
(awk-support-package (export next-range next-:range
next-range: next-:range:)))
(open receiving ; receive
scsh-utilities
error-package ; error
char-set-package
scheme
)
(files awk))
(define-structure awk-package awk-interface
(open awk-support-package scsh-regexp-package receiving scheme)
(for-syntax (open awk-expander-package scheme))
(begin (define-syntax awk expand-awk)))
(define-structures ((tty-flags tty-flags-interface)
(scsh-internal-tty-flags scsh-internal-tty-flags-interface))
(open scheme ascii bitwise)
@ -110,6 +68,16 @@
(open scheme)
(files scsh-version))
(define-structure partial-s48-ports
(export current-input-port current-output-port
newline
error-output-port
$current-input-port
$current-output-port
$error-output-port)
(open ports))
;;; The scsh-level-0 package is for implementation convenience.
;;; The scsh startup and top-level modules need access to scsh
;;; procedures, but they export procedures that are themselves
@ -118,7 +86,8 @@
;;; export the whole scsh enchilada.
(define-structures
((scsh-level-0-internals (export set-command-line-args!
((scsh-regexp-package scsh-regexp-interface)
(scsh-level-0-internals (export set-command-line-args!
init-scsh-hindbrain
init-scsh-vars))
(scsh-level-0
@ -166,7 +135,8 @@
ascii
records
extended-ports
ports
partial-s48-ports
; ports
build
bigbit
bitwise
@ -177,8 +147,8 @@
fluids
weak
scsh-regexp-package
scsh-regexp-internals
; scsh-regexp-package
; scsh-regexp-internals
char-set-package
scsh-version
tty-flags
@ -216,7 +186,6 @@
fileinfo
glob
filemtch
rdelim
time ; New in release 0.2.
(machine time_dep)
network ; New in release 0.3.
@ -226,6 +195,8 @@
pty ; New in release 0.4.
sighandlers ; New in release 0.5.
scsh
re
rdelim
))
(define-structure defrec-package (export (define-record :syntax))
@ -278,9 +249,42 @@
(files top meta-arg))
(define-structure field-reader-package scsh-field-reader-interface
(open receiving ; receive
char-set-package
scsh-utilities
error-package ; error
scsh-level-0 ; delimited readers
scsh-regexp-package
let-opt ; optional-arg parsing & defaulting
scheme
)
(files fr))
(define-structures
((awk-expander-package (export expand-awk))
(awk-support-package (export next-range next-:range
next-range: next-:range:)))
(open receiving ; receive
scsh-utilities
error-package ; error
scsh-regexp-package
scheme
)
(files awk))
(define-structure awk-package awk-interface
(open awk-support-package scsh-regexp-package receiving scheme)
(for-syntax (open awk-expander-package scheme))
(begin (define-syntax awk expand-awk)))
(define-structure scsh
(compound-interface (interface-of scsh-level-0)
(interface-of scsh-startup-package)
scsh-regexp-interface
scsh-field-reader-interface ; new in 0.3
; scsh-dbm-interface
(export repl)
@ -289,6 +293,7 @@
(open structure-refs
scsh-level-0
scsh-level-0-internals
scsh-regexp-package
scsh-startup-package
; dbm
awk-package
@ -305,3 +310,10 @@
features ; make-immutable!
scheme)
(files here))
(define-structure test-package (export test-proc)
(open scsh-regexp-package scheme)
(begin (define (test-proc p)
(regexp-substitute p
(string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux")
'post 3 1 2 'pre))))

View File

@ -548,6 +548,27 @@
(substring buf 0 nread)))) ; last one.
(lp))))))))
(define (y-or-n? question . maybe-eof-value)
(let loop ((count *y-or-n-eof-count*))
(display question)
(display " (y/n)? ")
(let ((line (read-line)))
(cond ((eof-object? line)
(newline)
(if (= count 0)
(:optional maybe-eof-value (error "EOF in y-or-n?"))
(begin (display "I'll only ask another ")
(write count)
(display " times.")
(newline)
(loop (- count 1)))))
((< (string-length line) 1) (loop count))
((char=? (string-ref line 0) #\y) #t)
((char=? (string-ref line 0) #\n) #f)
(else (loop count))))))
(define *y-or-n-eof-count* 100)
;;; Stdio/stdport sync procedures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -856,6 +856,21 @@ scheme_value df_scm_sort_filevec(long nargs, scheme_value *args)
return SCHFALSE;
}
scheme_value df_filter_stringvec(long nargs, scheme_value *args)
{
extern char *filter_stringvec(const char *, char const ** , int *);
scheme_value ret1;
char *r1;
int r2;
cig_check_nargs(3, nargs, "filter_stringvec");
r1 = filter_stringvec(cig_string_body(args[2]), (char const ** )AlienVal(args[1]), &r2);
ret1 = VECTOR_REF(*args,0);
{AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);}
VECTOR_REF(*args,1) = ENTER_FIXNUM(r2);
return ret1;
}
scheme_value df_scm_envvec(long nargs, scheme_value *args)
{
extern char** scm_envvec(int *);

View File

@ -848,6 +848,15 @@
(filter (lambda (f) (not (char=? (string-ref f 0) #\.)))
files))))))
;;; I do this one in C, I'm not sure why:
;;; It is used by MATCH-FILES.
(define-foreign %filter-C-strings!
(filter_stringvec (string pattern) ((C "char const ** ~a") cvec))
static-string ; error message -- #f if no error.
integer) ; number of files that pass the filter.
(define (match-files regexp . maybe-dir)
(let ((dir (:optional maybe-dir ".")))
(check-arg string? dir match-files)