move clargs into runtime

pull/10/head
Matthew Butterick 8 years ago
parent 59a63f71dc
commit f7eedcef6f

@ -12,8 +12,10 @@
(find-property 'b-import-name #'(LINE ...))] (find-property 'b-import-name #'(LINE ...))]
[(EXPORT-NAME ...) [(EXPORT-NAME ...)
(find-property 'b-export-name #'(LINE ...))] (find-property 'b-export-name #'(LINE ...))]
[((SHELL-ID SHELL-VAL) ...) [((SHELL-ID SHELL-IDX) ...)
(make-shell-ids-and-values caller-stx)] (for/list ([idx (in-range 10)])
(list (suffix-id #'arg idx #:context caller-stx)
idx))]
[(UNIQUE-ID ...) [(UNIQUE-ID ...)
(unique-ids (unique-ids
(syntax->list #'(VAR-ID ... SHELL-ID ...)))]) (syntax->list #'(VAR-ID ... SHELL-ID ...)))])
@ -24,7 +26,8 @@
(require IMPORT-NAME) ... (require IMPORT-NAME) ...
(provide EXPORT-NAME ...) (provide EXPORT-NAME ...)
(define UNIQUE-ID 0) ... (define UNIQUE-ID 0) ...
(set! SHELL-ID SHELL-VAL) ... (let ([clargs (current-command-line-arguments)])
(set! SHELL-ID (get-clarg clargs SHELL-IDX)) ...)
LINE ... LINE ...
(define line-table (define line-table
(apply hasheqv (append (list NUM LINE-FUNC) ...))) (apply hasheqv (append (list NUM LINE-FUNC) ...)))
@ -32,6 +35,11 @@
([current-output-port (basic-output-port)]) ([current-output-port (basic-output-port)])
(void (run line-table)))))) (void (run line-table))))))
(define (get-clarg clargs idx)
(with-handlers ([exn:fail? (λ (exn) 0)])
(let ([val (vector-ref clargs idx)])
(or (string->number val) val))))
(begin-for-syntax (begin-for-syntax
(require racket/list) (require racket/list)
@ -42,13 +50,5 @@
(unique-ids (unique-ids
(for/list ([stx (in-list (stx-flatten line-stxs))] (for/list ([stx (in-list (stx-flatten line-stxs))]
#:when (syntax-property stx which)) #:when (syntax-property stx which))
stx))) stx))))
(define (make-shell-ids-and-values ctxt)
(for/list ([idx (in-naturals)]
[val (current-command-line-arguments)])
(with-pattern
([SHELL-ID (suffix-id #'arg idx #:context ctxt)]
[SHELL-VALUE (or (string->number val) val)])
#'(SHELL-ID SHELL-VALUE)))))

Loading…
Cancel
Save