From 21aee3f090ed5550d6f325cd9234b9011b527497 Mon Sep 17 00:00:00 2001 From: Claudio Maggioni Date: Sun, 2 Dec 2018 18:05:50 +0100 Subject: [PATCH] added line numbers to gui + a bunch of refactoring --- .gitignore | 1 + gui.rkt | 68 ++++++---- interpreter.rkt | 324 ++++++++++++++++++++++++++++++++++++++++++++++++ main.rkt | 310 ++++++++++++++++++++++----------------------- 4 files changed, 516 insertions(+), 187 deletions(-) create mode 100644 interpreter.rkt diff --git a/.gitignore b/.gitignore index f2443da..b6bc92a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ *~ +compiled/* .cache .vagrant diff --git a/gui.rkt b/gui.rkt index cc7e3fd..6215bb5 100644 --- a/gui.rkt +++ b/gui.rkt @@ -1,6 +1,7 @@ #lang racket/gui -(require "main.rkt") +(require "interpreter.rkt" + framework) ; The editor width in pixels (define EDITOR-WIDTH 600) @@ -12,39 +13,60 @@ [width EDITOR-WIDTH] [height EDITOR-HEIGHT])) -; execute-content: -> World +; execute-content: -> ProgState ; Returns the last state of execution of the program loaded in the editor (define (execute-content) (execute - (program->world + (program->prog-state (string->program - (send t get-flattened-text))))) + (send editor get-flattened-text))))) ; The run button -(define button (new button% [parent f] - [label "Run"] - ; Callback procedure for a button click: - [callback (lambda (button event) - (send - output set-label - (world-output (execute-content))))])) +(define run-btn (new button% [parent f] + [label "Run"] + ; Callback procedure for a button click: + [callback + (lambda (button event) + ; empty output text and set color to running + (send run-output set-value "") + (send run-output set-field-background run-col) + + ; run the program + (define out (prog-state-output (execute-content))) + + ; set output and change color to ended + (send run-output set-value out) + (send run-output set-field-background end-col))])) (define c (new editor-canvas% [parent f])) ; The editor text object -(define t (new text%)) +(define text-ln% (text:line-numbers-mixin + (editor:standard-style-list-mixin text%))) +(define editor (new text-ln%)) + +; Show line numbers in editor +(send editor show-line-numbers! #t) + +; Change font to monospace 16 +(send editor change-style (make-object style-delta% 'change-size 16)) +(send editor change-style (make-object style-delta% 'change-family 'modern)) + +; Running output color +(define run-col (make-object color% 250 250 200)) + +; Output completed color +(define end-col (make-object color% 200 250 200)) -; Change font to monospace -(define style-delta (make-object style-delta% 'change-family 'modern)) -(send t change-style style-delta) - (define mb (new menu-bar% [parent f])) (define m-file (new menu% [label "File"] [parent mb])) (define m-edit (new menu% [label "Edit"] [parent mb])) -; Make a static text message in the frame -(define output (new message% [parent f] - [label "Click run to get output"])) +; The run output text object +(define run-output (new text-field% + [style (list 'multiple 'vertical-label)] + [label "Execution output:"] + [parent f])) (define mi-open (new menu-item% @@ -54,7 +76,7 @@ (lambda (i e) (define path (get-file #f f)) (when path - (send t load-file path 'text)))] + (send editor load-file path 'text)))] [shortcut #\o] [shortcut-prefix '(ctl)])) @@ -64,11 +86,11 @@ [parent m-file] [callback (lambda (i e) - (send t save-file #f 'text))] + (send editor save-file #f 'text))] [shortcut #\s] [shortcut-prefix '(ctl)])) (append-editor-operation-menu-items m-edit #f) -(send t set-max-undo-history 100) -(send c set-editor t) +(send editor set-max-undo-history 100) +(send c set-editor editor) (send f show #t) \ No newline at end of file diff --git a/interpreter.rkt b/interpreter.rkt new file mode 100644 index 0000000..ae3c36d --- /dev/null +++ b/interpreter.rkt @@ -0,0 +1,324 @@ +#lang racket + +; 2018-11-21 - Made by Claudio Maggioni - Tommaso Rodolfo Masera +; easybf + +(require racket/base + racket/struct + test-engine/racket-tests) + +(provide prog-state + prog-state? + prog-state-tape + prog-state-dp + prog-state-output + prog-state-program + prog-state-ip + execute + string->program + program->prog-state) + +; A Byte is an Int between 0 and 255 +; Interpretation: a byte in decimal notation. + +; A Tape is a NEList +; Interpretation: a tape in brainf*ck's Turing machine. + +; A DataPointer (DP) is a NonNegInt +; Interpretation: a data pointer in the brainf*ck language in a tape. + +; A Program is a String of: +; - ">" (tape-right) +; - "<" (tape-left) +; - "+" (add1) +; - "-" (sub1) +; - "." (out) +; - "," +; - "[" (loop-start) +; - "]" (loop-end) +; Interpretation: the brainf*ck program. + +; A InstructionPointer (IP) is a NonNegInt +; Interpretation: a pointer to the instruction to execute. + +; A ProgState is a (prog-state tape dp output program ip) where: +; - tape: Tape +; - dp: DataPointer +; - tape-len: Nat +; - output: String +; - program: Program +; - ip: InstructionPointer +; Interpretation: the current state of execution of a brainf*ck program. +(struct prog-state (tape dp tape-len output program ip) + #:transparent + #:methods gen:custom-write + [(define write-proc + (make-constructor-style-printer + (lambda (w) 'ProgState) + (lambda (w) (list (prog-state-tape w) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (prog-state-ip w)))))]) + +; Template function for ProgState +#;(define (fn-for-prog-state w) +#; (... (prog-state-tape w) +#; (prog-state-dp w) +#; (prog-state-tape-len w) +#; (prog-state-output w) +#; (prog-state-program w) +#; (prog-state-ip w))) + +; string->program: String -> Program +; Given a string, returns a bf program without any invalid character +(define (string->program s) + (local [; valid-char: Char -> Boolean + ; Given a valid-char, returns #t if the character is a valid bf + ; instruction. + (define (valid-char? s) + (ormap (lambda (x) (char=? s x)) + '(#\> #\< #\+ #\- #\, #\. #\[ #\])))] + (list->string (filter valid-char? (string->list s))))) + +; Tests for string->program +(check-expect (string->program "hello") "") +(check-expect (string->program "+ProgState50-[]") "+-[]") +(check-expect (string->program "") "") + +; add1-byte: Byte -> Byte +; Given a byte, returns the byte+1 simulating overflows +(define (add1-byte b) + (modulo (add1 b) 256)) + +; Tests for add1-byte +(check-expect (add1-byte 255) 0) +(check-expect (add1-byte 254) 255) + +; sub1-byte: Byte -> Byte +; Given a byte, returns the byte-1 simulating underflows +(define (sub1-byte b) + (cond [(zero? b) 255] + [else (sub1 b)])) + +; Tests for sub1-byte +(check-expect (sub1-byte 0) 255) +(check-expect (sub1-byte 1) 0) + +; program->prog-state: Program -> ProgState +; Given a program, returns the corresponding initial ProgState state. +(define (program->prog-state p) + (prog-state (cons 0 '()) 0 1 "" p 0)) + +; Tests for program->prog-state +(check-expect (program->prog-state "[->+<]") (prog-state (list 0) 0 1 "" "[->+<]" 0)) + +; tape-help: Tape DP (Byte -> Byte) -> Tape +; Given a tape and a data pointer, returns the same tape with the data in the +; location of the data pointer altered by the function `alter`. +(define (tape-help tape dp alter) + (cond [(zero? dp) (cons (alter (first tape)) (rest tape))] + [else (cons (first tape) (tape-help (rest tape) (sub1 dp) alter))])) + +; Tests for tape-help +(check-expect (tape-help (list 0) 0 add1-byte) (list 1)) +(check-expect (tape-help (list 0 1 2 3) 2 sub1-byte) (list 0 1 1 3)) + +; exec-add1: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the + instruction executed +(define (exec-add1 w) + (prog-state (tape-help (prog-state-tape w) (prog-state-dp w) add1-byte) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (add1 (prog-state-ip w)))) + +; Tests for exec-add1 +(check-expect (exec-add1 (prog-state + (list 1 2 3 4 5 6 7) 3 7 "" "+" 0)) + (prog-state (list 1 2 3 5 5 6 7) 3 7 "" "+" 1)) +(check-expect (exec-add1 (prog-state + (list 255 1 2 3) 0 4 "" "+" 0)) + (prog-state (list 0 1 2 3) 0 4 "" "+" 1)) + +; exec-sub1: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the - instruction executed +(define (exec-sub1 w) + (prog-state (tape-help (prog-state-tape w) (prog-state-dp w) sub1-byte) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (add1 (prog-state-ip w)))) + +; Tests for exec-sub1 +(check-expect (exec-sub1 (prog-state + (list 1 2 3 4 5 6 7) 3 7 "" "-" 0)) + (prog-state (list 1 2 3 3 5 6 7) 3 7 "" "-" 1)) +(check-expect (exec-sub1 (prog-state + (list 0 1 2 3) 0 4 "" "-" 0)) + (prog-state (list 255 1 2 3) 0 4 "" "-" 1)) + +; exec-tape-left: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the < instruction executed +(define (exec-tape-left w) + (if (zero? (prog-state-dp w)) + (error "Can't access negative tape positions") + (prog-state (prog-state-tape w) + (sub1 (prog-state-dp w)) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (add1 (prog-state-ip w))))) + +; Tests for exec-tape-left +(check-error (exec-tape-left (prog-state (list 1 2 3) 0 3 "" "<" 0))) +(check-expect (exec-tape-left (prog-state (list 1 2 3) 2 3 "" "<" 0)) + (prog-state (list 1 2 3) 1 3 "" "<" 1)) + +; exec-tape-right: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the > instruction executed +(define (exec-tape-right w) + (local [(define end-of-tape (= (prog-state-dp w) (sub1 (prog-state-tape-len w))))] + (prog-state + (if end-of-tape + (append (prog-state-tape w) (list 0)) + (prog-state-tape w)) + (add1 (prog-state-dp w)) + (if end-of-tape + (add1 (prog-state-tape-len w)) + (prog-state-tape-len w)) + (prog-state-output w) + (prog-state-program w) + (add1 (prog-state-ip w))))) + +; Tests for exec-tape-right +(check-expect (exec-tape-right (prog-state (list 1 2 3) 0 3 "" ">" 0)) + (prog-state (list 1 2 3) 1 3 "" ">" 1)) +(check-expect (exec-tape-right (prog-state (list 0 1 2) 2 3 "" ">" 0)) + (prog-state (list 0 1 2 0) 3 4 "" ">" 1)) + +; exec-out: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the . instruction executed +(define (exec-out w) + (prog-state + (prog-state-tape w) + (prog-state-dp w) + (prog-state-tape-len w) + (string-append + (prog-state-output w) + (list->string + (list (integer->char (list-ref (prog-state-tape w) (prog-state-dp w)))))) + (prog-state-program w) + (add1 (prog-state-ip w)))) + +; Tests for exec-out +(check-expect (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0)) + (prog-state (list 50) 0 1 "2" ".[->+<]" 1)) +(check-expect (exec-out (prog-state (list 65) 0 1 "" ".[->+<]" 0)) + (prog-state (list 65) 0 1 "A" ".[->+<]" 1)) + +; char-at: String Nat -> 1String +; Given a string and an index, returns the 1String at the position pointed by +; index +(define (char-at s i) + (substring s i (add1 i))) + +; Tests for char-at +(check-expect (char-at "malusa" 2) "l") +(check-error (char-at "another string" 300)) + +; find-first: 1String String Nat (Nat -> Nat) -> Nat +; Given a 1String `char`, a String `string` and a start index, returns +; the position of the first occurrence of `char` in `string` starting from the +; index walking the string changing the index using the `walk` function. +(define (find-first char string start walk) + (cond [(string=? (substring string start (add1 start)) + char) start] + [else (find-first char string (walk start) walk)])) + +; Tests for find-first +(check-expect (find-first "]" "[++++++---->><-]++++]+--" 0 add1) + 15) +(check-expect (find-first "]" "[+++++][+---->><-]++++]+--" 7 add1) + 17) +(check-expect (find-first "[" "[+++++][+---->><-]++++]+--" 17 sub1) + 7) + + +; exec-loop-start: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the [ instruction executed +(define (exec-loop-start w) + (local [(define jump (zero? (list-ref (prog-state-tape w) (prog-state-dp w))))] + (prog-state + (prog-state-tape w) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (add1 (if jump + (find-first "]" (prog-state-program w) (prog-state-ip w) add1) + (prog-state-ip w)))))) + +; Tests for exec-loop-start +(check-expect (exec-loop-start + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 0)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6)) +(check-expect (exec-loop-start + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 0)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) + +; exec-loop-end: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the ] instruction executed +(define (exec-loop-end w) + (local [(define jump (not (zero? (list-ref (prog-state-tape w) (prog-state-dp w)))))] + (prog-state + (prog-state-tape w) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (add1 (if jump + (find-first "[" (prog-state-program w) (prog-state-ip w) sub1) + (prog-state-ip w)))))) + +; Tests for exec-loop-end +(check-expect (exec-loop-end + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 5)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6)) +(check-expect (exec-loop-end + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 5)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) + +; execute: ProgState -> ProgState +; Given an initial ProgState state, returns the final ProgState state executing the +; program. +(define (execute w) + (local [(define program-len (string-length (prog-state-program w)))] + (cond [(>= (prog-state-ip w) program-len) w] + [else + (local [(define inst + (char-at (prog-state-program w) (prog-state-ip w)))] + (execute (cond [(string=? inst "+") (exec-add1 w)] + [(string=? inst "-") (exec-sub1 w)] + [(string=? inst "<") (exec-tape-left w)] + [(string=? inst ">") (exec-tape-right w)] + [(string=? inst "[") (exec-loop-start w)] + [(string=? inst "]") (exec-loop-end w)] + [(string=? inst ".") (exec-out w)] + [(string=? inst ",") #f])))]))) + +; Tests for execute +(check-expect (execute (prog-state (list 0) 0 3 "" "" 0)) + (prog-state (list 0) 0 3 "" "" 0)) +; assert that 5+2 to ASCII = "7" (WTF) +(check-expect (execute (prog-state (list 0) 0 1 "" + "++>+++++[<+>-]++++++++[<++++++>-]<." 0)) + (prog-state (list 55 0) 0 2 "7" + "++>+++++[<+>-]++++++++[<++++++>-]<." 35)) +; Run tests +(test) + +; TODO: fix matching bracket bug diff --git a/main.rkt b/main.rkt index a8c663e..ae3c36d 100644 --- a/main.rkt +++ b/main.rkt @@ -3,24 +3,20 @@ ; 2018-11-21 - Made by Claudio Maggioni - Tommaso Rodolfo Masera ; easybf -(require racket/base) -(require racket/struct) -(require test-engine/racket-tests) -(require 2htdp/batch-io) -(require 2htdp/image) -(require 2htdp/universe) +(require racket/base + racket/struct + test-engine/racket-tests) -(provide main) -(provide world) -(provide world?) -(provide world-tape) -(provide world-dp) -(provide world-output) -(provide world-program) -(provide world-ip) -(provide execute) -(provide string->program) -(provide program->world) +(provide prog-state + prog-state? + prog-state-tape + prog-state-dp + prog-state-output + prog-state-program + prog-state-ip + execute + string->program + program->prog-state) ; A Byte is an Int between 0 and 255 ; Interpretation: a byte in decimal notation. @@ -45,7 +41,7 @@ ; A InstructionPointer (IP) is a NonNegInt ; Interpretation: a pointer to the instruction to execute. -; A World is a (world tape dp output program ip) where: +; A ProgState is a (prog-state tape dp output program ip) where: ; - tape: Tape ; - dp: DataPointer ; - tape-len: Nat @@ -53,31 +49,30 @@ ; - program: Program ; - ip: InstructionPointer ; Interpretation: the current state of execution of a brainf*ck program. -(struct world (tape dp tape-len output program ip) +(struct prog-state (tape dp tape-len output program ip) #:transparent #:methods gen:custom-write [(define write-proc (make-constructor-style-printer - (lambda (w) 'world) - (lambda (w) (list (world-tape w) - (world-dp w) - (world-tape-len w) - (world-output w) - (world-program w) - (world-ip w)))))]) + (lambda (w) 'ProgState) + (lambda (w) (list (prog-state-tape w) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (prog-state-ip w)))))]) -; Template function for World -#;(define (fn-for-world w) -#; (... (world-tape w) -#; (world-dp w) -#; (world-tape-len w) -#; (world-output w) -#; (world-program w) -#; (world-ip w))) +; Template function for ProgState +#;(define (fn-for-prog-state w) +#; (... (prog-state-tape w) +#; (prog-state-dp w) +#; (prog-state-tape-len w) +#; (prog-state-output w) +#; (prog-state-program w) +#; (prog-state-ip w))) ; string->program: String -> Program -; Given a string, returns a b(world-dp-len w)f program without -; any invalid character +; Given a string, returns a bf program without any invalid character (define (string->program s) (local [; valid-char: Char -> Boolean ; Given a valid-char, returns #t if the character is a valid bf @@ -89,7 +84,7 @@ ; Tests for string->program (check-expect (string->program "hello") "") -(check-expect (string->program "+world50-[]") "+-[]") +(check-expect (string->program "+ProgState50-[]") "+-[]") (check-expect (string->program "") "") ; add1-byte: Byte -> Byte @@ -111,13 +106,13 @@ (check-expect (sub1-byte 0) 255) (check-expect (sub1-byte 1) 0) -; program->world: Program -> World -; Given a program, returns the corresponding initial world state. -(define (program->world p) - (world (cons 0 '()) 0 1 "" p 0)) +; program->prog-state: Program -> ProgState +; Given a program, returns the corresponding initial ProgState state. +(define (program->prog-state p) + (prog-state (cons 0 '()) 0 1 "" p 0)) -; Tests for program->world -(check-expect (program->world "[->+<]") (world (list 0) 0 1 "" "[->+<]" 0)) +; Tests for program->prog-state +(check-expect (program->prog-state "[->+<]") (prog-state (list 0) 0 1 "" "[->+<]" 0)) ; tape-help: Tape DP (Byte -> Byte) -> Tape ; Given a tape and a data pointer, returns the same tape with the data in the @@ -130,100 +125,100 @@ (check-expect (tape-help (list 0) 0 add1-byte) (list 1)) (check-expect (tape-help (list 0 1 2 3) 2 sub1-byte) (list 0 1 1 3)) -; exec-add1: World -> World -; Given a world, returns a new world with the + instruction executed +; exec-add1: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the + instruction executed (define (exec-add1 w) - (world (tape-help (world-tape w) (world-dp w) add1-byte) - (world-dp w) - (world-tape-len w) - (world-output w) - (world-program w) - (add1 (world-ip w)))) + (prog-state (tape-help (prog-state-tape w) (prog-state-dp w) add1-byte) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (add1 (prog-state-ip w)))) ; Tests for exec-add1 -(check-expect (exec-add1 (world +(check-expect (exec-add1 (prog-state (list 1 2 3 4 5 6 7) 3 7 "" "+" 0)) - (world (list 1 2 3 5 5 6 7) 3 7 "" "+" 1)) -(check-expect (exec-add1 (world + (prog-state (list 1 2 3 5 5 6 7) 3 7 "" "+" 1)) +(check-expect (exec-add1 (prog-state (list 255 1 2 3) 0 4 "" "+" 0)) - (world (list 0 1 2 3) 0 4 "" "+" 1)) + (prog-state (list 0 1 2 3) 0 4 "" "+" 1)) -; exec-sub1: World -> World -; Given a world, returns a new world with the - instruction executed +; exec-sub1: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the - instruction executed (define (exec-sub1 w) - (world (tape-help (world-tape w) (world-dp w) sub1-byte) - (world-dp w) - (world-tape-len w) - (world-output w) - (world-program w) - (add1 (world-ip w)))) + (prog-state (tape-help (prog-state-tape w) (prog-state-dp w) sub1-byte) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (add1 (prog-state-ip w)))) ; Tests for exec-sub1 -(check-expect (exec-sub1 (world +(check-expect (exec-sub1 (prog-state (list 1 2 3 4 5 6 7) 3 7 "" "-" 0)) - (world (list 1 2 3 3 5 6 7) 3 7 "" "-" 1)) -(check-expect (exec-sub1 (world + (prog-state (list 1 2 3 3 5 6 7) 3 7 "" "-" 1)) +(check-expect (exec-sub1 (prog-state (list 0 1 2 3) 0 4 "" "-" 0)) - (world (list 255 1 2 3) 0 4 "" "-" 1)) + (prog-state (list 255 1 2 3) 0 4 "" "-" 1)) -; exec-tape-left: World -> World -; Given a world, returns a new world with the < instruction executed +; exec-tape-left: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the < instruction executed (define (exec-tape-left w) - (if (zero? (world-dp w)) + (if (zero? (prog-state-dp w)) (error "Can't access negative tape positions") - (world (world-tape w) - (sub1 (world-dp w)) - (world-tape-len w) - (world-output w) - (world-program w) - (add1 (world-ip w))))) + (prog-state (prog-state-tape w) + (sub1 (prog-state-dp w)) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) + (add1 (prog-state-ip w))))) ; Tests for exec-tape-left -(check-error (exec-tape-left (world (list 1 2 3) 0 3 "" "<" 0))) -(check-expect (exec-tape-left (world (list 1 2 3) 2 3 "" "<" 0)) - (world (list 1 2 3) 1 3 "" "<" 1)) +(check-error (exec-tape-left (prog-state (list 1 2 3) 0 3 "" "<" 0))) +(check-expect (exec-tape-left (prog-state (list 1 2 3) 2 3 "" "<" 0)) + (prog-state (list 1 2 3) 1 3 "" "<" 1)) -; exec-tape-right: World -> World -; Given a world, returns a new world with the > instruction executed +; exec-tape-right: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the > instruction executed (define (exec-tape-right w) - (local [(define end-of-tape (= (world-dp w) (sub1 (world-tape-len w))))] - (world + (local [(define end-of-tape (= (prog-state-dp w) (sub1 (prog-state-tape-len w))))] + (prog-state (if end-of-tape - (append (world-tape w) (list 0)) - (world-tape w)) - (add1 (world-dp w)) + (append (prog-state-tape w) (list 0)) + (prog-state-tape w)) + (add1 (prog-state-dp w)) (if end-of-tape - (add1 (world-tape-len w)) - (world-tape-len w)) - (world-output w) - (world-program w) - (add1 (world-ip w))))) + (add1 (prog-state-tape-len w)) + (prog-state-tape-len w)) + (prog-state-output w) + (prog-state-program w) + (add1 (prog-state-ip w))))) ; Tests for exec-tape-right -(check-expect (exec-tape-right (world (list 1 2 3) 0 3 "" ">" 0)) - (world (list 1 2 3) 1 3 "" ">" 1)) -(check-expect (exec-tape-right (world (list 0 1 2) 2 3 "" ">" 0)) - (world (list 0 1 2 0) 3 4 "" ">" 1)) +(check-expect (exec-tape-right (prog-state (list 1 2 3) 0 3 "" ">" 0)) + (prog-state (list 1 2 3) 1 3 "" ">" 1)) +(check-expect (exec-tape-right (prog-state (list 0 1 2) 2 3 "" ">" 0)) + (prog-state (list 0 1 2 0) 3 4 "" ">" 1)) -; exec-out: World -> World -; Given a world, returns a new world with the . instruction executed +; exec-out: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the . instruction executed (define (exec-out w) - (world - (world-tape w) - (world-dp w) - (world-tape-len w) + (prog-state + (prog-state-tape w) + (prog-state-dp w) + (prog-state-tape-len w) (string-append - (world-output w) + (prog-state-output w) (list->string - (list (integer->char (list-ref (world-tape w) (world-dp w)))))) - (world-program w) - (add1 (world-ip w)))) + (list (integer->char (list-ref (prog-state-tape w) (prog-state-dp w)))))) + (prog-state-program w) + (add1 (prog-state-ip w)))) ; Tests for exec-out -(check-expect (exec-out (world (list 50) 0 1 "" ".[->+<]" 0)) - (world (list 50) 0 1 "2" ".[->+<]" 1)) -(check-expect (exec-out (world (list 65) 0 1 "" ".[->+<]" 0)) - (world (list 65) 0 1 "A" ".[->+<]" 1)) +(check-expect (exec-out (prog-state (list 50) 0 1 "" ".[->+<]" 0)) + (prog-state (list 50) 0 1 "2" ".[->+<]" 1)) +(check-expect (exec-out (prog-state (list 65) 0 1 "" ".[->+<]" 0)) + (prog-state (list 65) 0 1 "A" ".[->+<]" 1)) ; char-at: String Nat -> 1String ; Given a string and an index, returns the 1String at the position pointed by @@ -253,59 +248,59 @@ 7) -; exec-loop-start: World -> World -; Given a world, returns a new world with the [ instruction executed +; exec-loop-start: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the [ instruction executed (define (exec-loop-start w) - (local [(define jump (zero? (list-ref (world-tape w) (world-dp w))))] - (world - (world-tape w) - (world-dp w) - (world-tape-len w) - (world-output w) - (world-program w) + (local [(define jump (zero? (list-ref (prog-state-tape w) (prog-state-dp w))))] + (prog-state + (prog-state-tape w) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) (add1 (if jump - (find-first "]" (world-program w) (world-ip w) add1) - (world-ip w)))))) + (find-first "]" (prog-state-program w) (prog-state-ip w) add1) + (prog-state-ip w)))))) ; Tests for exec-loop-start (check-expect (exec-loop-start - (world '(0) 0 1 "" "[++--]++--+-[]" 0)) - (world '(0) 0 1 "" "[++--]++--+-[]" 6)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 0)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6)) (check-expect (exec-loop-start - (world '(1) 0 1 "" "[++--]++--+-[]" 0)) - (world '(1) 0 1 "" "[++--]++--+-[]" 1)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 0)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) -; exec-loop-end: World -> World -; Given a world, returns a new world with the ] instruction executed +; exec-loop-end: ProgState -> ProgState +; Given a ProgState, returns a new ProgState with the ] instruction executed (define (exec-loop-end w) - (local [(define jump (not (zero? (list-ref (world-tape w) (world-dp w)))))] - (world - (world-tape w) - (world-dp w) - (world-tape-len w) - (world-output w) - (world-program w) + (local [(define jump (not (zero? (list-ref (prog-state-tape w) (prog-state-dp w)))))] + (prog-state + (prog-state-tape w) + (prog-state-dp w) + (prog-state-tape-len w) + (prog-state-output w) + (prog-state-program w) (add1 (if jump - (find-first "[" (world-program w) (world-ip w) sub1) - (world-ip w)))))) + (find-first "[" (prog-state-program w) (prog-state-ip w) sub1) + (prog-state-ip w)))))) ; Tests for exec-loop-end (check-expect (exec-loop-end - (world '(0) 0 1 "" "[++--]++--+-[]" 5)) - (world '(0) 0 1 "" "[++--]++--+-[]" 6)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 5)) + (prog-state '(0) 0 1 "" "[++--]++--+-[]" 6)) (check-expect (exec-loop-end - (world '(1) 0 1 "" "[++--]++--+-[]" 5)) - (world '(1) 0 1 "" "[++--]++--+-[]" 1)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 5)) + (prog-state '(1) 0 1 "" "[++--]++--+-[]" 1)) -; execute: World -> World -; Given an initial World state, returns the final World state executing the +; execute: ProgState -> ProgState +; Given an initial ProgState state, returns the final ProgState state executing the ; program. (define (execute w) - (local [(define program-len (string-length (world-program w)))] - (cond [(>= (world-ip w) program-len) w] + (local [(define program-len (string-length (prog-state-program w)))] + (cond [(>= (prog-state-ip w) program-len) w] [else (local [(define inst - (char-at (world-program w) (world-ip w)))] + (char-at (prog-state-program w) (prog-state-ip w)))] (execute (cond [(string=? inst "+") (exec-add1 w)] [(string=? inst "-") (exec-sub1 w)] [(string=? inst "<") (exec-tape-left w)] @@ -316,27 +311,14 @@ [(string=? inst ",") #f])))]))) ; Tests for execute -(check-expect (execute (world (list 0) 0 3 "" "" 0)) - (world (list 0) 0 3 "" "" 0)) +(check-expect (execute (prog-state (list 0) 0 3 "" "" 0)) + (prog-state (list 0) 0 3 "" "" 0)) ; assert that 5+2 to ASCII = "7" (WTF) -(check-expect (execute (world (list 0) 0 1 "" +(check-expect (execute (prog-state (list 0) 0 1 "" "++>+++++[<+>-]++++++++[<++++++>-]<." 0)) - (world (list 55 0) 0 2 "7" + (prog-state (list 55 0) 0 2 "7" "++>+++++[<+>-]++++++++[<++++++>-]<." 35)) - - -; main: Filename -> World -; Given a Filename, return the last world state of execution of the -; corresponding bf program in the file -(define (main file) - (execute (program->world (string->program (read-file file))))) - +; Run tests (test) -; TODO: -; fix matching bracket bug -; - big-bang: -; - - - - - - inital state (world (list 0) 0 "" 0) -; - - - - - - on-tick fetch, decode, execute -; - - - - - - on-key for "," -; - - - - - - (on-mouse for stepper) -; - - - - - - (draw-scene for output and tape) + +; TODO: fix matching bracket bug