brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Use number of procedure arguments function from util-proc in command-line.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-10 20:16:21 +02:00
parent 147afa3ab4
commit c2c19c2d6a
4 changed files with 16 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/Makefile
View file

@ -91,7 +91,7 @@ listing.o: listing.import.scm
listing.import.scm: $(LISTING-SOURCES) listing.import.scm: $(LISTING-SOURCES)
UTIL-DICT-LIST-SOURCES=util-dict-list.scm testing.import.scm \ UTIL-DICT-LIST-SOURCES=util-dict-list.scm testing.import.scm \
util-tag.import.scm util-tag.import.scm util-proc.import.scm
util-dict-list.o: util-dict-list.import.scm util-dict-list.o: util-dict-list.import.scm
util-dict-list.import.scm: $(UTIL-DICT-LIST-SOURCES) util-dict-list.import.scm: $(UTIL-DICT-LIST-SOURCES)
@ -113,7 +113,7 @@ ansi.o: ansi.import.scm
ansi.import.scm: $(ANSI-SOURCES) ansi.import.scm: $(ANSI-SOURCES)
COMMAND-LINE-SOURCES=command-line.scm testing.import.scm \ COMMAND-LINE-SOURCES=command-line.scm testing.import.scm \
util-list.import.scm util-list.import.scm util-proc.import.scm
command-line.o: command-line.import.scm command-line.o: command-line.import.scm
command-line.import.scm: $(COMMAND-LINE-SOURCES) command-line.import.scm: $(COMMAND-LINE-SOURCES)

6
src/command-line.scm
View file

@ -39,7 +39,8 @@
(chicken process-context) (chicken process-context)
(chicken format) (chicken format)
util-list util-list
testing) testing
util-proc)
;; Consumes given number of arguments from the list and returns the ;; Consumes given number of arguments from the list and returns the
;; remainder of the list and a list of arguments consumed. ;; remainder of the list and a list of arguments consumed.
@ -74,8 +75,7 @@
(when (not specp) (when (not specp)
(error 'parse-command-line "Unknown argument" arg)) (error 'parse-command-line "Unknown argument" arg))
(let* ((proc (caddr specp)) (let* ((proc (caddr specp))
(info (procedure-information proc)) (nargs (procedure-num-args proc))
(nargs (- (length info) 1))
(aargsl (consume-args (cdr args) nargs)) (aargsl (consume-args (cdr args) nargs))
(args (car aargsl)) (args (car aargsl))
(aargs (cadr aargsl))) (aargs (cadr aargsl)))

8
src/util-dict-list.scm
View file

@ -54,7 +54,8 @@
(import scheme (import scheme
(chicken base) (chicken base)
testing testing
util-tag) util-tag
util-proc)
;; Tag used for identifying list dictionaries from this module ;; Tag used for identifying list dictionaries from this module
(define TAG-LDICT (make-tag LDICT)) (define TAG-LDICT (make-tag LDICT))
@ -162,9 +163,8 @@
;; accepts more than one argument. If it accepts a third argument, ;; accepts more than one argument. If it accepts a third argument,
;; index gets passed as well. ;; index gets passed as well.
(define (ldict-map proc ld) (define (ldict-map proc ld)
(let* ((lpi (length (procedure-information proc))) (let ((both? ((procedure-arity>=? 2) proc))
(both? (> lpi 2)) (index? ((procedure-arity>=? 3) proc)))
(index? (> lpi 3)))
(let loop ((pairs (ldict-pairs ld)) (let loop ((pairs (ldict-pairs ld))
(res '()) (res '())
(i 0)) (i 0))

7
src/util-proc.scm
View file

@ -31,6 +31,8 @@
procedure-arity=? procedure-arity=?
procedure-arity>=? procedure-arity>=?
procedure-arity>? procedure-arity>?
procedure-num-args
) )
(import scheme (import scheme
@ -72,4 +74,9 @@
(or rest? (or rest?
(> args n)))) (> args n))))
;; Returns the number of mandatory arguments
(define (procedure-num-args proc)
(let-values (((args rest?) (procedure-arity-info proc)))
args))
) )