Thank you for your comment

Beau­tiful Racket / tuto­rials

basic/args.rkt
#lang br
(current-command-line-arguments)
copy to clipboard
basic/report-args.rkt
#lang basic-demo-3
10 print "arg0 is " ; arg0
20 print "arg1 + arg1 is " ; arg1 + arg1
40 print "arg3 is " ; arg3
50 print "arg4 is " ; arg4
1
2
3
4
5
#lang basic-demo-3
10 print "arg0 is " ; arg0
20 print "arg1 + arg1 is " ; arg1 + arg1
40 print "arg3 is " ; arg3
50 print "arg4 is " ; arg4
copy to clipboard
  1. (define-macro (define-three-vars ID1 ID2 ID3)
      #'(begin
          (define ID1 1)
          (define ID2 2)
          (define ID3 3)))
    (define-three-vars a b c)
    (+ a b c) ; 6
    1
    2
    3
    4
    5
    6
    7
    (define-macro (define-three-vars ID1 ID2 ID3)
      #'(begin
          (define ID1 1)
          (define ID2 2)
          (define ID3 3)))
    (define-three-vars a b c)
    (+ a b c) ; 6
    
    copy to clipboard
  2. (define-macro (define-three-vars)
      (with-pattern ([ID1 (datum->syntax caller-stx 'a)]
                     [ID2 (datum->syntax caller-stx 'b)]
                     [ID3 (datum->syntax caller-stx 'c)])
        #'(begin
            (define ID1 1)
            (define ID2 2)
            (define ID3 3))))
    (define-three-vars)
    (+ a b c) ; 6
     1
     2
     3
     4
     5
     6
     7
     8
     9
    10
    (define-macro (define-three-vars)
      (with-pattern ([ID1 (datum->syntax caller-stx 'a)]
                     [ID2 (datum->syntax caller-stx 'b)]
                     [ID3 (datum->syntax caller-stx 'c)])
        #'(begin
            (define ID1 1)
            (define ID2 2)
            (define ID3 3))))
    (define-three-vars)
    (+ a b c) ; 6
    
    copy to clipboard
basic/expander.rkt
#lang br/quicklang
(require "struct.rkt" "run.rkt" "elements.rkt" "setup.rkt")
(provide (rename-out [b-module-begin #%module-begin])
         (all-from-out "elements.rkt"))

(define-macro (b-module-begin (b-program LINE ...))
  (with-pattern
      ([((b-line NUM STMT ...) ...) #'(LINE ...)]
       [(LINE-FUNC ...) (prefix-id "line-" #'(NUM ...))]
       [(VAR-ID ...) (find-property 'b-id #'(LINE ...))]
       [(IMPORT-NAME ...)
        (find-property 'b-import-name #'(LINE ...))]
       [(EXPORT-NAME ...)
        (find-property 'b-export-name #'(LINE ...))]
       [((SHELL-ID SHELL-IDX) ...)
        (make-shell-ids-and-idxs caller-stx)]
       [(UNIQUE-ID ...)
        (unique-ids
         (syntax->list #'(VAR-ID ... SHELL-ID ...)))])
    #'(#%module-begin
       (module configure-runtime br
         (require basic/setup)
         (do-setup!))
       (require IMPORT-NAME) ...
       (provide EXPORT-NAME ...)
       (define UNIQUE-ID 0) ...
       (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) ...)))
       (parameterize
           ([current-output-port (basic-output-port)])
         (void (run line-table))))))

(define (get-clarg clargs idx)
  (if (<= (vector-length clargs) idx)
      0
      (let ([val (vector-ref clargs idx)])
        (or (string->number val) val))))

(begin-for-syntax
  (require racket/list)
  
  (define (unique-ids stxs)
    (remove-duplicates stxs #:key syntax->datum))

  (define (find-property which line-stxs)
    (unique-ids
     (for/list ([stx (in-list (stx-flatten line-stxs))]
                #:when (syntax-property stx which))
       stx)))

  (define (make-shell-ids-and-idxs ctxt)
    (define arg-count 10)
    (for/list ([idx (in-range arg-count)])
      (list (suffix-id #'arg idx #:context ctxt) idx))))
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
#lang br/quicklang
(require "struct.rkt" "run.rkt" "elements.rkt" "setup.rkt")
(provide (rename-out [b-module-begin #%module-begin])
         (all-from-out "elements.rkt"))

(define-macro (b-module-begin (b-program LINE ...))
  (with-pattern
      ([((b-line NUM STMT ...) ...) #'(LINE ...)]
       [(LINE-FUNC ...) (prefix-id "line-" #'(NUM ...))]
       [(VAR-ID ...) (find-property 'b-id #'(LINE ...))]
       [(IMPORT-NAME ...)
        (find-property 'b-import-name #'(LINE ...))]
       [(EXPORT-NAME ...)
        (find-property 'b-export-name #'(LINE ...))]
       [((SHELL-ID SHELL-IDX) ...)
        (make-shell-ids-and-idxs caller-stx)] 
       [(UNIQUE-ID ...)
        (unique-ids
         (syntax->list #'(VAR-ID ... SHELL-ID ...)))])
    #'(#%module-begin
       (module configure-runtime br
         (require basic/setup)
         (do-setup!))
       (require IMPORT-NAME) ...
       (provide EXPORT-NAME ...)
       (define UNIQUE-ID 0) ...
       (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) ...)))
       (parameterize
           ([current-output-port (basic-output-port)])
         (void (run line-table))))))

(define (get-clarg clargs idx)
  (if (<= (vector-length clargs) idx)
      0
      (let ([val (vector-ref clargs idx)])
        (or (string->number val) val))))

(begin-for-syntax
  (require racket/list)
  
  (define (unique-ids stxs)
    (remove-duplicates stxs #:key syntax->datum))

  (define (find-property which line-stxs)
    (unique-ids
     (for/list ([stx (in-list (stx-flatten line-stxs))]
                #:when (syntax-property stx which))
       stx)))

  (define (make-shell-ids-and-idxs ctxt)
    (define arg-count 10)
    (for/list ([idx (in-range arg-count)])
      (list (suffix-id #'arg idx #:context ctxt) idx))))
copy to clipboard
basic/report-args.rkt
#lang basic
10 print "arg0 is " ; arg0
20 print "arg1 + arg1 is " ; arg1 + arg1
40 print "arg3 is " ; arg3
50 print "arg4 is " ; arg4
1
2
3
4
5
#lang basic
10 print "arg0 is " ; arg0
20 print "arg1 + arg1 is " ; arg1 + arg1
40 print "arg3 is " ; arg3
50 print "arg4 is " ; arg4
copy to clipboard
← prev next →