diff --git a/scsh/re.c b/scsh/re.c index 7f297c3..6c26881 100644 --- a/scsh/re.c +++ b/scsh/re.c @@ -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; - } - diff --git a/scsh/re.scm b/scsh/re.scm index 9fdcee6..647800e 100644 --- a/scsh/re.scm +++ b/scsh/re.scm @@ -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. diff --git a/scsh/re1.h b/scsh/re1.h index 983cc2e..5249ba6 100644 --- a/scsh/re1.h +++ b/scsh/re1.h @@ -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); diff --git a/scsh/rw.scm b/scsh/rw.scm index d030280..2e17712 100644 --- a/scsh/rw.scm +++ b/scsh/rw.scm @@ -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) diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm index 3f06b7f..ec7cbae 100644 --- a/scsh/scsh-interfaces.scm +++ b/scsh/scsh-interfaces.scm @@ -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 diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm index 58de67b..1e13b2d 100644 --- a/scsh/scsh-package.scm +++ b/scsh/scsh-package.scm @@ -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)))) diff --git a/scsh/scsh.scm b/scsh/scsh.scm index 3d9039e..d92257f 100644 --- a/scsh/scsh.scm +++ b/scsh/scsh.scm @@ -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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/scsh/syscalls.c b/scsh/syscalls.c index 4dfd222..285b115 100644 --- a/scsh/syscalls.c +++ b/scsh/syscalls.c @@ -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 *); diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index cd852cb..af3ac25 100644 --- a/scsh/syscalls.scm +++ b/scsh/syscalls.scm @@ -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)