Implemented very basic (and ugly) stepper
This commit is contained in:
parent
ed0281d240
commit
c19a9da695
2 changed files with 78 additions and 11 deletions
68
gui.rkt
68
gui.rkt
|
@ -16,7 +16,7 @@
|
||||||
[width EDITOR-WIDTH]
|
[width EDITOR-WIDTH]
|
||||||
[height EDITOR-HEIGHT]))
|
[height EDITOR-HEIGHT]))
|
||||||
|
|
||||||
; execute-content: ((ProgState) -> _) -> _
|
; execute-content: (ProgState -> _) -> _
|
||||||
; Given a callback, calls the callback with the last state of execution of the
|
; Given a callback, calls the callback with the last state of execution of the
|
||||||
; program loaded in the editor
|
; program loaded in the editor
|
||||||
(define (execute-content done)
|
(define (execute-content done)
|
||||||
|
@ -26,6 +26,42 @@
|
||||||
(send EDITOR get-flattened-text)))
|
(send EDITOR get-flattened-text)))
|
||||||
done on-input))
|
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 -> _) -> _
|
; on-input: (Byte -> _) -> _
|
||||||
; Given a a callback to resume execution, sets up the run input area (callback
|
; Given a a callback to resume execution, sets up the run input area (callback
|
||||||
; included).
|
; included).
|
||||||
|
@ -67,6 +103,19 @@
|
||||||
(update-state-gui ps)
|
(update-state-gui ps)
|
||||||
(send RUN-OUTPUT set-field-background end-col))))
|
(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 -> _
|
; update-state-gui: ProgState -> _
|
||||||
; Given a prog-state, updates the data tape inspector and the output window with
|
; Given a prog-state, updates the data tape inspector and the output window with
|
||||||
; the contents of that prog-state.
|
; the contents of that prog-state.
|
||||||
|
@ -77,11 +126,26 @@
|
||||||
; set output and change color to ended
|
; set output and change color to ended
|
||||||
(send RUN-OUTPUT set-value out))
|
(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
|
; Definition of the run button widget
|
||||||
(define RUN-BTN (new button% [parent F]
|
(define RUN-BTN (new button% [parent BUTTON-PANEL]
|
||||||
[label "Run"]
|
[label "Run"]
|
||||||
; Callback procedure for a button click:
|
; Callback procedure for a button click:
|
||||||
[callback run-program]))
|
[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
|
; Definition of the editor canves
|
||||||
(define C (new editor-canvas% [parent F]))
|
(define C (new editor-canvas% [parent F]))
|
||||||
|
|
|
@ -373,10 +373,11 @@
|
||||||
(lambda (done) (done 50))
|
(lambda (done) (done 50))
|
||||||
(lambda (w) (check-equal? w (prog-state (list 50) 0 1 "," "" 1 #f)))))
|
(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"
|
; Given an initial ProgState state, an async function to get input and a "done"
|
||||||
; callback, calls done with the ProgState updated after executing one
|
; 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)
|
(define (execute-instr prog done get-input)
|
||||||
|
|
||||||
; execute-sync: Char ProgState -> ProgState
|
; execute-sync: Char ProgState -> ProgState
|
||||||
|
@ -391,13 +392,15 @@
|
||||||
[(char=? inst #\]) (exec-loop-end w)]
|
[(char=? inst #\]) (exec-loop-end w)]
|
||||||
[(char=? inst #\.) (exec-out w)]))
|
[(char=? inst #\.) (exec-out w)]))
|
||||||
|
|
||||||
; Fetch current instruction
|
; Fetch current instruction. If the char is out of range, call done with #f
|
||||||
(define inst (string-ref (prog-state-program prog) (prog-state-ip prog)))
|
(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 asynchr. if ",", otherwise call callback with results of
|
||||||
; execute-sync
|
; execute-sync
|
||||||
(cond [(char=? inst #\,) (exec-in prog get-input done)]
|
(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 -> _) -> _) -> _
|
; execute: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _
|
||||||
; Given an initial ProgState state,
|
; Given an initial ProgState state,
|
||||||
|
|
Loading…
Reference in a new issue