Added files for the tm package

README.md

 # csci71-lib
 
-Racket library for CSCI 71
\ No newline at end of file
+This is a Racket library for CSCI 71, which aims to implement simulators for different computing models (specifically: finite automata, regular expressions, context-free grammars, and Turing machines).
+
+## Installation
+
+```
+raco pkg install "https://gitlab.discs.ateneo.edu/brian/csci71-lib.git?path=tm"
+```
+
+## Update (untested)
+
+```
+raco pkg update --update-deps csci71-tm
+```
+
+## Documentation
+
+Partial documentation for `tm` package here: http://penoy.admu.edu.ph/~guadalupe154884/classes/csci71/doc/tm/

info.rkt

+#lang info
+
+(collection 'multi)

tm/LICENSE-MIT

+tm 
+
+MIT License
+
+Copyright (c) 2023 brian
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

tm/colorer.rkt

+#lang br
+
+(require "lexer.rkt"
+         brag/support)
+
+(provide tm-colorer)
+
+(define (tm-colorer port)
+  (define (handle-lexer-error exn)
+    (define exn-srclocs (exn:fail:read-srclocs exn))
+    (srcloc-token (token 'ERROR) (car exn-srclocs)))
+  (define srcloc-tok
+    (with-handlers ([exn:fail:read? handle-lexer-error])
+      (tm-lexer port)))
+  (match srcloc-tok
+    [(? eof-object?) (values srcloc-tok 'eof #f #f #f)]
+    [else
+     (match-define
+       (srcloc-token
+        (token-struct type val _ _ _ _ _)
+        (srcloc _ _ _ posn span)) srcloc-tok)
+     (define start posn)
+     (define end (+ start span))
+     (match-define (list cat paren)
+       (match type
+         ['COMMENT  '(comment #f)]
+         ['ERROR    '(error #f)]
+         ['SYM      '(constant #f)]
+         ['LABEL    '(symbol #f)]
+         [else
+          (match val
+            ["If" '(keyword #f)]
+            ["Not" '(keyword #f)]
+            ["Write" '(keyword #f)]
+            ["Move" '(keyword #f)]
+            ["Goto" '(keyword #f)]
+            ["Return" '(keyword #f)]
+            ["True"  '(constant #f)]
+            ["False" '(constant #f)]
+            ["Left"  '(constant #f)]
+            ["Right" '(constant #f)]
+            ["Blank" '(constant #f)]
+            [else '(no-color #f)])]))
+     (values val cat paren start end)]))
\ No newline at end of file

tm/expander.rkt

+#lang br/quicklang
+
+(require (except-in tm/tmachine run)
+         (only-in tm/gui simulate)
+         racket/set)
+
+(provide (rename-out [tm-module-begin #%module-begin])
+         (all-from-out tm/tmachine)
+         tm-sym tm-if-so tm-if-not
+         tm-mov tm-ret tm-stmt)
+
+(define-macro-cases tm-sym
+  [(tm-sym "Blank") #'BLANK]
+  [(tm-sym CHAR)    #'CHAR])
+
+(define-macro-cases tm-ret
+  [(tm-ret "True")  #'(tm-return #t)]
+  [(tm-ret "False") #'(tm-return #f)])
+
+(define-macro-cases tm-mov
+  [(tm-mov "Left")  #'(tm-move 'left)]
+  [(tm-mov "Right") #'(tm-move 'right)])
+
+(define-macro (tm-if-so SYM CMD)
+  #'(tm-if SYM CMD #f))
+(define-macro (tm-if-not SYM CMD)
+  #'(tm-if SYM CMD #t))
+
+(struct tm-line (number cmd) #:transparent)
+
+(define-macro (tm-stmt CMD)
+  (with-syntax ([ln (syntax-line caller-stx)])
+    (syntax/loc caller-stx
+      (tm-line ln CMD))))
+
+(define (make-tm-config raw-prgm)
+  (begin
+    (define program-list 
+       (map tm-line-cmd raw-prgm))
+    (define raw-label-table
+      (for/hasheqv ([ln raw-prgm]
+                    #:when (tm-label? (tm-line-cmd ln)))
+        (values (tm-label-name (tm-line-cmd ln))
+                (tm-line-number ln))))
+
+    ; hash tables with raw line numbers from source
+     #|(define raw-line-table
+       (for/hasheqv ([ln raw-prgm])
+         (values (tm-line-number ln)
+                 (tm-line-cmd ln))))|#
+    
+    ; Find all labels and write them down, throwing an error if they
+    ; already exist in the set.
+    (define labels-set (make-hash))
+    (for ([line (in-list raw-prgm)]
+          #:when (tm-label? (tm-line-cmd line)))
+      (let ([name (tm-label-name (tm-line-cmd line))])
+        (if (hash-has-key? labels-set name)
+          (error (format "Label name ~v already defined in line ~a" name (hash-ref labels-set name)))
+          (hash-set! labels-set name (tm-line-number line)))))
+
+    ; Build the label table
+    (define label-table
+       (for/hash ([ln (range (length program-list))]
+                     #:when (tm-label? (list-ref program-list ln)))
+         (values (tm-label-name (list-ref program-list ln))
+                 ln)))
+    (define start-line-no
+      (hash-ref label-table "Start"
+                (λ ()
+                  (error "This program is missing a \"Start\" label"))))
+    (define raw-end-line-no
+      (tm-line-number (last raw-prgm)))
+    (define end-line-no
+      (length program-list))
+
+    ; Find all used labels and make sure they exist
+    (for ([line (in-list raw-prgm)]
+          #:when (or (tm-goto? (tm-line-cmd line))
+                     (and (tm-if? (tm-line-cmd line))
+                      (tm-goto? (tm-if-cmd (tm-line-cmd line))))))
+      (let* ([cmd (tm-line-cmd line)]
+             [dest (cond
+                     [(tm-goto? cmd)
+                      (tm-goto-dest cmd)]
+                     [(tm-if? cmd)
+                      (tm-goto-dest (tm-if-cmd cmd))])])
+        (when (not (hash-has-key? labels-set dest))
+          (error (format "Goto statement (in line ~a) references undefined label ~v"
+                         (tm-line-number line) dest)))))
+
+    ; Return the interpreter object
+    (tm-config
+        ; initial tape config
+        (initial-tape-for "")
+        ; initial state
+        'running
+        ; program listing
+        (list->vector program-list)
+        ; starting line number
+        start-line-no
+        ; last line number
+        end-line-no
+        ; initial step count
+        0
+        ; label table
+        label-table)))  
+
+(define-macro (tm-module-begin (tm-program STMTS ...))
+  #'(#%module-begin
+     (provide this-tm)
+     (define raw-prgm (list STMTS ...))
+     (define this-tm
+       (make-tm-config raw-prgm))
+     (display "Input string: ")
+     (define input (read-line))
+     (set-input! this-tm input)
+     (simulate this-tm)))
+

tm/gui.rkt

+#lang racket
+
+(require 2htdp/image
+         2htdp/universe
+         (except-in tm/tmachine run)
+         (only-in pict show-pict))
+
+(provide run-simulation
+         simulate)
+
+(define (tape-cell i sym [head? #f])
+  (above/align
+   "middle"
+   (text/font (number->string i)
+               12 "gray"
+               #f "modern" "normal" "normal" #f)
+   (overlay
+    (text/font (if (eq? sym BLANK) "" (string sym))
+               30 "black"
+               #f "modern" "normal" "normal" #f)
+    (square 40 "outline" "black")
+    (square 40 "solid" (make-color 239 239 239)))
+   (if head? tape-head no-tape-head)))
+
+(define tape-head
+  (triangle 20 "solid" (make-color 122 166 218)))
+(define no-tape-head
+  (triangle 20 "solid" "transparent"))
+
+(define (render-tape tm)
+  (let ([tape (tm-config-tape tm)])
+    (apply beside
+           (for/list ([i (in-range (sub1 TAPE-WIDTH))])
+             (let ([tape-idx (+ (tape-leftmost-pos tape) i)])
+               (tape-cell tape-idx (tape-at tm tape-idx)
+                          (= tape-idx (tape-pos tape))))))))
+
+; render single line from program listing
+(define (program-line linestr [in-focus? #f])
+  (overlay/align "left" "middle"
+   (text/font linestr
+              18 "black"
+              #f ;"JuliaMono"
+              "modern" "normal" "normal" #f)
+   (rectangle (* TAPE-WIDTH 40) 30 "solid"
+              (if in-focus?
+                  (make-color 240 198 116)
+                  "white"))))
+
+; display 10 lines at a time
+(define PRGM-HEIGHT 10)
+(define PRGM-MARGIN 2)
+(define topmost-line 0)
+
+(define (render-program-list tm from to)
+  (apply above/align
+       (append (list "left")
+       (for/list ([i (in-range from to)])
+         (program-line
+          (if (or (< i 0) (>= i (tm-config-last-line-no tm)))
+              ""
+              ;(string-append (~r i #:min-width 4) " "
+              (stmt->string
+               (vector-ref (tm-config-program tm) i)));)
+          (= i (tm-config-line-no tm)))))))
+
+(define (render-status tm)
+  (overlay/align "left" "middle"
+   (text/font
+    (match (tm-config-state tm)
+      ['accept  (format "Accepted after ~a steps" (tm-config-steps tm))]
+      ['reject  (format "Rejected after ~a steps" (tm-config-steps tm))]
+      ['running  (format "Running: ~a steps" (tm-config-steps tm))])
+              16 "black"
+              #f "swiss" "normal" "normal" #f)
+   (rectangle (* TAPE-WIDTH 40)
+              25 "solid" "white")))
+
+(define (render-frame tm)
+  ; print out current line from program
+  (let ([tape (tm-config-tape tm)])
+    (when (>= (tm-config-line-no tm)
+              (- (+ topmost-line PRGM-HEIGHT) PRGM-MARGIN))
+      (set! topmost-line (+ (- (tm-config-line-no tm) PRGM-HEIGHT) (+ PRGM-MARGIN 1))))
+      
+    (when (< (tm-config-line-no tm)
+             (+ topmost-line PRGM-MARGIN))
+      (set! topmost-line (- (tm-config-line-no tm) PRGM-MARGIN)))
+      
+    (when (< topmost-line 0)
+      (set! topmost-line 0))
+      
+    ; if bottom-line = topmost-line + HEIGHT == last-line-np
+    (when (and (> (tm-config-line-no tm) PRGM-HEIGHT)
+               (>= (+ topmost-line PRGM-HEIGHT) (tm-config-last-line-no tm)))
+      (set! topmost-line (- (tm-config-last-line-no tm) PRGM-HEIGHT)))
+
+    (define curr-listing
+      (render-program-list tm
+                           topmost-line
+                           (+ topmost-line PRGM-HEIGHT)))
+    
+    (when (>= (tape-pos tape)
+              (- (+ (tape-leftmost-pos tape) TAPE-WIDTH) TAPE-MARGIN))
+      (set-tape-leftmost-pos! tape (add1 (tape-leftmost-pos tape))))
+    (when (< (tape-pos tape)
+             (+ (tape-leftmost-pos tape) TAPE-MARGIN))
+      (set-tape-leftmost-pos! tape (sub1 (tape-leftmost-pos tape))))
+
+    (above curr-listing
+           (render-tape tm)
+           (render-status tm))))
+
+(define tape-anim-frames (list))
+(define (run! tm)
+  ; generate first frame
+  (set! tape-anim-frames
+        (append tape-anim-frames
+                (list (render-frame tm))))
+
+  (define (run!/loop tm)
+    (begin
+      (step! tm)
+      (when (and (eq? (tm-config-state tm) 'running)
+                 (> (tm-config-steps tm) MAX-STEPS))
+        (error (format "TM still running after ~a steps; double-check for possible infinite loop"
+                       MAX-STEPS)))
+      ; generate next frame
+      (set! tape-anim-frames
+            (append tape-anim-frames
+                    (list (render-frame tm))))
+      (when (eq? (tm-config-state tm) 'running)
+        (run!/loop tm))))
+  (run!/loop tm))
+
+(define ANIMATION-DELAY ; in seconds
+  (list 750 ;0.75
+        500 ;0.5
+        250 ;0.25
+        125 ;0.125
+        50  ;0.05
+        25  ;0.025
+        10  ;0.01
+        5   ;0.005
+        ))
+
+(struct tm-gui ([steps #:mutable]
+                [running? #:mutable]
+                [rate #:mutable]
+                [ticks #:mutable]))
+
+(define (simulate tm)
+  (begin
+    (set! tape-anim-frames (list))
+    (set! topmost-line 0)
+    (define (update-step steps ticks rate)
+      ;(printf "st:~a tk:~a dl:~a\n" steps ticks (list-ref ANIMATION-DELAY rate))
+      (if (= (remainder ticks (list-ref ANIMATION-DELAY rate)) 0)
+          (add1 steps)
+          steps))
+    (run! tm)
+    (thread
+     (λ ()
+       (big-bang
+         (tm-gui 0 #f 0 0)
+         (name "TM Debugger")
+         (on-tick
+          (λ (state)
+            (if (tm-gui-running? state)
+                        (if (< (tm-gui-steps state) (tm-config-steps tm))
+                            (tm-gui (update-step (tm-gui-steps state)
+                                                 (tm-gui-ticks state)
+                                                 (tm-gui-rate state))
+                                    #t
+                                    (tm-gui-rate state)
+                                    (add1 (tm-gui-ticks state)))
+                            (tm-gui (tm-gui-steps state)
+                                    #f
+                                    (tm-gui-rate state)
+                                    (add1 (tm-gui-ticks state)))
+                            )
+                        (tm-gui (tm-gui-steps state)
+                                #f
+                                (tm-gui-rate state)
+                                (add1 (tm-gui-ticks state)))))
+          0.001)
+         (to-draw (λ (state)
+                    (list-ref tape-anim-frames (tm-gui-steps state))))
+
+         ; key handler
+         (on-key
+          (λ (state a-key)
+            (cond
+              ; play/pause simulation
+              [(key=? a-key " ")
+               (tm-gui (tm-gui-steps state)
+                       (not (tm-gui-running? state))
+                       (tm-gui-rate state)
+                       (tm-gui-ticks state))]
+              ; step forward
+              [(key=? a-key "right")
+               (tm-gui (min (tm-config-steps tm) (add1 (tm-gui-steps state)))
+                       #f
+                       (tm-gui-rate state)
+                       (tm-gui-ticks state))]
+              ; step backward
+              [(key=? a-key "left")
+               (tm-gui (max 0 (sub1 (tm-gui-steps state)))
+                       #f
+                       (tm-gui-rate state)
+                       (tm-gui-ticks state))]
+              ; rewind
+              [(key=? a-key "r")
+               (tm-gui 0
+                       #f
+                       (tm-gui-rate state)
+                       (tm-gui-ticks state))]
+              ; fast forward
+              [(key=? a-key "f")
+               (tm-gui (tm-config-steps tm)
+                       #f
+                       (tm-gui-rate state)
+                       (tm-gui-ticks state))]
+              ; faster
+              [(key=? a-key "up")
+               (tm-gui (tm-gui-steps state)
+                       (tm-gui-running? state)
+                       (min (sub1 (length ANIMATION-DELAY))
+                            (add1 (tm-gui-rate state)))
+                       (tm-gui-ticks state))]
+              ; slower
+              [(key=? a-key "down")
+               (tm-gui (tm-gui-steps state)
+                       (tm-gui-running? state)
+                       (max 0
+                            (sub1 (tm-gui-rate state)))
+                       (tm-gui-ticks state))]
+              [else state]
+                  )))
+         )))))

tm/info.rkt

+#lang info
+(define collection "tm")
+(define deps '("beautiful-racket-lib"
+               "brag-lib"
+               "htdp-lib"
+               "pict-lib"
+               "base"))
+(define build-deps '("scribble-lib" "racket-doc" "rackunit-lib"))
+(define scribblings '(("scribblings/tm.scrbl" ())))
+(define pkg-desc "Turing machine simulator/debugger for CSCI 71")
+(define version "0.1")
+(define pkg-authors '(brian))
+(define license '(MIT))

tm/lexer.rkt

+#lang racket
+
+(require brag/support)
+
+(provide tm-lexer
+         make-tokenizer)
+
+(define-lex-abbrevs
+  (lower-letter (:/ #\a #\z))
+  (upper-letter (:/ #\A #\Z))
+  (letter (:or lower-letter upper-letter))
+  (digit (:/ #\0 #\9))
+  (underscore #\_)
+  (colon #\:)
+  (squote #\')
+  (dquote #\")
+  (keywords (:or "Write" "Move" "If" "Not" "Goto"
+                 "Return" "True" "False" "Left" "Right" "Blank"))
+  )
+
+(define tm-lexer
+  (lexer-srcloc
+   [#\newline (token 'NEWLINE)]
+   [whitespace
+    (token lexeme #:skip? #t)]
+   [colon
+    (token 'COLON lexeme)]
+   [keywords
+    (token lexeme lexeme)]
+   [(from/to squote squote)
+    (token 'SYM (string-ref
+                 (trim-ends "'" lexeme "'") 0))]
+   [(:: (:or letter underscore)
+        (:* (:or letter underscore digit)))
+    (token 'LABEL lexeme)]
+   ; comments
+   [(from/stop-before ";;" "\n")
+    (token 'COMMENT lexeme #:skip? #t)]
+   ))
+
+(define (make-tokenizer input-port [path #f])
+  (lexer-file-path path)
+  (define (next-token) (tm-lexer input-port))
+  next-token)
+
+(define (scan str)
+  (apply-port-proc tm-lexer str))
\ No newline at end of file

tm/main.rkt

+#lang br/quicklang
+
+(require "parser.rkt" "tokenizer.rkt")
+
+(module+ reader
+  (provide read-syntax get-info))
+
+(define (read-syntax path port)
+  (define parse-tree (parse path (make-tokenizer port path)))
+  (strip-bindings
+   #`(module tm-mod tm/expander
+       #,parse-tree
+       )))
+
+(define (get-info port src-mod src-line src-col src-pos)
+  (define (handle-query key default)
+    (case key
+      [(color-lexer)
+       (dynamic-require 'tm/colorer 'tm-colorer)]
+      [(drracket:opt-out-toolbar-buttons)
+       '(drracket:syncheck debug-tool macro-stepper)]
+      ; for some reason this don't work hmmmmmm
+      [(drracket:default-extension)
+       "tm"]
+      [else default]))
+  handle-query)

tm/parser.rkt

+#lang brag
+
+tm-program: [tm-stmt] (/NEWLINE [tm-stmt])*
+tm-stmt: tm-label | tm-write | tm-mov
+        | tm-if | tm-goto | tm-ret
+
+tm-label: LABEL /COLON
+tm-write: /"Write" tm-sym
+tm-mov: /"Move" "Left" | /"Move" "Right"
+
+@tm-if: tm-if-so | tm-if-not
+tm-if-so: /"If" tm-sym if-consequent
+tm-if-not: /"If" /"Not" tm-sym if-consequent
+@if-consequent: tm-write | tm-mov | tm-goto | tm-ret
+
+tm-goto: /"Goto" LABEL
+tm-ret: /"Return" "True" | /"Return" "False"
+
+tm-sym: SYM | "Blank"

tm/scribblings/tm.scrbl

+#lang scribble/manual
+@require[@for-label[tm
+                    racket/base]
+         scribble/bnf]
+
+@title{@tt{tm}: A Turing machine for CSCI 71}
+@author[(author+email "Brian Guadalupe" "bguadalupe@ateneo.edu")]
+
+@defmodulelang[tm]
+
+@section{Introduction}
+The @tt{tm} package provides an implementation of a Turing machine.
+Unlike the usual ``automaton-based'' model of a Turing machine found in most textbooks, this package implements a ``program-based'' model using an equivalent variant called the @hyperlink["https://en.wikipedia.org/wiki/Post%E2%80%93Turing_machine" @emph{Post--Turing machine}].
+More precisely, it is based on a formulation of the Post--Turing machine by Davis, Sigal, and Weyuker defined in @emph{Computability, Complexity, and Languages: Fundamentals of Theoretical Computer Science} (1994). To quote:
+
+@nested[#:style 'inset]{Although the formulation we have presented is closer in spirit to that originally given by Emil Post, it was Turing's analysis of the computation process that has made this formulation seem so appropriate. This language has played a fundamental role in theoretical computer science.}
+
+@subsection{Setup}
+@margin-note{Prior knowledge of Racket is not required nor needed to use this package.}
+
+To be able to design, test, and debug your Turing machines, you will need to set up Racket on your machine first. Most of you have taken CSCI 70 last semester anyway, so most likely you already have it installed. If not, download and install the latest version @hyperlink["https://download.racket-lang.org/" "here"].
+
+Next, open your terminal and run the following command:
+@commandline{raco pkg install "https://gitlab.discs.ateneo.edu/brian/csci71-lib.git?path=csci71-tm"}
+
+This will install the @tt{tm} package and makes the @tt{tm} language accessible from DrRacket through @tt{#lang tm}.
+
+@subsection{Sample programs}
+To help you develop your own TM programs, here is a list of sample programs so that you can see some strategies for solving problems with Turing machines.
+
+@itemlist[
+@item{@tt{anbn.tm} --- a program that recognizes strings of the form @math{@tt{a}^n@tt{b}^n} where @math{n ≥ 0}.}
+@item{@tt{sort_ab.tm} --- a program (transducer) that sorts a string consisting of @tt{a}'s and @tt{b}'s so that all @tt{a}'s appear first before @tt{b}'s.}
+@item{@tt{hailstone.tm} --- a program that, given a string of the form @math{@tt{a}^n} for some nonnegative integer @math{n}, accepts iff the hailstone sequence terminates for @math{n}.}
+]
+
+@section{Program syntax}
+
+An example of a Turing machine program looks like this:
+@codeblock[#:keep-lang-line? #t]{
+#lang tm
+Start:
+  If Blank Return True
+  If 'b' Return False
+  Write 'x'
+  Move Right
+  If Not 'b' Return False
+  Write 'x'
+  Move Right
+  Goto Start
+}
+
+Note that every program starts with the @tt{#lang tm} header.
+
+@subsection{Labels}
+Labels indicate different sections of code. Labels have no effect when executed; we just move to the next line.
+The name @tt{Start} is special and means ``begin here''; this is where the program starts execution. 
+Every program has a @tt{Start} label.
+
+@subsection{Instruction set}
+
+The statement @bold{@tt{Write}} @nonterm{symbol} writes @nonterm{symbol} to the cell under the tape head.
+The @nonterm{symbol} can either be @tt{Blank} or a character in single quotes, like @tt{'a'}.
+
+The statement @bold{@tt{Move}} @nonterm{direction} moves the tape head one step in the indicated direction (either @tt{Left} or @tt{Right}).
+
+The statement @bold{@tt{Goto}} @nonterm{label} jumps to the indicated label.
+
+A statement of the form @bold{@tt{If}} @nonterm{symbol} @nonterm{command} checks if the symbol under the tape head is @nonterm{symbol}. If so, it executes @nonterm{command}. If not, nothing happens.
+
+A statement of the form @bold{@tt{If Not}} @nonterm{symbol} @nonterm{command} checks if the symbol under the tape head is @nonterm{symbol}. If so, nothing happens. If not, it executes @italic{command}.
+
+The program stops when executing the @bold{@tt{Return}} @nonterm{result} statement. Here, @nonterm{result} can be either @tt{True} (accept) or @tt{False} (reject).
+@margin-note{If we ``fall off'' the bottom of the program, the program acts as though it executes the @tt{Return False} statement.}
+
+@subsection{Comments}
+Comments are supported and can be embedded within a program.
+Two semicolons (@tt{;;}) denote the start of a comment, and anything after this is ignored until the next line.
+Comments are stripped off prior to expansion.
+
+@subsection{Indentation}
+Indentation serves no syntactic purpose other than to maintain or preserve clarity, thus it is optional.
+
+
+@section{The debugger interface}
+The debugger allows you to input arbitrary strings as input to Turing machine programs and doesn't validate that your input strings have the correct alphabet.
+
+@subsection{Using the debugger}
+To launch the debugger, click the ``Run'' button on the top-right corner in the DrRacket window, or press @tt{Ctrl+R} (or @tt{Cmd-R} for macOS, I think).
+
+The interactions panel will then pop up (usually below your code) and ask for the input string. The input string can be empty.
+
+@image[#:scale 0.35]{scribblings/tm_debugger_input.png}
+
+The interpreter will generate the animation frames, after which you will be presented with the debugger GUI:
+
+@image[#:scale 0.35]{scribblings/tm_debugger_start.png}
+
+Note that the debugger GUI will not appear if your program takes more than 100,000 steps to run; this is the hard limit imposed by the interpreter.
+
+@subsection{Keyboard controls}
+The GUI is driven by keyboard controls. In particular:
+@itemlist[@item{@tt{<space>} pauses and resumes the simulation}
+          @item{@tt{<left>} and @tt{<right>} moves the simulation one step backward and forward, respectively (note that both keys will pause the simulation)}
+          @item{@tt{<up>} and @tt{<down>} speeds up and slows down the simulation, respectively}
+          @item{@tt{r} resets/rewinds the simulation to the beginning}
+          @item{@tt{f} fast-forwards the simulation to the end (i.e., when the TM accepts or rejects)}
+          ]
+
+@subsection{Troubleshooting}
+@itemlist[
+@item{@bold{Encountered parsing error...}
+
+       This means you have a syntax error in your program. The offending characters are usually colored red in the editor.}
+
+@item{@bold{Label name @nonterm{label} already defined in line @nonterm{line-no}}
+
+       Either rename the second instance of @nonterm{label} or remove it.}
+
+@item{@bold{This program is missing a "Start" label}
+
+       Add a @tt{Start} label in your program.}
+
+@item{@bold{Goto statement (in line @nonterm{line-no}) references undefined label @nonterm{label}}
+
+       Either define this label or remove it.}
+]
+
+
+@section{The nitty-gritty implementation details}
+@margin-note{This section is under construction.}
+
+@bold{Warning:} This section is only intended for the morbidly curious.
+
+
+@subsection{Syntax}
+The grammar for a TM program is defined as follows:
+
+@BNF[
+(list @nonterm{program}
+      @BNF-seq[@optional[@nonterm{statement}]
+               @kleenestar[@BNF-group[@litchar{\n} @optional[@nonterm{statement}]]]])
+(list @nonterm{statement}
+      @BNF-alt[@nonterm{label-stmt} @nonterm{write-stmt} @nonterm{move-stmt} @nonterm{if-stmt} @nonterm{if-not-stmt} @nonterm{goto-stmt} @nonterm{return-stmt}])
+(list @nonterm{label-stmt}
+      @BNF-seq[@nonterm{label} @litchar{:}])
+(list @nonterm{write-stmt}
+      @BNF-seq[@litchar{Write} @nonterm{symbol-or-blank}])
+(list @nonterm{move-stmt}
+      @BNF-seq[@litchar{Move} @nonterm{direction}])
+
+(list @nonterm{if-stmt}
+      @BNF-seq[@litchar{If} @nonterm{symbol-or-blank} @nonterm{consequent}])
+(list @nonterm{if-not-stmt}
+      @BNF-seq[@litchar{If Not} @nonterm{symbol-or-blank} @nonterm{consequent}])
+(list @nonterm{consequent}
+      @BNF-alt[@nonterm{write-stmt} @nonterm{move-stmt} @nonterm{goto-stmt} @nonterm{return-stmt}])
+
+(list @nonterm{goto-stmt}
+      @BNF-seq[@litchar{Goto} @nonterm{label}])
+(list @nonterm{return-stmt}
+      @BNF-seq[@litchar{Return} @nonterm{result}])
+
+(list @nonterm{direction} @BNF-alt[@litchar{Left} @litchar{Right}])
+(list @nonterm{result} @BNF-alt[@litchar{True} @litchar{False}])
+]
+
+
+@subsection{Expansion}
+The expander translates the parse tree into a list of @racket[tm-stmt] objects. Each type of statement has a corresponding structure type:
+
+@defstruct*[tm-label ([name string?])]{
+A structure type representing a section label.
+}
+
+@defstruct*[tm-write ([sym (or/c '□ char?)])]{
+A structure type representing the statement @tt{Write} @racketvarfont{sym}.
+}
+
+@defstruct*[tm-move ([direction (or/c 'left 'right)])]{
+A structure type representing the statement @tt{Move} @racketvarfont{direction}.
+}
+
+@defstruct*[tm-goto ([dest string?])]{
+A structure type representing the statement @tt{Goto} @racketvarfont{dest}. The referenced label @racketvarfont{dest} should be defined in the program.
+}
+
+@defstruct*[tm-return ([result boolean?])]{
+A structure type representing a @tt{Return} statement. If @racketvarfont{result} evaluates to @racket[#t], it represents the statement @tt{Return True}; otherwise, it represents the statement @tt{Return False}. 
+}
+
+@defstruct*[tm-if ([sym (or/c '□ char?)] [cmd (or/c tm-write? tm-move? tm-goto? tm-return?)] [negated? boolean?])]{
+A structure type representing either an @tt{If} or an @tt{If Not} statement. If @racketvarfont{negated?} evaluates to @racket[#f], it represents the statement @tt{If} @racketvarfont{sym} @racketvarfont{cmd}; otherwise, it represents the statement @tt{If Not} @racketvarfont{sym} @racketvarfont{cmd}.
+The consequent command @racketvarfont{cmd} cannot correspond to a label declaration or another @tt{If} or @tt{If Not} statement.
+}
+
+As an example, the program at the beginning of the page expands to:
+@racketblock[
+(list (tm-line 3 (tm-label "Start"))
+      (tm-line 4 (tm-if '□ (tm-return #t) #f))
+      (tm-line 5 (tm-if #\b (tm-return #f) #f))
+      (tm-line 6 (tm-write #\x))
+      (tm-line 7 (tm-move 'right))
+      (tm-line 8 (tm-if #\b (tm-return #f) #t))
+      (tm-line 9 (tm-write #\x))
+      (tm-line 10 (tm-move 'right))
+      (tm-line 11 (tm-goto "Start")))
+]
+
+@subsection{Semantic analysis}
+The program must be valid before it can be interpreted.
+During semantic analysis, the expander checks for the following things:
+@itemlist[
+@item{Whether there are no duplicated labels.}
+@item{Whether there is a @tt{Start} label.}
+@item{Whether all @tt{Goto} statements reference an existing label.}]
+
+This step also involves building the label table, determining the starting line number (i.e., the line number containing the @tt{Start} label), and the last line number.
+
+@defproc[(make-tm-config [raw-prgm list?]) tm-config?]{
+ Given the program list @racket[raw-prgm] obtained from expansion, carries out the semantic analysis step as described in the previous paragraphs. If there are no errors raised, it returns a @racket[tm-config] object for the program.
+}
+
+@subsection{The tape}
+The tape is essentially implemented using two queues.
+
+@defstruct*[tape ([before list?] [after list?] [pos integer?] [leftmost-pos integer?])]{
+A structure type representing a Turing machine tape.
+The tape is implemented using two @racket[list] objects, where @racketvarfont{before} contains the sequence of symbols appearing to the left of the tape head (stored in reverse), and @racketvarfont{after} represents the sequence of symbols starting from the tape head and onwards.
+
+The @racketvarfont{pos} field stores the current index of the tape head; initially set to @racket[0], which points at the first symbol of the input.
+}
+
+@subsection{The interpreter}
+One can think of the interpreter as a universal Turing machine, where given a program and an input string, it sets up a simulation that can then be used to run the program.
+
+An instance of a Turing machine interpreter is constructed using the @racket[tm-config] struct.
+
+@defstruct*[tm-config ([tape tm-tape?] [state (or/c 'accept 'reject 'running)] [program vector?] [line-no exact-nonnegative-integer?] [last-line-no exact-nonnegative-integer?] [steps exact-nonnegative-integer?] [labels hash?])]{
+A structure type representing a Turing machine configuration.
+
+@racketvarfont{tape} holds the program tape.
+
+@racketvarfont{state} stores the current state, initially set to @racket['running].
+The other two possible states are @racket['accept] and @racket['reject].
+
+@racketvarfont{program} is a @racket[vector] of statements, directly obtained from the expansion step.
+
+@racketvarfont{line-no} stores the current line number. Note that this is different from the line numbers in the original program as stored in the file.
+
+@racketvarfont{last-line-no} stores the last line number of the program; usually this is just equal to the length of @racketvarfont{program}.
+
+@racketvarfont{steps} is the step counter, initially set to @racket[0].
+
+@racketvarfont{labels} is a hash table where keys correspond to labels in the program, and values correspond to their respective line numbers. This is obtained from the semantic analysis step.
+}
+
+To initialize the tape with the input string, the @racket[initial-tape-for] procedure is used.
+
+@defproc[(initial-tape-for [str string?]) tape?]{
+Returns a tape object containing @racket[str], where each symbol is placed on a single tape cell. The initial position of the tape head is on the first symbol of the input.
+}
+
+@defproc[(execute-statement! [tm tm-config?] [stmt (or/c tm-label? tm-write? tm-move? tm-goto? tm-return? tm-if?)]) void?]{
+Executes a single statement @racket[stmt], which updates @racket[tm] in place.
+}
+
+@defproc[(step! [tm tm-config?]) void?]{
+If the current state of @racket[tm] is equal to @racket['running], increments the step counter and executes the statement on the current line number of @racket[tm]. If the line number stays the same (i.e., a @tt{Goto} has not been executed), it will increment the current line number of @racket[tm].
+When the last line of the program has been processed, it automatically sets the state of @racket[tm] to @racket['reject].
+}
\ No newline at end of file

tm/tmachine.rkt

+#lang racket
+
+(provide (all-defined-out))
+
+; TM instruction set
+(struct tm-label (name) #:transparent)
+(struct tm-write (sym) #:transparent)
+(struct tm-move (direction) #:transparent)
+(struct tm-if (sym cmd negated?) #:transparent)
+(struct tm-goto (dest) #:transparent)
+(struct tm-return (result) #:transparent)
+
+(struct tm-config ([tape  #:mutable]
+                   [state #:mutable]     ; initially 'running
+                   [program #:mutable]
+                   [line-no #:mutable]   ; starting line number
+                   [last-line-no #:mutable] ; last line number
+                   [steps #:mutable]
+                   labels)) 
+
+; blank symbol
+(define BLANK '□)
+
+;; tape structure
+
+(struct tape
+  ([before #:mutable]
+   [after #:mutable]
+   ; current position of tape head
+   [pos #:mutable]
+   ; minimum character position to display on the tape
+   [leftmost-pos #:mutable]
+   ))
+
+; Margin on each side of the tape that the tape head can't leave. If the tape
+; head's displayed position were to move outside of this range, instead we scroll
+; the tape over.
+(define TAPE-MARGIN 3)
+(define TAPE-WIDTH 18)
+
+(define (tape-head tape)
+  (car (tape-after tape)))
+
+(define (replace-tape-head! tape new)
+  (set-tape-after! tape
+   (cons new (cdr (tape-after tape)))))
+
+(define (read-tape tm)
+  (tape-head (tm-config-tape tm)))
+
+(define (write-tape! tm sym)
+  (replace-tape-head! (tm-config-tape tm) sym))
+
+;; TO-DO: fix comestic bug where the new blank cell gets "added"
+(define (move-head-left! tm)
+  (let ([tape (tm-config-tape tm)])
+    (begin
+      ; if nothing before, add a new cell
+      (when (empty? (tape-before tape))
+        (set-tape-before! tape (cons BLANK '()))
+        ;(set-tape-leftmost-pos! tape (add1 (tape-leftmost-pos tape)))
+        )
+      (define new-head (car (tape-before tape)))
+      (set-tape-before! tape (cdr (tape-before tape)))
+      (set-tape-after! tape (cons new-head (tape-after tape)))
+      (set-tape-pos! tape (sub1 (tape-pos tape))))))
+
+(define (move-head-right! tm)
+  (let ([tape (tm-config-tape tm)])
+    (begin
+      (define curr-head (tape-head tape))
+      (when (empty? (cdr (tape-after tape)))
+        (set-tape-after! tape (cons curr-head (cons BLANK '()))))
+      (set-tape-after! tape (cdr (tape-after tape)))
+      (set-tape-before! tape (cons curr-head (tape-before tape)))
+      (set-tape-pos! tape (add1 (tape-pos tape))))))
+
+
+; if index is "out of range", just return a blank
+(define (symbol-or-blank lst idx)
+  (if (<= (length lst) idx)
+      BLANK
+      (list-ref lst idx)))
+(define (tape-at tm index)
+  (let ([tape (tm-config-tape tm)]
+        [head-pos (tape-pos (tm-config-tape tm))])
+    (if (< index head-pos)
+        (symbol-or-blank (tape-before tape) (- head-pos (+ index 1)))
+        (symbol-or-blank (tape-after tape)  (- index head-pos)))))
+
+; TO-DO: truncate tape if it only contains mostly blanks
+(define (tape-list->string tl)
+  (if (empty? tl) ""
+      (string-append*
+       (format "~a" (car tl))
+       (append* (map (λ (s) (list " " (format "~a" s))) (cdr tl))))))
+  
+(define (print-tape tm)
+  (let ([tape (tm-config-tape tm)])
+    (printf "~a[~a]~a\n"
+            (tape-list->string (reverse (tape-before tape)))
+            (tape-head tape)
+            (tape-list->string (cdr (tape-after tape))))))
+
+(define (tape-contents tm)
+  (let ([tape (tm-config-tape tm)])
+    (format "~a~a~a"
+            (tape-list->string (reverse (tape-before tape)))
+            (tape-head tape)
+            (tape-list->string (cdr (tape-after tape))))))
+
+;; program-related stuff
+
+(define (jump-to! tm label-str)
+  (set-tm-config-line-no! (label->line-no label-str)))
+  
+(define (label->line-no tm label)
+  (hash-ref (tm-config-labels tm)
+            label
+            (λ () (error 'execute-statement! "Label ~v is undefined" label))))
+
+(define (execute-statement! tm stmt)
+  (match stmt
+    [(tm-write sym)  (write-tape! tm sym)]
+    [(tm-move dir)   (match dir
+                       ['left  (move-head-left! tm)]
+                       ['right (move-head-right! tm)]
+                       [_      (error "Invalid direction")])]
+    [(tm-goto destination)   (set-tm-config-line-no! tm
+                                                     (label->line-no tm destination))]
+    [(tm-return result)  (set-tm-config-state! tm (if result 'accept 'reject))]
+    [(tm-if sym cmd negated?)     (if (xor (eq? sym (read-tape tm)) negated?)
+                                      (execute-statement! tm cmd)
+                                      #f)]
+    [(tm-label _)   (go-to-next-line! tm)]
+    [_    (error 'execute-statement! "Invalid instruction '~a'" (car stmt))]
+    ))
+
+(define (stmt->string stmt)
+  (match stmt
+    [(tm-label name) (string-append name ":")]
+    [(tm-write sym)  (string-append "  Write " (if (eq? sym BLANK)
+                                                 "Blank"
+                                                 (string #\' sym #\')))]
+    [(tm-move dir)   (string-append "  Move "  (match dir
+                                               ['left  "Left"]
+                                               ['right "Right"]
+                                               [_   "<unknown direction>"]))]
+    [(tm-return result) (string-append "  Return " (if result "True" "False"))]
+    [(tm-goto destination)     (string-append "  Goto " destination)]
+    [(tm-if sym cmd negated?)  (string-append "  If "
+                                              (if negated? "Not " "")
+                                              (if (eq? sym BLANK)
+                                                  "Blank"
+                                                  (string #\' sym #\'))
+                                              (stmt->string cmd))]
+    [_ "<illegal operation>"]))
+
+(define (go-to-next-line! tm)
+  (set-tm-config-line-no! tm (+ (tm-config-line-no tm) 1)))
+
+(define (step! tm)
+  (when (eq? (tm-config-state tm) 'running)
+      (begin
+        (set-tm-config-steps! tm (+ 1 (tm-config-steps tm)))
+        (define line-before (tm-config-line-no tm))
+        (define stmt (vector-ref (tm-config-program tm) (tm-config-line-no tm)))
+        (execute-statement! tm stmt)
+        (when (not (eq? (tm-config-state tm) 'running)) (void))
+        
+        (when (= line-before (tm-config-line-no tm))
+            (go-to-next-line! tm))
+        (when (and (>= (tm-config-line-no tm) (tm-config-last-line-no tm))
+                   (eq? (tm-config-state tm) 'running))
+               (set-tm-config-state! tm 'reject)))))
+
+(define MAX-STEPS 100000) ; 100k steps should be enough
+;(define MAX-STEPS 10000000)
+(define (run tm)
+  (begin
+    (when (and (eq? (tm-config-state tm) 'running)
+             (> (tm-config-steps tm) MAX-STEPS))
+      (error (format "TM still running after ~a steps; double-check for possible infinite loop"
+                     MAX-STEPS)))
+    (printf "~a\n\t" (stmt->string (vector-ref (tm-config-program tm)
+                            (tm-config-line-no tm))))
+    (step! tm)
+    (print-tape tm)
+    ;(printf "tape position: ~a" (tape-pos (tm-config-tape tm)))
+    (if (not (eq? (tm-config-state tm) 'running))
+        (tm-config-state tm)
+        (run tm))
+  ))
+
+(define (initial-tape-for str)
+  (tape '()
+        (append (string->list str) (list BLANK))
+        0
+        (- TAPE-MARGIN)))
+
+(define (set-input! tm input)
+  (set-tm-config-tape! tm (initial-tape-for input)))
+

tm/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) (tm-lexer ip))
+  next-token)
+
+(provide make-tokenizer)
\ No newline at end of file