From 8a1af32dcb4b64d812cfe19c408ec1ccc63b9f00 Mon Sep 17 00:00:00 2001 From: Claudio Maggioni Date: Wed, 12 Dec 2018 10:02:15 +0100 Subject: [PATCH 1/2] Added more tests/comments and fixed bug in stepper regarding initial state --- gui.rkt | 135 +++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 105 insertions(+), 30 deletions(-) diff --git a/gui.rkt b/gui.rkt index 27d3316..7088a53 100644 --- a/gui.rkt +++ b/gui.rkt @@ -4,7 +4,8 @@ (require "interpreter.rkt" framework racket/set - racket/block) + racket/block + rackunit) ; The editor width in pixels (define EDITOR-WIDTH 600) @@ -46,6 +47,9 @@ (define init (program->prog-state (string->program (send EDITOR get-flattened-text)))) + ; Put initial ProgState in step-stack + (set! step-stack (cons init '())) + ; Execute step (execute-instr init after-run on-input)] [(cons? step-stack) (execute-instr (first step-stack) after-run on-input)])) @@ -112,7 +116,6 @@ ; run the step (fun-to-run (lambda (ps) - (print step-stack) (update-state-gui ps) (send RUN-OUTPUT set-field-background in-done-col)))) @@ -131,6 +134,7 @@ (new horizontal-panel% [parent F] [min-height 50] + [alignment (list 'center 'center)] [stretchable-height #f])) ; Definition of the run button widget @@ -138,14 +142,18 @@ [label "Run"] ; Callback procedure for a button click: [callback run-program])) -(define BSTEP-BTN (new button% [parent BUTTON-PANEL] - [label "Step Back"] - ; Callback procedure for a button click: - [callback run-step])) +(define STEP-BACK-BTN (new button% [parent BUTTON-PANEL] + [label "Step Back"] + ; Callback procedure for a button click: + [callback run-step])) (define STEP-BTN (new button% [parent BUTTON-PANEL] - [label "Step Fwd"] - ; Callback procedure for a button click: - [callback run-step])) + [label "Step Fwd"] + ; Callback procedure for a button click: + [callback run-step])) +(define STEP-STOP-BTN (new button% [parent BUTTON-PANEL] + [label "Stop Step"] + ; Callback procedure for a button click: + [callback (lambda (_ __) (set! step-stack '()))])) ; Definition of the editor canves (define C (new editor-canvas% [parent F])) @@ -168,6 +176,13 @@ ; - 'loop ; Interp: category of a bf program token +; Template for BFToken +#; (define (fn-for-bf-token t) +#; (cond [(symbol=? t 'comment) ...] +#; [(symbol=? t 'instruction) ...] +#; [(symbol=? t 'shift) ...] +#; [(symbol=? t 'loop) ...])) + ; A BFStyle is one of: ; - "Comment" ; - "Instruction" @@ -175,6 +190,13 @@ ; - "Loop" ; Interp: name of the style for a bf program token +; Template for BFToken +#; (define (fn-for-bf-style t) +#; (cond [(string=? t "Comment") ...] +#; [(string=? t "Instruction") ...] +#; [(string=? t "Shift") ...] +#; [(string=? t "Loop") ...])) + ; bf-token->bf-style: BFToken -> BFStyle ; Given a BFToken, returns the corresponding BFStyle. (define (bf-token->bf-style token) @@ -183,6 +205,12 @@ [(symbol=? token 'shift) "Shift"] [(symbol=? token 'instruction) "Instruction"])) +; Tests for bf-token->bf-style +(check-equal? (bf-token->bf-style 'comment) "Comment") +(check-equal? (bf-token->bf-style 'loop) "Loop") +(check-equal? (bf-token->bf-style 'shift) "Shift") +(check-equal? (bf-token->bf-style 'instruction) "Instruction") + ; bf-lexer: InputPort -> (values 1String BFToken #f Option Option) ; Given an input port, returns the BFToken of the instruction pointed by the ; port. @@ -197,26 +225,64 @@ [(set-member? (set "<" ">") 1str) 'shift] [(set-member? (set "[" "]") 1str) 'loop] [else 'comment])) - (values 1str bf-token #f (+ pos) (+ pos 1))])) + (values 1str bf-token #f pos (+ pos 1))])) -; Syntax highlighting for brainf*ck +; Tests from bf-lexer +(begin + (let ([program-port (open-input-string "+--+++Comment[]")]) + (define-values (a b c d e) (bf-lexer program-port)) + (check-equal? a "+") + (check-equal? b 'instruction) + (check-equal? c #f) + (check-equal? d 1) + (check-equal? e 2))) +(begin + (let ([program-port (open-input-string "--")]) + (define-values (a b c d e) (bf-lexer program-port)) + (check-equal? a "-") + (check-equal? b 'instruction) + (check-equal? c #f) + (check-equal? d 1) + (check-equal? e 2))) +(begin + (let ([program-port (open-input-string "Comments!")]) + (define-values (a b c d e) (bf-lexer program-port)) + (check-equal? a "C") + (check-equal? b 'comment) + (check-equal? c #f) + (check-equal? d 1) + (check-equal? e 2))) +(begin + (let ([program-port (open-input-string "Car<>")]) + ; Use the input port three times to use bf-lexer on the "<" char + (let-values ([(_ __ ___) (port-next-location program-port)]) (void)) + (let-values ([(_ __ ___) (port-next-location program-port)]) (void)) + (let-values ([(_ __ ___) (port-next-location program-port)]) (void)) + (define-values (a b c d e) (bf-lexer program-port)) + (check-equal? a "C") + (check-equal? b 'comment) + (check-equal? c #f) + (check-equal? d 1) + (check-equal? e 2))) + +; Enable syntax highlighting for brainf*ck (with lexer) (send EDITOR start-colorer bf-token->bf-style bf-lexer '()) -; Define basic style for instructions (+ - , .) +; Define style for instructions (+ - , .) (define delta (make-object style-delta%)) -(send delta set-delta-foreground "blue") +(void (send delta set-delta-foreground "blue")) (editor:set-standard-style-list-delta "Instruction" delta) ; Define style for shifting operations (< >) -(send delta set-delta-foreground "red") +(void (send delta set-delta-foreground "red")) (editor:set-standard-style-list-delta "Shift" delta) -; Define basic style for looping instructions ([ ]) -(send delta set-delta-foreground "forestgreen") +; Define style for looping instructions ([ ]) +(void (send delta set-delta-foreground "forestgreen")) (editor:set-standard-style-list-delta "Loop" delta) ; Define style of comments -(send delta set-delta-foreground "orange") +(void (send delta set-delta-foreground "orange")) (editor:set-standard-style-list-delta "Comment" delta) ; Input done color @@ -228,11 +294,6 @@ ; Output completed color (define end-col (make-object color% 200 250 200)) -; Populate menu bar -(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])) - ; The tape panel (define tape-panel (new horizontal-panel% @@ -257,7 +318,7 @@ (send c set-canvas-background (if hl end-col run-col)) (send dc draw-text (send c get-label) 12.5 10) (send dc draw-text content 12.5 30))])) - + ; make-tape-cells: ProgState -> _ ; Given a ProgState, empties the data tape inspector and creates the ; corresponding cells as canvasas in the tape inspector. @@ -296,10 +357,18 @@ [label "Execution output:"] [parent F])) -(define mi-open +; Populate menu bar +(define MB (new menu-bar% [parent F])) + +; Create "File" and "Edit" menu "lists" +(define FILE-MENU (new menu% [label "File"] [parent MB])) +(define EDIT-MENU (new menu% [label "Edit"] [parent MB])) + +; Menu element for opening a new file +(define MENU-OPEN (new menu-item% [label "Open"] - [parent m-file] + [parent FILE-MENU] [callback (lambda (i e) (define path (get-file #f F)) @@ -307,18 +376,24 @@ (send EDITOR load-file path 'text)))] [shortcut #\o] [shortcut-prefix '(ctl)])) - -(define mi-save + +; Menu element for saving the current file +(define MENU-SAVE (new menu-item% [label "Save"] - [parent m-file] + [parent FILE-MENU] [callback (lambda (i e) (send EDITOR save-file #f 'text))] [shortcut #\s] [shortcut-prefix '(ctl)])) - -(append-editor-operation-menu-items m-edit #f) + +; Add default menu elements to "edit" menu +(append-editor-operation-menu-items EDIT-MENU #f) + +; Set max undo history for editor (send EDITOR set-max-undo-history 100) + +; Init editor (send C set-editor EDITOR) (send F show #t) From 0034de018b8103ee16d5bf95df7000a4f7e91780 Mon Sep 17 00:00:00 2001 From: Claudio Maggioni Date: Wed, 12 Dec 2018 10:21:45 +0100 Subject: [PATCH 2/2] Made execute more efficiently --- interpreter.rkt | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/interpreter.rkt b/interpreter.rkt index 31155b2..b2c3d3b 100644 --- a/interpreter.rkt +++ b/interpreter.rkt @@ -407,19 +407,17 @@ ; calls done when the final ProgState has been ; computed by executing the program (define (execute prog done get-input) - - ; The program length in characters - (define program-len (string-length (prog-state-program prog))) - ; execute-help: ProgState -> _ + ; execute-help: ProgState ProgState -> _ ; Helper function for `execute`. - ; Given an initial ProgState state, calls done - ; when the final ProgState is ready. - (define (execute-help w) - (cond [(>= (prog-state-ip w) program-len) (done w)] - [else (execute-instr w execute-help get-input)])) + ; Given an initial ProgState state, and the previous state, + ; calls done when the final ProgState is ready. + (define (execute-help w prev) + (cond [(eq? w #f) (done prev)] + [else (execute-instr w (lambda (new) (execute-help new w)) + get-input)])) - (execute-help prog)) + (execute-instr prog (lambda (new) (execute-help new prog)) get-input)) ; Tests for execute (test-begin