;; Kathi Fisler and Charles Rich ;; Stage 4 : macro front-end ;;;;;;;;;;;; THE LANGUAGE - DATA DEFINITIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; A talk is a (make-talk list[cmd]) (define-struct talk (cmds)) ;; A cmd is ;; - (make-displaycmd slide) ;; - (make-timecond (time -> boolean) list[cmd] list[cmd]) (define-struct displaycmd (slide)) (define-struct timecond (time-limit within-time over-time)) ;; a slide is a (make-slide slide-title slide-body) (define-struct slide (title body)) ;; a slide-title is either ;; - a string, or ;; - a (make-varstring string symbol) (define-struct varstring (base varname)) ;; a slide-body is either ;; - a string (paragraph), or ;; - a (make-pointlist list[string] boolean) (define-struct pointlist (points numbered?)) ;;;;;;;;;;;;;;; THE LANGUAGE - HELPERS ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; pointlist-numbered : list[string] -> pointlist ;; create numbered pointlist with given points (define (pointlist-numbered points) (make-pointlist points true)) ;; pointlist-bulleted : list[string] -> pointlist ;; create non-numbered pointlist with given points (define (pointlist-bulleted points) (make-pointlist points false)) ;; display-slide : slide -> display ;; gives another name for make-display for readability (define (display-slide slide) (make-displaycmd slide)) ;;;;;;;;;;;;;;;; THE LANGUAGE - MACROS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; macro to wrap lambda around a slide specification (define-syntax myslide (syntax-rules () [(myslide title body) (lambda () (make-slide title body))])) ;; macro to wrap list around a sequence of commands (define-syntax mytalk (syntax-rules () [(mytalk cmd1 ...) (make-talk (list cmd1 ...))])) ;; macro to move slide specifications into talk (define-syntax talk-with-slides (syntax-rules () [(talk-with-slides ((slide name1 title1 body1) ...) cmd1 ...) (let ([name1 (myslide title1 body1)] ...) (mytalk cmd1 ...))])) ;; macro to simplify specification of timeconds ;; note this has two cases: you can leave the second list off in ;; the program and the macro will insert the empty command list (define-syntax time-branch (syntax-rules () [(time-branch test cmdlist1) (make-timecond test cmdlist1 empty)] [(time-branch test cmdlist1 cmdlist2) (make-timecond test cmdlist1 cmdlist2)])) ;;;;;;;;;;;;;;;;;;;;;;;; EXAMPLE TALKS - SUCCESSIVE REFINEMENT ;;;;;;;;;;;;;;;;;;;;; (define talk3 (let ([intro-slide (lambda () (make-slide "Hand Evals in DrScheme" "Hand evaluation helps you learn how Scheme reduces programs to values"))] [arith-eg-slide (lambda () (make-slide (make-next-example-title) (make-pointlist (list "(+ (* 2 3) 6)" "(+ 6 6)" "12") false)))] [func-eg-slide (lambda () (make-slide (make-next-example-title) (make-pointlist (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" "(* (+ 5 3) 4)" "(* 8 4)" "32") false)))] [summary-slide (lambda () (make-slide "Summary: How to Hand Eval" (make-pointlist (list "Find the innermost expression" "Evaluate one step" "Repeat until have a value") true)))]) (make-talk (list (make-displaycmd intro-slide) (make-timecond (lambda (time-in-talk) (> 5 time-in-talk)) (list (make-displaycmd arith-eg-slide)) empty) (make-displaycmd func-eg-slide) (make-displaycmd summary-slide))))) (define talk4a ;remove pointlist true/false with helper functions / display-slide (let ([intro-slide (lambda () (make-slide "Hand Evals in DrScheme" "Hand evaluation helps you learn how Scheme reduces programs to values"))] [arith-eg-slide (lambda () (make-slide (make-next-example-title) (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12"))))] [func-eg-slide (lambda () (make-slide (make-next-example-title) (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" "(* (+ 5 3) 4)" "(* 8 4)" "32"))))] [summary-slide (lambda () (make-slide "Summary: How to Hand Eval" (pointlist-numbered (list "Find the innermost expression" "Evaluate one step" "Repeat until have a value"))))]) (make-talk (list (display-slide intro-slide) (make-timecond (lambda (time-in-talk) (> 5 time-in-talk)) (list (display-slide arith-eg-slide)) empty) (display-slide func-eg-slide) (display-slide summary-slide))))) (define talk4b ;remove lambda and make-slide with myslide macro (let ([intro-slide (myslide "Hand Evals in DrScheme" "Hand evaluation helps you learn how Scheme reduces programs to values")] [arith-eg-slide (myslide (make-next-example-title) (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12")))] [func-eg-slide (myslide (make-next-example-title) (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" "(* (+ 5 3) 4)" "(* 8 4)" "32")))] [summary-slide (myslide "Summary: How to Hand Eval" (pointlist-numbered (list "Find the innermost expression" "Evaluate one step" "Repeat until have a value")))]) (make-talk (list (display-slide intro-slide) (make-timecond (lambda (time-in-talk) (> 5 time-in-talk)) (list (display-slide arith-eg-slide)) empty) (display-slide func-eg-slide) (display-slide summary-slide))))) (define talk4c ;remove list with mytalk macro (let ([intro-slide (myslide "Hand Evals in DrScheme" "Hand evaluation helps you learn how Scheme reduces programs to values")] [arith-eg-slide (myslide (make-next-example-title) (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12")))] [func-eg-slide (myslide (make-next-example-title) (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" "(* (+ 5 3) 4)" "(* 8 4)" "32")))] [summary-slide (myslide "Summary: How to Hand Eval" (pointlist-numbered (list "Find the innermost expression" "Evaluate one step" "Repeat until have a value")))]) (mytalk (display-slide intro-slide) (make-timecond (lambda (time-in-talk) (> 5 time-in-talk)) (list (display-slide arith-eg-slide)) empty) (display-slide func-eg-slide) (display-slide summary-slide)))) (define talk4d ;remove let and mytalk with talk-slides macro (talk-with-slides ([slide intro-slide "Hand Evals in DrScheme" "Hand evaluation helps you learn how Scheme reduces programs to values"] [slide arith-eg-slide (make-next-example-title) (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12"))] [slide func-eg-slide (make-next-example-title) (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" "(* (+ 5 3) 4)" "(* 8 4)" "32"))] [slide summary-slide "Summary: How to Hand Eval" (pointlist-numbered (list "Find the innermost expression" "Evaluate one step" "Repeat until have a value"))]) (display-slide intro-slide) (make-timecond (lambda (time-in-talk) (> 5 time-in-talk)) (list (display-slide arith-eg-slide)) empty) (display-slide func-eg-slide) (display-slide summary-slide))) (define talk4e ;remove empty with time-branch macro (talk-with-slides ([slide intro-slide "Hand Evals in DrScheme" "Hand evaluation helps you learn how Scheme reduces programs to values"] [slide arith-eg-slide (make-next-example-title) (pointlist-bulleted (list "(+ (* 2 3) 6)" "(+ 6 6)" "12"))] [slide func-eg-slide (make-next-example-title) (pointlist-bulleted (list "(define (foo x) (+ x 3))" "(* (foo 5) 4)" "(* (+ 5 3) 4)" "(* 8 4)" "32"))] [slide summary-slide "Summary: How to Hand Eval" (pointlist-numbered (list "Find the innermost expression" "Evaluate one step" "Repeat until have a value"))]) (display-slide intro-slide) (time-branch (lambda (time-in-talk) (> 5 time-in-talk)) (list (display-slide arith-eg-slide))) (display-slide func-eg-slide) (display-slide summary-slide))) ;;;;;;;;;;;;;;;; INTERPRETER ;;;;;;;;;;;;;;;;;;;;;;;;;; (define start-time 0) (define example-index 0) ;; elapsed-time : -> number ;; returns the elapsed seconds since the recorded start time (define (elapsed-time) (- (current-seconds) start-time)) ;; make-next-example-title : -> string ;; creates string from "Example" and the current example index ;; EFFECTS: increments example-index (define (make-next-example-title) (begin (set! example-index (+ 1 example-index)) (format "Example ~a" example-index))) ;; run-talk : talk -> void ;; executes the commands in a talk then displays end-of-show message (define (run-talk a-talk) (begin (set! example-index 0) (set! start-time (current-seconds)) (run-cmdlist (talk-cmds a-talk)) (end-show))) ;; run-cmdlist : list[cmd] -> void ;; executes every command in a list (define (run-cmdlist cmd-lst) (for-each run-cmd cmd-lst)) ;; run-cmd : cmd -> void ;; executes the given command (define (run-cmd cmd) (cond [(displaycmd? cmd) (begin (print-slide ((displaycmd-slide cmd))) (await-click))] [(timecond? cmd) (cond [((timecond-time-limit cmd) (elapsed-time)) (run-cmdlist (timecond-within-time cmd))] [else (run-cmdlist (timecond-over-time cmd))])])) ;; print-slide : slide -> void ;; displays contents of slide on screen (define (print-slide aslide) (begin (print-string "------------------------------") (print-slide-title (slide-title aslide)) (print-slide-body (slide-body aslide)) (print-string "------------------------------"))) ;; print-slide-title : string -> void ;; displays title of slide on screen (define (print-slide-title title-str) (begin (print-string (string-append "Title: " title-str)) (print-newline))) ;; print-slide-body : slide-body -> void ;; displays contents of body on screen (define (print-slide-body body) (cond [(string? body) (print-string body)] [(pointlist? body) (cond [(pointlist-numbered? body) (print-numbered-strings (pointlist-points body) 1)] [else (print-unnumbered-strings (pointlist-points body))])])) ;; end-show : -> void ;; displays end of show message on screen (define (end-show) (print-string "End of show")) ;;;;;;;;;;;;;;; THE INTERFACE HELPERS ;;;;;;;;;;;;;;;;;;;;;;; ;; print-string : string -> void ;; prints string and a newline to the screen (define (print-string str) (printf "~a~n" str)) ;; print-newline : -> void ;; prints a newline on the screen (define (print-newline) (printf "~n")) ;; print-unnumbered-strings : list[string] -> void ;; prints a list of strings to the screen, each prefixed with a - (define (print-unnumbered-strings strlist) (for-each (lambda (str) (printf "- ~a~n" str)) strlist)) ;; print-numbered-strings : list[string] number -> void ;; prints a list of strings to the screen, each prefixed with ;; a number (in consecutive increasing order) (define (print-numbered-strings strlist label) (cond [(empty? strlist) (void)] [(cons? strlist) (begin (printf "~a. ~a~n" label (first strlist)) (print-numbered-strings (rest strlist) (+ 1 label)))])) ;; await-click : -> void ;; mimics a mouse click by waiting for the user to type a character (define (await-click) (read))