Implemented very basic (and ugly) stepper

This commit is contained in:
Claudio Maggioni 2018-12-11 14:51:45 +01:00
parent ed0281d240
commit c19a9da695
2 changed files with 78 additions and 11 deletions

68
gui.rkt
View file

@ -16,7 +16,7 @@
[width EDITOR-WIDTH]
[height EDITOR-HEIGHT]))
; execute-content: ((ProgState) -> _) -> _
; execute-content: (ProgState -> _) -> _
; Given a callback, calls the callback with the last state of execution of the
; program loaded in the editor
(define (execute-content done)
@ -26,6 +26,42 @@
(send EDITOR get-flattened-text)))
done on-input))
; Stack of execution for stepper (List<ProgState>)
(define step-stack '())
; execute-step: (ProgState -> _) -> _
; Given a callback, if step-stack is empty, updates step-stack as a list with
; only the first step of execution; otherwise, it computes the next step of
; execution, it puts it on top of step-stack, and calls the callback with that.
(define (execute-step done)
; after-run: Option<ProgState> -> _
; Given a ProgState, it puts it in the t.o.s. of step-stack and executes done.
(define (after-run ps)
(cond [(eq? ps #f) (void)]
[else (set! step-stack (cons ps step-stack))
(done ps)]))
(cond [(empty? step-stack)
(define init (program->prog-state
(string->program
(send EDITOR get-flattened-text))))
(execute-instr init after-run on-input)]
[(cons? step-stack)
(execute-instr (first step-stack) after-run on-input)]))
; execute-step-back: (ProgState -> _) -> _
; Given a callback, if step-stack is empty or of length 1, does nothing;
; otherwise, it fetches the previous step of execution, it puts it on top of
; step-stack (by popping and discarding the t.o.s.) and calls the callback with
; that.
(define (execute-step-back done)
(cond [(empty? step-stack) (void)]
[(empty? (rest step-stack)) (void)]
[(cons? step-stack)
(set! step-stack (rest step-stack))
(done (first step-stack))]))
; on-input: (Byte -> _) -> _
; Given a a callback to resume execution, sets up the run input area (callback
; included).
@ -67,6 +103,19 @@
(update-state-gui ps)
(send RUN-OUTPUT set-field-background end-col))))
; run-step: Button ControlEvent -> Nothing
; Given the step button pressed and an event, runs the matching step (step or
; step-back) updating the GUI.
(define (run-step b event)
; Determine matching function to run (based on the type of step)
(define fun-to-run (if (eqv? b STEP-BTN) execute-step execute-step-back))
; run the step
(fun-to-run
(lambda (ps)
(print step-stack)
(update-state-gui ps)
(send RUN-OUTPUT set-field-background in-done-col))))
; update-state-gui: ProgState -> _
; Given a prog-state, updates the data tape inspector and the output window with
; the contents of that prog-state.
@ -77,11 +126,26 @@
; set output and change color to ended
(send RUN-OUTPUT set-value out))
; The tape panel
(define BUTTON-PANEL
(new horizontal-panel%
[parent F]
[min-height 50]
[stretchable-height #f]))
; Definition of the run button widget
(define RUN-BTN (new button% [parent F]
(define RUN-BTN (new button% [parent BUTTON-PANEL]
[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-BTN (new button% [parent BUTTON-PANEL]
[label "Step Fwd"]
; Callback procedure for a button click:
[callback run-step]))
; Definition of the editor canves
(define C (new editor-canvas% [parent F]))

View file

@ -373,10 +373,11 @@
(lambda (done) (done 50))
(lambda (w) (check-equal? w (prog-state (list 50) 0 1 "," "" 1 #f)))))
; execute-instr: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _
; execute-instr: ProgState (Option<ProgState> -> _) ((Byte -> _) -> _) -> _
; Given an initial ProgState state, an async function to get input and a "done"
; callback, calls done with the ProgState updated after executing one
; instruction.
; instruction. If the program is at the last step of execution, calls done with
; #f
(define (execute-instr prog done get-input)
; execute-sync: Char ProgState -> ProgState
@ -391,13 +392,15 @@
[(char=? inst #\]) (exec-loop-end w)]
[(char=? inst #\.) (exec-out w)]))
; Fetch current instruction
; Fetch current instruction. If the char is out of range, call done with #f
(with-handlers
([exn:fail:contract? (lambda (e) (done #f))])
(define inst (string-ref (prog-state-program prog) (prog-state-ip prog)))
; Execute asynchr. if ",", otherwise call callback with results of
; execute-sync
(cond [(char=? inst #\,) (exec-in prog get-input done)]
[else (done (execute-sync inst prog))]))
[else (done (execute-sync inst prog))])))
; execute: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _
; Given an initial ProgState state,