first commit

README.md

@@ -0,0 +1,107 @@
+= turingAutomaton =
+
+a toy programming language for creating turing machines
+
+== description ==
+
+`turingAutomaton` is a programming language created to test the Racket ecosystem. it features custom syntax and is able to run single tape turing machines.
+
+== installation ==
+
+```
+git clone https://git.lain.church/tA/turingAutomaton
+cd turingAutomaton
+raco pkg install
+```
+
+== syntax ==
+
+all files must begin with a
+
+```
+#lang turingAutomaton
+```
+
+followed by a definition of;
+
+```
+@ beginningState
+% blankSymbol
+! acceptingState
+```
+
+(currently the accepting state is unimplemented)
+
+`states` are defined using the following syntax;
+
+```
+: stateName
+currentSymbol ~ newSymbol > newState
+currentSymbol ~ newSymbol < newState
+```
+
+where `<` and `>` denote moving the tape left and right, respectively
+
+comments are allowed:
+
+```
+; either on their own line
+@ first ; or at the end of a line
+```
+
+== sample program ==
+
+this machine will double a number passed to it
+
+```
+#lang turingAutomaton
+
+; this is a comment!
+
+@ first
+% e
+! F
+
+: first
+a ~ b > second
+c ~ c > fourth
+
+: second
+a ~ a > second
+c ~ c > second
+e ~ c < third
+
+: third
+a ~ a < third
+b ~ b > first
+c ~ c < third
+
+: fourth
+c ~ c > fourth
+e ~ e < fifth
+
+: fifth
+b ~ a < fifth
+c ~ a < fifth
+e ~ e > F
+```
+
+== caveats ==
+
+currently very unfinished.
+
+all input is a single tape defined with `aaaaa` for now.
+
+there is no error checking until I learn how to do that.
+
+might get slow for very large tapes as the tape uses linked lists to operate.
+
+== thanks ==
+
+mutce ckire to:
+   * the racket team for creating an awesome language
+   * Matthew Butterick for his book [Beautiful Racket](https://beautifulracket.com/) and the libraries within
+
+== author ==
+
+`fi'e la ti'ei`

expander.rkt

@@ -0,0 +1,60 @@
+#lang br/quicklang
+
+(require "tmUtils.rkt")
+
+(define-macro (tA-module-begin PARSE-TREE)
+   #'(#%module-begin
+      PARSE-TREE
+      (display-result '(a a a a a))))
+(provide (rename-out [tA-module-begin #%module-begin]))
+
+(define-macro (tA-program START-ARG BLANK-ARG ACCEPT-ARG STATE-SET-ARG)
+   #'(void START-ARG BLANK-ARG ACCEPT-ARG STATE-SET-ARG))
+(provide tA-program)
+
+(define-macro (tA-start "@" START-ARG)
+   #'(set-start! START-ARG))
+(provide tA-start)
+
+(define-macro (tA-blank "%" BLANK-ARG)
+   #'(set-def! BLANK-ARG))
+(provide tA-blank)
+
+(define-macro (tA-accept "!" ACCEPT-ARG)
+   #'(void))
+(provide tA-accept)
+
+(define-macro (tA-state-set STATE-ARG ...)
+   #'(begin
+       STATE-ARG ...))
+(provide tA-state-set)
+
+(define-macro (tA-tran CURRENT "~" NEW DIR NEXT)
+   #'(lambda (i)
+       (hash-set! trans-map
+                  `(,i ,CURRENT)
+                  `(,NEW ,DIR ,NEXT))))
+(provide tA-tran)
+
+(define-macro (tA-tran-set TRAN ...)
+   #'(lambda (i)
+       (begin
+         (TRAN i) ...)))
+(provide tA-tran-set)
+
+(define-macro (tA-state ":" ID TRAN-SET)
+   #'(TRAN-SET ID))
+(provide tA-state)
+
+(define-macro (tA-state-id ID)
+   #'(string->symbol ID))
+(provide tA-state-id)
+
+(define-macro (tA-symbol SYM)
+   #'(string->symbol SYM))
+(provide tA-symbol)
+
+(define-macro (tA-dir DIR)
+   #'(begin
+       (if (equal? "<" DIR) 'L 'R)))
+(provide tA-dir)

main.rkt

@@ -0,0 +1,4 @@
+#lang br/quicklang
+(module reader br
+   (require "reader.rkt")
+   (provide read-syntax))

parser.rkt

@@ -0,0 +1,13 @@
+#lang brag
+
+tA-program   : tA-start tA-blank tA-accept tA-state-set
+tA-start     : "@" tA-state-id
+tA-blank     : "%" tA-symbol
+tA-accept    : "!" tA-state-id
+tA-state-set : tA-state (tA-state)*
+tA-state     : ":" tA-state-id tA-tran-set
+tA-tran-set  : (tA-tran)* (NL)*
+tA-tran      : tA-symbol "~" tA-symbol tA-dir tA-state-id (NL)*
+tA-symbol    : TA-STRING
+tA-state-id  : TA-STRING
+tA-dir       : "<" | ">"

reader.rkt

@@ -0,0 +1,26 @@
+#lang br/quicklang
+(require "parser.rkt")
+
+(define (read-syntax path port)
+   (define parse-tree (parse path (make-tokenizer port)))
+   (define module-datum `(module tA-mod turingAutomaton/expander
+                           ,parse-tree))
+   (datum->syntax #f module-datum))
+(provide read-syntax)
+
+(require brag/support)
+
+(define-lex-abbrev digits (:+ (char-set "0123456789")))
+
+(define (make-tokenizer port)
+   (define (next-token)
+      (define tA-lexer
+         (lexer
+            [(from/to ";" "\n") (next-token)]
+            [whitespace (next-token)]
+            ["\n" (token 'NL lexeme)]
+            [(char-set "@%!~<>") lexeme]
+            [(:+ (:or digits alphabetic)) (token 'TA-STRING lexeme)] 
+            [any-char lexeme]))
+      (tA-lexer port))
+   next-token)

tmUtils.rkt

@@ -0,0 +1,121 @@
+#lang racket
+
+; utils - wont change
+
+(define def-symbol '())
+(define start-state '())
+(define input '())
+
+(define (set-def! x)
+   (set! def-symbol x))
+
+(define (set-start! x)
+   (set! start-state x))
+
+(define (set-input! x)
+   (set! start-state x))
+
+(define (pre t)
+   (car t))
+
+(define (cur t)
+   (cadr t))
+
+(define (aft t)
+   (caddr t))
+
+(define (shiftr t)
+  (let* [(c (cur t))
+         (p (pre t))
+         (a (aft t))
+         (a (if (null? a)
+                (list def-symbol)
+                a))]
+  `(,(append p (list c))
+    ,(car a)
+    ,(cdr a))))
+
+(define (shiftl t)
+  (let* [(c (cur t))
+         (p (pre t))
+         (a (aft t))
+         (p (if (null? p)
+                (list def-symbol)
+                p))]
+  `(,(reverse (cdr (reverse p)))
+    ,(car (reverse p))
+    ,(cons c a))))
+
+(define (write-sym s t)
+   (let [(p (pre t))
+         (a (aft t))]
+   `(,p ,s ,a)))
+
+(define (list->tape l)
+   `(() ,(car l) ,(cdr l)))
+
+(define trans-map (make-hash))
+
+(define (transition current-state tape)
+   (let [(f (hash-ref trans-map `(,current-state ,(cur tape)) #f))]
+      (if (eq? f #f)
+          `(,current-state ,tape)
+          (let* [(new-sym   (first f))
+                 (dir       (second f))
+                 (new-state (third f))
+                 (dir-op    (if (eq? 'L dir)
+                                shiftl
+                                shiftr))
+                 (new-tape  (dir-op (write-sym new-sym tape)))]
+             (transition new-state new-tape)))))
+
+(define (tape->list t)
+   (let [(flat-tape (append (pre t) (list (cur t)) (aft t)))
+         (f (lambda (x) (eq? x def-symbol)))]
+      (reverse (drop-while f (reverse (drop-while f flat-tape))))))
+
+(define (drop-while f l)
+   (if (null? l)
+       l
+       (if (f (car l))
+           (drop-while f (cdr l))
+           l)))
+
+(define (display-result input)
+   (let* [(res (transition start-state (list->tape input)))
+          (fin-state (car res))
+          (fin-tape  (tape->list (cadr res)))]
+     (void
+         (printf "Initial State: ~a~nInitial Tape:~n~a~nFinal State: ~a~nFinal Tape:~n~a~n" start-state input fin-state fin-tape))))
+
+(provide trans-map)
+(provide display-result)
+(provide set-def!)
+(provide set-start!)
+
+;; per machine - will change
+;
+;(define def-symbol 'e)
+;(define start-state '1)
+;
+;(hash-set! trans-map '(1 a) '(b R 2))
+;(hash-set! trans-map '(1 c) '(c R 4))
+;
+;(hash-set! trans-map '(2 a) '(a R 2))
+;(hash-set! trans-map '(2 c) '(c R 2))
+;(hash-set! trans-map '(2 e) '(c L 3))
+;
+;(hash-set! trans-map '(3 a) '(a L 3))
+;(hash-set! trans-map '(3 c) '(c L 3))
+;(hash-set! trans-map '(3 b) '(b R 1))
+;
+;(hash-set! trans-map '(4 c) '(c R 4))
+;(hash-set! trans-map '(4 e) '(e L 5))
+;
+;(hash-set! trans-map '(5 c) '(a L 5))
+;(hash-set! trans-map '(5 b) '(a L 5))
+;(hash-set! trans-map '(5 e) '(e R F))
+;
+;; fin
+;
+;(display-result '(a a a a a))