Thank you for your comment

Beau­tiful Racket / tuto­rials

Into the rapids: more basic

Spec­i­fi­ca­tion

Here’s what we’ll add to our BASIC imple­men­ta­tion in this tuto­rial:

Setup

We’ll start with the code we made during the first basic tuto­rial. We’ll also assume that we’ve created a basic direc­tory and installed it as a package as described in the previous spec­i­fi­ca­tion and setup.

But before we hit the road, let’s reor­ga­nize the project to be more modular.

Down­load basic-2-tuto­rial-setup.zip

Our lexer, tokenizer, parser, and main module (containing our reader) will remain the same:

basic/lexer.rkt
#lang br
(require brag/support)

(define-lex-abbrev digits (:+ (char-set "0123456789")))

(define basic-lexer
  (lexer-srcloc
   ["\n" (token 'NEWLINE lexeme)]
   [whitespace (token lexeme #:skip? #t)]
   [(from/stop-before "rem" "\n") (token 'REM lexeme)]
   [(:or "print" "goto" "end"
         "+" ":" ";") (token lexeme lexeme)]
   [digits (token 'INTEGER (string->number lexeme))]
   [(:or (:seq (:? digits) "." digits)
         (:seq digits "."))
    (token 'DECIMAL (string->number lexeme))]
   [(:or (from/to "\"" "\"") (from/to "'" "'"))
    (token 'STRING
           (substring lexeme
                      1 (sub1 (string-length lexeme))))]))

(provide basic-lexer) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
#lang br
(require brag/support)

(define-lex-abbrev digits (:+ (char-set "0123456789")))

(define basic-lexer
  (lexer-srcloc
   ["\n" (token 'NEWLINE lexeme)]
   [whitespace (token lexeme #:skip? #t)]
   [(from/stop-before "rem" "\n") (token 'REM lexeme)]
   [(:or "print" "goto" "end"
         "+" ":" ";") (token lexeme lexeme)]
   [digits (token 'INTEGER (string->number lexeme))]
   [(:or (:seq (:? digits) "." digits)
         (:seq digits "."))
    (token 'DECIMAL (string->number lexeme))]
   [(:or (from/to "\"" "\"") (from/to "'" "'"))
    (token 'STRING
           (substring lexeme
                      1 (sub1 (string-length lexeme))))]))

(provide basic-lexer)
copy to clipboard
basic/tokenizer.rkt
#lang br
(require "lexer.rkt" brag/support)

(define (make-tokenizer ip [path #f])
  (port-count-lines! ip)
  (lexer-file-path path)
  (define (next-token) (basic-lexer ip))
  next-token)

(provide make-tokenizer)
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
#lang br
(require "lexer.rkt" brag/support)

(define (make-tokenizer ip [path #f])
  (port-count-lines! ip)
  (lexer-file-path path)
  (define (next-token) (basic-lexer ip))
  next-token)

(provide make-tokenizer)
copy to clipboard
basic/parser.rkt
#lang brag
b-program : [b-line] (/NEWLINE [b-line])*
b-line : b-line-num [b-statement] (/":" [b-statement])* [b-rem]
@b-line-num : INTEGER
@b-statement : b-end | b-print | b-goto
b-rem : REM
b-end : /"end"
b-print : /"print" [b-printable] (/";" [b-printable])*
@b-printable : STRING | b-expr
b-goto : /"goto" b-expr
b-expr : b-sum
b-sum : b-number (/"+" b-number)*
@b-number : INTEGER | DECIMAL
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
#lang brag
b-program : [b-line] (/NEWLINE [b-line])*
b-line : b-line-num [b-statement] (/":" [b-statement])* [b-rem]
@b-line-num : INTEGER
@b-statement : b-end | b-print | b-goto
b-rem : REM
b-end : /"end"
b-print : /"print" [b-printable] (/";" [b-printable])*
@b-printable : STRING | b-expr
b-goto : /"goto" b-expr
b-expr : b-sum
b-sum : b-number (/"+" b-number)*
@b-number : INTEGER | DECIMAL
copy to clipboard
basic/main.rkt
#lang br/quicklang
(require "parser.rkt" "tokenizer.rkt")

(module+ reader
  (provide read-syntax))

(define (read-syntax path port)
  (define parse-tree (parse path (make-tokenizer port path)))
  (strip-bindings
   #`(module basic-mod basic/expander
       #,parse-tree))) 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
#lang br/quicklang
(require "parser.rkt" "tokenizer.rkt")

(module+ reader
  (provide read-syntax))

(define (read-syntax path port)
  (define parse-tree (parse path (make-tokenizer port path)))
  (strip-bindings
   #`(module basic-mod basic/expander
       #,parse-tree)))
copy to clipboard

We’ll trim down our expander module to contain only our #%module-begin macro. Our supporting struc­ture types will be moved into a new "struct.rkt" module. Our run func­tion will go into "run.rkt". Every­thing else—i.e., the func­tions and macros that imple­ment the language constructs—will be moved into a new "elements.rkt" module. We use all-from-out to re-export every­thing that gets imported from this module:

basic/expander.rkt
#lang br/quicklang
(require "struct.rkt" "run.rkt" "elements.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 ...))])
    #'(#%module-begin
       LINE ...
       (define line-table
         (apply hasheqv (append (list NUM LINE-FUNC) ...)))
       (void (run line-table)))))

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
#lang br/quicklang
(require "struct.rkt" "run.rkt" "elements.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 ...))])
    #'(#%module-begin
       LINE ...
       (define line-table
         (apply hasheqv (append (list NUM LINE-FUNC) ...)))
       (void (run line-table)))))
copy to clipboard

Here’s the new "struct.rkt" module. We use struct-out to auto­mat­i­cally include the supporting func­tions that are silently gener­ated when we define a new struc­ture type with struct:

basic/struct.rkt
#lang br
(provide (struct-out end-program-signal)
         (struct-out change-line-signal))

(struct end-program-signal ())
(struct change-line-signal (val))
1
2
3
4
5
6
#lang br
(provide (struct-out end-program-signal)
         (struct-out change-line-signal))

(struct end-program-signal ())
(struct change-line-signal (val))
copy to clipboard

The new "run.rkt", which relies on both "struct.rkt" and "line.rkt" (described below):

basic/run.rkt
#lang br
(require "line.rkt" "struct.rkt")
(provide run)

(define (run line-table)
  (define line-vec
    (list->vector (sort (hash-keys line-table) <)))
  (with-handlers ([end-program-signal? (λ (exn-val) (void))])
    (for/fold ([line-idx 0])
              ([i (in-naturals)]
               #:break (>= line-idx (vector-length line-vec)))
      (define line-num (vector-ref line-vec line-idx))
      (define line-func (hash-ref line-table line-num))
      (with-handlers
          ([change-line-signal?
            (λ (cls)
              (define clsv (change-line-signal-val cls))
              (or
               (and (exact-positive-integer? clsv)
                    (vector-member clsv line-vec))
               (error (format "error in line ~a: line ~a not found"
                              line-num clsv))))])
        (line-func)
        (add1 line-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
#lang br
(require "line.rkt" "struct.rkt")
(provide run)

(define (run line-table)
  (define line-vec
    (list->vector (sort (hash-keys line-table) <)))
  (with-handlers ([end-program-signal? (λ (exn-val) (void))])
    (for/fold ([line-idx 0])
              ([i (in-naturals)]
               #:break (>= line-idx (vector-length line-vec)))
      (define line-num (vector-ref line-vec line-idx))
      (define line-func (hash-ref line-table line-num))
      (with-handlers
          ([change-line-signal?
            (λ (cls)
              (define clsv (change-line-signal-val cls))
              (or
               (and (exact-positive-integer? clsv)
                    (vector-member clsv line-vec))
               (error (format "error in line ~a: line ~a not found"
                              line-num clsv))))])
        (line-func)
        (add1 line-idx)))))
copy to clipboard

Our new "elements.rkt" module will bring together a number of other supporting modules. Again, we use all-from-out to re-export the imported bind­ings, thus there are no defi­n­i­tions in the body of this module:

basic/elements.rkt
#lang br
(require "line.rkt" "go.rkt"
         "expr.rkt" "misc.rkt")
(provide
 (all-from-out "line.rkt" "go.rkt"
               "expr.rkt" "misc.rkt"))
1
2
3
4
5
6
#lang br
(require "line.rkt" "go.rkt"
         "expr.rkt" "misc.rkt")
(provide
 (all-from-out "line.rkt" "go.rkt"
               "expr.rkt" "misc.rkt"))
copy to clipboard

Then we need to make the four modules that are imported by "elements.rkt".

First we have "line.rkt", which provides b-line:

basic/line.rkt
#lang br
(require "struct.rkt")
(provide b-line)

(define-macro (b-line NUM STATEMENT ...)
  (with-pattern ([LINE-NUM (prefix-id "line-" #'NUM
                                      #:source #'NUM)])
    (syntax/loc caller-stx
      (define (LINE-NUM) (void) STATEMENT ...))))
1
2
3
4
5
6
7
8
9
#lang br
(require "struct.rkt")
(provide b-line)

(define-macro (b-line NUM STATEMENT ...)
  (with-pattern ([LINE-NUM (prefix-id "line-" #'NUM
                                      #:source #'NUM)])
    (syntax/loc caller-stx
      (define (LINE-NUM) (void) STATEMENT ...))))
copy to clipboard

Then "go.rkt", which provides b-end and b-goto:

basic/go.rkt
#lang br
(require "struct.rkt" "line.rkt")
(provide b-end b-goto)

(define (b-end) (raise (end-program-signal)))

(define (b-goto num-expr)
  (raise (change-line-signal num-expr)))
1
2
3
4
5
6
7
8
#lang br
(require "struct.rkt" "line.rkt")
(provide b-end b-goto)

(define (b-end) (raise (end-program-signal)))

(define (b-goto num-expr)
  (raise (change-line-signal num-expr)))
copy to clipboard

Then "expr.rkt", which provides b-sum and b-expr:

basic/expr.rkt
#lang br
(provide b-sum b-expr)

(define (b-sum . vals) (apply + vals))

(define (b-expr expr)
  (if (integer? expr) (inexact->exact expr) expr))
1
2
3
4
5
6
7
#lang br
(provide b-sum b-expr)

(define (b-sum . vals) (apply + vals))

(define (b-expr expr)
  (if (integer? expr) (inexact->exact expr) expr))
copy to clipboard

And finally "misc.rkt", which holds every­thing else, which for now is b-rem and b-print:

basic/misc.rkt
#lang br
(require "struct.rkt")
(provide b-rem b-print)

(define (b-rem val) (void))

(define (b-print . vals)
  (displayln (string-append* (map ~a vals))))
1
2
3
4
5
6
7
8
#lang br
(require "struct.rkt")
(provide b-rem b-print)

(define (b-rem val) (void))

(define (b-print . vals)
  (displayln (string-append* (map ~a vals))))
copy to clipboard

So all the code is the same. We’ve just divided it into smaller modules.

We can test that we’ve set up every­thing correctly by running our sample program from last time:

basic/sample.rkt
#lang basic
30 rem print 'ignored'
35
50 print "never gets here"
40 end
60 print 'three' : print 1.0 + 3
70 goto 11. + 18.5 + .5 rem ignored
10 print "o" ; "n" ; "e"
20 print : goto 60.0 : end
1
2
3
4
5
6
7
8
9
#lang basic
30 rem print 'ignored'
35
50 print "never gets here"
40 end
60 print 'three' : print 1.0 + 3
70 goto 11. + 18.5 + .5 rem ignored
10 print "o" ; "n" ; "e"
20 print : goto 60.0 : end
copy to clipboard

The result should be the same as before:

one

three
4
1
2
3
4
one

three
4
copy to clipboard

If so, we’re ready to move on.

← prev next →