using (ice-9 expect) to feed a repl

[thi]

please find below a toy program that uses (ice-9 expect) to feed a guile
repl some forms and collect its output.  output is appended after the
program.

to Barak Bar Oryon: i suspect your ftp-expect program is missing some
tricky fdes bits -- everything else looks ok to me.  see `call-process'
or its model `open-process' for details.  also, i am using a development
version of guile; perhaps your guile is borken in some way.

to guile developers: what do you think about exporting `open-process'
(or at least the tricky fdes bits of it)?  i like the `call-process'
abstraction, personally.  also, this kind of repl interaction seems to
be another good way to test guile.

happy hacking,
thi

____________________________________________
#!/bin/sh
exec guile -s $0 "$@"
!#
;;; feed-repl.scm
;;;
;;; Copyright (C) 2001 Thien-Thi Nguyen
;;; This program is released under GNU GPL with ABSOLUTELY NO WARRANTY.

(use-modules (ice-9 expect) (ttn shellutils))

(define (bg program)
  (let ((kid-rd/par-wr (pipe))
        (par-rd/kid-wr (pipe)))
    (let ((pid (primitive-fork)))
      (if (= 0 pid)
          (exit (call-process program
                              #:inp (car kid-rd/par-wr)
                              #:outp (cdr par-rd/kid-wr)
                              #:errp (cdr par-rd/kid-wr)
                              #:norm #t))
          (cons (car par-rd/kid-wr) (cdr kid-rd/par-wr))))))

(define (repl-session interpreter prompt-re commands)
  (let* ((interp-ports (bg interpreter))
         (spew (lambda (string)
                 (display string (cdr interp-ports))
                 (flush-all-ports)))
         (log '()))
    (let ((expect-port (car interp-ports))
          (expect-timeout 2)
          (expect-timeout-proc (lambda (s) (display "Time's up!\n") (exit 1)))
          (expect-eof-proc (lambda (s) (display "EOF!!!\n") (exit 0))))
      (let loop ((commands commands))
        (or (null? commands)
            (let ((cmd (string-append (with-output-to-string
                                        (lambda () (write (car commands))))
                                      "\n"))
                  (expect-char-proc (lambda (c)
                                      (set-car! log (cons c (car log))))))
              (set! log (cons '() log))
              (expect-strings
               (prompt-re => (lambda (prompt)
                               (set-car! log
                                         (list->string
                                          (reverse
                                           (list-tail
                                            (car log)
                                            (string-length prompt)))))
                               (set-object-property! (car commands) 'cmd #t)
                               (set! log (cons (car commands) log))
                               (spew cmd))))
              (loop (cdr commands))))))
    (reverse log)))

(define (main)
  (for-each (lambda (entry)
              (and (object-property entry 'cmd)
                   (display "COMMAND: "))
              (display entry) (newline))
            (repl-session "guile -q" "guile> "
                          '((use-modules (ttn echo))
                            (echo 'greetings 'world!)
                            (define (fact n)
                              (if (< n 1)
                                  1
                                  (* n (fact (1- n)))))
                            fact
                            (fact 5)
                            (iota 50)
                            (for-each echo (map fact (reverse (iota 50))))
                            (quit)))))

(exit (main))

;;; feed-repl.scm ends here
___________________________________________
cd /home/ttn/build/beguiled/
./feed-repl.scm

COMMAND: (use-modules (ttn echo))

COMMAND: (echo (quote greetings) (quote world!))
greetings world!

COMMAND: (define (fact n) (if (< n 1) 1 (* n (fact (1- n)))))

COMMAND: fact
#<procedure fact (n)>

COMMAND: (fact 5)
120

COMMAND: (iota 50)
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49)

COMMAND: (for-each echo (map fact (reverse (iota 50))))
608281864034267560872252163321295376887552831379210240000000000
12413915592536072670862289047373375038521486354677760000000000
258623241511168180642964355153611979969197632389120000000000
5502622159812088949850305428800254892961651752960000000000
119622220865480194561963161495657715064383733760000000000
2658271574788448768043625811014615890319638528000000000
60415263063373835637355132068513997507264512000000000
1405006117752879898543142606244511569936384000000000
33452526613163807108170062053440751665152000000000
815915283247897734345611269596115894272000000000
20397882081197443358640281739902897356800000000
523022617466601111760007224100074291200000000
13763753091226345046315979581580902400000000
371993326789901217467999448150835200000000
10333147966386144929666651337523200000000
295232799039604140847618609643520000000
8683317618811886495518194401280000000
263130836933693530167218012160000000
8222838654177922817725562880000000
265252859812191058636308480000000
8841761993739701954543616000000
304888344611713860501504000000
10888869450418352160768000000
403291461126605635584000000
15511210043330985984000000
620448401733239439360000
25852016738884976640000
1124000727777607680000
51090942171709440000
2432902008176640000
121645100408832000
6402373705728000
355687428096000
20922789888000
1307674368000
87178291200
6227020800
479001600
39916800
3628800
362880
40320
5040
720
120
24
6
2
1
1

COMMAND: (quit)

Compilation finished at Tue Mar 27 10:54:20