From 6288f19e93a0d6e4fbd754d0cf0e58a8895ee256 Mon Sep 17 00:00:00 2001 From: tA Date: Tue, 31 Mar 2020 09:35:50 +1300 Subject: [PATCH] first commit --- README.md | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++++ expander.rkt | 60 +++++++++++++++++++++++++++++ main.rkt | 4 ++ parser.rkt | 13 +++++++ reader.rkt | 26 +++++++++++++ tmUtils.rkt | 121 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 331 insertions(+) create mode 100644 README.md create mode 100644 expander.rkt create mode 100644 main.rkt create mode 100644 parser.rkt create mode 100644 reader.rkt create mode 100644 tmUtils.rkt diff --git a/README.md b/README.md new file mode 100644 index 0000000..9c3262d --- /dev/null +++ b/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` diff --git a/expander.rkt b/expander.rkt new file mode 100644 index 0000000..9aa749a --- /dev/null +++ b/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) diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..df07399 --- /dev/null +++ b/main.rkt @@ -0,0 +1,4 @@ +#lang br/quicklang +(module reader br + (require "reader.rkt") + (provide read-syntax)) diff --git a/parser.rkt b/parser.rkt new file mode 100644 index 0000000..b5dede7 --- /dev/null +++ b/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 : "<" | ">" diff --git a/reader.rkt b/reader.rkt new file mode 100644 index 0000000..6589469 --- /dev/null +++ b/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) diff --git a/tmUtils.rkt b/tmUtils.rkt new file mode 100644 index 0000000..b3308d2 --- /dev/null +++ b/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))