├── .gitignore
├── README.md
├── basic-demo-syntax.rkt
├── basic-reader.rkt
└── basic.rkt


/.gitignore:
--------------------------------------------------------------------------------
1 | **/compiled
2 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # Code for rC3 talk "All Programming Language Suck?  Just Build Your Own!"
 2 | 
 3 | To try this out:
 4 | 
 5 | - download [Racket](https://www.racket-lang.org)
 6 | - open the file `basic-demo-syntax.rkt` in the DrRacket
 7 | - in DrRacket click on the Run-Button or hit the F5 key
 8 | - type-in `(line-10)` and press the Enter key
 9 | 
10 | Enjoy!
11 | 
12 | Let me know if you have questions or comments.
13 | 
14 | ## License
15 | 
16 | Distributed under the Eclipse Public License either version 1.0 or (at
17 | your option) any later version.
18 | 


--------------------------------------------------------------------------------
/basic-demo-syntax.rkt:
--------------------------------------------------------------------------------
1 | #lang reader "basic-reader.rkt"
2 | 10 A = 1
3 | 20 PRINT A
4 | 30 A = A + 1
5 | 40 IF A < 100 THEN GOTO 20 ELSE PRINT "DONE"
6 | 


--------------------------------------------------------------------------------
/basic-reader.rkt:
--------------------------------------------------------------------------------
  1 | #lang racket
  2 | (provide (rename-out (basic-read-syntax read-syntax)))
  3 | (require syntax/readerr)
  4 | 
  5 | (define (basic-read-syntax src in)
  6 |   (datum->syntax
  7 |    #f
  8 |    `(module basic racket
  9 |       (require "basic.rkt")
 10 |       (basic
 11 |        ,@(parse-program src in)))))
 12 | 
 13 | (define (parse-program src in)
 14 |   (define line (parse-line src in))
 15 |   (if (eof-object? line)
 16 |       '()
 17 |       (cons line (parse-program src in))))
 18 | 
 19 | (define (parse-line src in)
 20 |   (regexp-try-match #px"^\\s+" in)
 21 |   (if (eof-object? (peek-char in))
 22 |       eof
 23 |       (let ()
 24 |         (define line-number (get-line-number src in))
 25 |         (define command (parse-command src in))
 26 |         `(,line-number ,command))))
 27 | 
 28 | (define (next-token src in (peek? #f))
 29 |   (skip-whitespace in)
 30 |   (define match (if peek? regexp-match-peek regexp-try-match))
 31 |   (cond
 32 |     ((match #rx"^(PRINT|GOTO|GOSUB|RETURN|IF|THEN|ELSE|\\*|\\+|-|/|=|<=|>=|<|>)" in)
 33 |      => (lambda (match)
 34 |           (string->symbol (bytes->string/utf-8 (car match)))))
 35 |     ((match #rx"^\\(" in)
 36 |      'open-paren)
 37 |     ((match #rx"^\\)" in)
 38 |      'closed-paren)
 39 |     ((match #rx"^," in)
 40 |      'comma)
 41 |     ((match #rx"^[0-9]+" in)
 42 |      => (lambda (match)
 43 |           (string->number (bytes->string/utf-8 (car match)))))     
 44 |     ((match #rx"^[a-zA-Z]+$?" in)
 45 |      => (lambda (match)
 46 |           (string->symbol (bytes->string/utf-8 (car match)))))
 47 |     ((match #rx"\"([^\"]+)\"" in)
 48 |      => (lambda (match)
 49 |           (bytes->string/utf-8 (cadr match))))
 50 |     ((eof-object? (peek-char in))
 51 |      eof)
 52 |     ((equal? #\newline (peek-char in))
 53 |      (read-char in)
 54 |      eof)
 55 |     ((match "^$" in)
 56 |      eof)
 57 |     (else
 58 |      (complain src in "unknown lexeme"))))
 59 | 
 60 | (define (tokenize src in)
 61 |   (define token (next-token src in))
 62 |   (if (eof-object? token)
 63 |       '()
 64 |       (cons token (tokenize src in))))
 65 | 
 66 | (define (get-line-number src in)
 67 |   (regexp-try-match #px"^\\s+" in)
 68 |   (cond
 69 |     ((regexp-try-match #rx"^[0-9]+" in)
 70 |      => (lambda (match)
 71 |           (string->number (bytes->string/utf-8 (car match)))))
 72 |     (else
 73 |      (complain src in "no line number"))))
 74 | 
 75 | (define (complain src in msg)
 76 |   (define-values (line col pos) (port-next-location in))
 77 |   (raise-read-error msg src line col pos 1))
 78 | 
 79 | (define (parse-command src in)
 80 |   (define first-token (next-token src in))
 81 |   (when (eof-object? first-token)
 82 |     (error "no command after line number"))
 83 |   (cond
 84 |     ((eq? 'PRINT first-token)
 85 |      `(print ,@(parse-arguments src in)))
 86 |     ((eq? 'GOTO first-token) `(goto ,(get-line-number src in)))
 87 |     ((eq? 'GOSUB first-token) `(gosub ,(get-line-number src in)))
 88 |     ((eq? 'RETURN first-token) '(return))
 89 |     ((eq? 'IF first-token)
 90 |      (define test (parse-expr src in))
 91 |      (unless (eq? 'THEN (next-token src in))
 92 |        (complain src in "missing THEN in IF"))
 93 |      (define then (parse-command src in))
 94 |      (unless (eq? 'ELSE (next-token src in))
 95 |        (complain src in "missing ELSE in IF"))
 96 |      (define else (parse-command src in))
 97 |      `(if ,test ,then ,else))
 98 |     ((symbol? first-token)
 99 |      (unless (eq? '= (next-token src in))
100 |        (complain src in "incomplete assignment"))
101 |      (define expr (parse-expr src in))
102 |      `(:= ,first-token ,expr))))
103 | 
104 | (define (parse-arguments src in)
105 |   (define first (parse-expr src in))
106 |   (if (eq? 'comma (next-token src in 'peek))
107 |       (begin
108 |         (next-token src in)
109 |         (cons first (parse-arguments src in)))
110 |       (list first)))
111 | 
112 | (define (skip-whitespace in)
113 |   (regexp-try-match #px"^[ \t]+" in))
114 | 
115 | (define (parse-expr src in)
116 |   (define left (parse-expr-1 src in))
117 |   (define next (next-token src in 'peek))
118 |   (cond
119 |     ((eof-object? next) left)
120 |     ((memq next '(= < > <= >=))
121 |      (next-token src in)
122 |      (define right (parse-expr src in))
123 |      `(,next ,left ,right))
124 |     (else
125 |      left)))
126 | 
127 | (define (parse-expr-1 src in)
128 |   (define left (parse-expr-2 src in))
129 |   (define next (next-token src in 'peek))
130 |   (cond
131 |     ((eof-object? next) left)
132 |     ((memq next '(+ -))
133 |      (next-token src in)
134 |      (define right (parse-expr-1 src in))
135 |      `(,next ,left ,right))
136 |     (else
137 |      left)))
138 | 
139 | (define (parse-expr-2 src in)
140 |   (define left (parse-expr-3 src in))
141 |   (define next (next-token src in 'peek))
142 |   (cond
143 |     ((eof-object? next) left)
144 |     ((memq next '(* /))
145 |      (next-token src in)
146 |      (define right (parse-expr-2 src in))
147 |      `(,next ,left ,right))
148 |     (else
149 |      left)))
150 | 
151 | (define (parse-expr-3 src in)
152 |   (define next (next-token src in))
153 |   (cond
154 |     ((eof-object? next)
155 |      (complain src in "premature end of input"))
156 |     ((eq? next 'open-paren)
157 |      (define expr (parse-expr src in))
158 |      (define after (next-token src in))
159 |      (unless (eq? 'closed-paren after)
160 |        (complain src in "no closing parenthesis"))
161 |      expr)
162 |     (else next)))
163 | 
164 | 
165 | 


--------------------------------------------------------------------------------
/basic.rkt:
--------------------------------------------------------------------------------
  1 | #lang racket
  2 | (provide basic print goto := gosub return)
  3 | (require (for-syntax syntax/parse
  4 |                      racket/syntax
  5 |                      syntax/id-set))
  6 | 
  7 | #|
  8 | (print "1+1=" (+ 1 1))
  9 | =>
 10 | (begin
 11 |   (display "1+1=")
 12 |   (display (+ 1 1)))
 13 | |#
 14 | 
 15 | (define-syntax (print form)
 16 |   (syntax-parse form
 17 |     ((print arg:expr ...)
 18 |      #`(begin
 19 |          (display arg) ...
 20 |          (newline)))))
 21 | 
 22 | #|
 23 | 10 PRINT "Hello, world!"
 24 | 20 GOTO 10
 25 | |#
 26 | 
 27 | #|
 28 | (10 (print "Hello, world!"))
 29 | (20 (goto 10))
 30 | 
 31 | =>
 32 | (define (line-10)
 33 |   (print "Hello, world!")
 34 |   (line-20))
 35 | (define (line-20)
 36 |   (line-10))
 37 | |#
 38 | 
 39 | (define-for-syntax (make-line-name context line-number)
 40 |   (format-id context "line-~a" (syntax-e line-number)))
 41 | 
 42 | (define-syntax (basic form)
 43 |   (syntax-parse form
 44 |     ((basic (line-number:integer command:expr) ...)
 45 |      (define id-set (mutable-free-id-set))
 46 |      (for-each (lambda (command)
 47 |                  (collect-variables command id-set))
 48 |                (syntax->list #`(command ...)))
 49 |      #`(begin
 50 |          #,@(map (lambda (variable)
 51 |                    #`(define #,variable #f))
 52 |                  (free-id-set->list id-set))
 53 |          #,@(map (lambda (line-number next-line-number command)
 54 |                    (define name (make-line-name #`basic line-number))
 55 |                    (define call-next-line
 56 |                      (if next-line-number
 57 |                          #`(#,(make-line-name #`basic next-line-number))
 58 |                          #`(void)))
 59 |                    #`(define (#,name)
 60 |                        #,(translate-command #`basic command call-next-line)))
 61 |                  (syntax->list #`(line-number ...))
 62 |                  (append (cdr (syntax->list #`(line-number ...))) '(#f))
 63 |                  (syntax->list #`(command ...)))))))
 64 | 
 65 | (define goto #f)
 66 | (define := #f)
 67 | (define gosub #f)
 68 | (define return #f)
 69 | 
 70 | (define-for-syntax (translate-command context command call-next-line)
 71 |   (syntax-parse command
 72 |     #:literals (goto := if gosub return)
 73 |     ((goto line-number:integer)
 74 |      #`(#,(make-line-name context #`line-number)))
 75 |     ((gosub line-number:integer)
 76 |      #`(begin
 77 |          (#,(make-line-name context #`line-number))
 78 |          #,call-next-line))
 79 |     ((return) (void))
 80 |     ((:= variable:id rhs:expr)
 81 |      #`(begin
 82 |          (set! variable rhs)
 83 |          #,call-next-line))
 84 |     ((if test:expr then:expr else:expr)
 85 |      #`(if test
 86 |            #,(translate-command context #`then call-next-line)
 87 |            #,(translate-command context #`else call-next-line)))
 88 |     (_
 89 |      #`(begin #,command
 90 |               #,call-next-line))))
 91 | 
 92 | (define-for-syntax (collect-variables command id-set)
 93 |   (syntax-parse command
 94 |     #:literals (:= if)
 95 |     ((:= variable:id rhs:expr)
 96 |      (free-id-set-add! id-set #`variable))
 97 |     ((if test:expr then:expr else:expr)
 98 |      (collect-variables #`then id-set)
 99 |      (collect-variables #`else id-set))
100 |     (_ (void))))
101 |     
102 | 
103 | (basic
104 |  (5 (:= a 42)) ; A = 42
105 |  (7 (if (= a 42) (:= b 1) (:= b 2)))
106 |  (8 (gosub 1000))
107 |  (10 (print "Hello, world " a " " b))
108 |  (20 (goto 40))
109 |  (30 (print "Hello again"))
110 |  (40 (print "The end"))
111 |  (1000 (print b))
112 |  (1010 (return)))
113 | 


--------------------------------------------------------------------------------