Browse Source

first commit

master
Thorn Avery 4 years ago
commit
6288f19e93
6 changed files with 331 additions and 0 deletions
  1. +107
    -0
      README.md
  2. +60
    -0
      expander.rkt
  3. +4
    -0
      main.rkt
  4. +13
    -0
      parser.rkt
  5. +26
    -0
      reader.rkt
  6. +121
    -0
      tmUtils.rkt

+ 107
- 0
README.md View File

@@ -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`

+ 60
- 0
expander.rkt View File

@@ -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)

+ 4
- 0
main.rkt View File

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

+ 13
- 0
parser.rkt View File

@@ -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 : "<" | ">"

+ 26
- 0
reader.rkt View File

@@ -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)

+ 121
- 0
tmUtils.rkt View File

@@ -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))

Loading…
Cancel
Save