diff --git a/beautiful-racket-demo/basic-demo-3/expander.rkt b/beautiful-racket-demo/basic-demo-3/expander.rkt index a8e61b1..c0440d9 100644 --- a/beautiful-racket-demo/basic-demo-3/expander.rkt +++ b/beautiful-racket-demo/basic-demo-3/expander.rkt @@ -12,8 +12,10 @@ (find-property 'b-import-name #'(LINE ...))] [(EXPORT-NAME ...) (find-property 'b-export-name #'(LINE ...))] - [((SHELL-ID SHELL-VAL) ...) - (make-shell-ids-and-values caller-stx)] + [((SHELL-ID SHELL-IDX) ...) + (for/list ([idx (in-range 10)]) + (list (suffix-id #'arg idx #:context caller-stx) + idx))] [(UNIQUE-ID ...) (unique-ids (syntax->list #'(VAR-ID ... SHELL-ID ...)))]) @@ -24,7 +26,8 @@ (require IMPORT-NAME) ... (provide EXPORT-NAME ...) (define UNIQUE-ID 0) ... - (set! SHELL-ID SHELL-VAL) ... + (let ([clargs (current-command-line-arguments)]) + (set! SHELL-ID (get-clarg clargs SHELL-IDX)) ...) LINE ... (define line-table (apply hasheqv (append (list NUM LINE-FUNC) ...))) @@ -32,6 +35,11 @@ ([current-output-port (basic-output-port)]) (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 (require racket/list) @@ -42,13 +50,5 @@ (unique-ids (for/list ([stx (in-list (stx-flatten line-stxs))] #:when (syntax-property stx which)) - 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))))) + stx))))