Merge branch 'master' of github.com:usi-pf1-2018/pf1-project-workingffs

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]
+(define STEP-BACK-BTN (new button% [parent BUTTON-PANEL]
-                     [label "Step Back"]
+                           [label "Step Back"]
-                     ; Callback procedure for a button click:
+                           ; Callback procedure for a button click:
-                     [callback run-step]))
+                           [callback run-step]))
 (define STEP-BTN (new button% [parent BUTTON-PANEL]
-                     [label "Step Fwd"]
+                      [label "Step Fwd"]
-                     ; Callback procedure for a button click:
+                      ; Callback procedure for a button click:
-                     [callback run-step]))
+                      [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<Nat> Option<Nat>) 
 ; 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 ([ ])
+; Define style for looping instructions ([ ])
-(send delta set-delta-foreground "forestgreen")
+(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%
@@ -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))
@@ -308,17 +377,23 @@
        [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)

interpreter.rkt

@@ -408,18 +408,16 @@
 ; computed by executing the program
 (define (execute prog done get-input)
 
-  ; The program length in characters
+  ; execute-help: ProgState ProgState -> _
-  (define program-len (string-length (prog-state-program prog)))
-
-  ; execute-help: ProgState -> _
   ; Helper function for `execute`.
-  ; Given an initial ProgState state, calls done
+  ; Given an initial ProgState state, and the previous state,
-  ; when the final ProgState is ready.
+  ; calls done when the final ProgState is ready.
-  (define (execute-help w)
+  (define (execute-help w prev)
-    (cond [(>= (prog-state-ip w) program-len) (done w)]
+    (cond [(eq? w #f) (done prev)]
-          [else (execute-instr w execute-help get-input)]))
+          [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