[PRL] How about Tues 200-300 for macro reading group?

Doug Orleans dougo at place.org
Mon Sep 13 19:07:04 EDT 2004


Matthias Felleisen wrote:
 > I got pretty sick staring at Perl, so I rewrote the program in Pretty
 > Big. It's 2 lines longer, argh. Anyone who knows more about our
 > libraries? -- Matthias

Here's a line-by-line translation of Jeff's perl script into MzScheme.
It's as faithful as I could make it.  (I even learned something about
R5RS: the body of a "do" construct is not a <body> but a sequence of
<command>s, i.e. you can't start with a "define".  Hence I had to use
"let".  I was tempted to write a "for" macro instead.)  (I also
learned something about Perl: "$#foo" doesn't mean "the length of
foo", it means "the index of the last element in foo".  Weird.)


#!/usr/local/bin/mzscheme -r

(define days #(mon tue wed thu fri))

;; day -> constraints
;; a constraints is a vector of (start,stop) times
(define constraints
  #hash(
  ;;       mitch          will
  (mon . #("1200" "1330"  "1330" "1445"))
  ;;       carl et al     will           sam            jeff
  (tue . #("1145" "1705"  "1600" "2345"  "1100" "0515"  "0800" "1130"))
  ;;       pl             will
  (wed . #("1145" "1330"  "1145" "1445"))
  ;;       mitch          mitch          mitch          will           will           sam
  (thu . #("0900" "1100"  "1200" "1330"  "1330" "1445"  "1445" "1800"  "1800" "2100"  "1230" "1330"))
  ;;       mitch          will           sam
  (fri . #("0800" "2145"  "0800" "2145"  "1300" "1500"))
  ))

(define ok 1)
(define start-hour 8)
(define stop-hour 21)
(display "Day ")
(do ((h start-hour (add1 h))) ((> h stop-hour))
  (let ((hour (if (< h 10) (format "0~a" h) h)))
    (printf "~a00 " hour))
)
(newline)
(do ((i 0 (add1 i))) ((>= i (vector-length days)))
  (let* ((stack 0)
	 (day (vector-ref days i))
	 (cst (hash-table-get constraints day)))
    (display day)
    (do ((h start-hour (add1 h))) ((> h stop-hour))
      (let ((hour (if (< h 10) (format "0~a" h) h)))
	(display " ")
	(do ((m 0 (+ m 15))) ((> m 45))
	  (do ((j 0 (+ j 2))) ((>= j (vector-length cst)))
	    (let* ((start (vector-ref cst (+ j 0)))
		   (stop  (vector-ref cst (+ j 1)))
		   (min (if (< m 10) (format "0~a" m) m))
		   (time (format "~a~a" hour min)))
	      (when (equal? time start) (set! stack (add1 stack)))
	      (when (equal? time stop)  (set! stack (sub1 stack)))
	  ))
	  (display (if (zero? stack) " " stack))
	)
    ))
    (newline)
))


--dougo at place.org



More information about the PRL mailing list