NetNews Usenet Archive 1993 #3/NN_1993_3.iso/spool/comp/lang/dylan/114

Text File | 1993-01-21 | 5.2 KB | 139 lines

Newsgroups: comp.lang.dylan
Path: sparky!uunet!world!jsidlo
From: [e-mail] (John R Sidlo)
Subject: Improvements to Thomas Read-Eval-Print
Message-ID: <[e-mail]>
Organization: The World Public Access UNIX, Brookline, MA
Date: Thu, 21 Jan 1993 23:19:17 GMT
Lines: 129

The learning of a new language is definitely enhanced by the exercise of
using it, so I'd like to start out by thanking those at Digital's
Cambridge Research Labs, like [e-mail] and
[e-mail], and to Marc Feeley
([e-mail]) in providing their Thomas/Dylan interpreter.

I've noticed or heard of several shortcomings in the Interpreter, in
<deque> and with the Dylan Read-Eval-Print loop.  I believe I found the
<deque> initialization problem, code included below.  I also made some
changes to the copy of Thomas-rep I have, making the Thomas interpreter
more pleasant to use.  I found myself aggravated by the internal
structure dumps that Thomas prints: they are certainly not succinct, and
therefore not particularly informative.  I modified several error
handlers and the main r-e-p to detect these situations, and print the
short text description of the object, rather than a structure dump.  The
code for these changes also appears below.  I'll note that I may not
have the latest copy of the source used in the Gambit Thomas: in fact
I'm sure there are small differences.

I've tested these changes out on the Thomas Interpreter based on Marc
Feeley's gambit.  These changes may also work for other implementations
of Thomas, but I haven't tried them out.

I've distributed the <deque> fix on comp.lang.dylan, but this is the
first time for the Thomas read-eval-print changes.

These changes have also been sent to Feeley and Digital.

John Sidlo ([e-mail])

****
<deque> fix
***

(add-method
 dylan:make
 (dylan::dylan-callable->method
  (make-param-list `((DEQUE ,(dylan::make-singleton <deque>)))
                   #F #F '(size: fill:))
  (lambda (multiple-values next-method class . rest)
    multiple-values class               ; Not used
    (dylan::keyword-validate next-method rest '(size: fill:))
    (let* ((size (dylan::find-keyword rest 'size: (lambda () 0)))
           (fill (dylan::find-keyword rest 'fill: (lambda () #F))))
      (if (or (not (integer? size)) (negative? size))
          (dylan-call dylan:error
                      "make -- deque size invalid" size))
      (let ((instance (dylan::make-<object> <deque>)))
;        (dylan-call dylan:set-deque-front! instance '())
;        (dylan-call dylan:set-deque-last! instance '())
        (dylan-call dylan:set-deque-front! instance #F)
        (dylan-call dylan:set-deque-last! instance #F)
        (do ((n 0 (+ n 1)))
            ((= n size) instance)
          (dylan-call dylan:push instance fill)))))))
;I changed the commented lines

***
Thomas-rep/error handler changes
***

(define (thomas-rep)
;  (newline)
;  (display "Entering Thomas read-eval-print-loop.")
;  (newline)
;  (display "Exit by typing \"thomas:done\"")
;  (newline)
  (dylan::catch-all-conditions
   (lambda ()
     (let loop ()
       (newline)
       (display "? ")
       (let ((input (read)))
         (newline)
         (if (and (eq? input 'thomas:done))
             'thomas:done
             (compile-expression
              input '!MULTIPLE-VALUES thomas-rep-module-variables
              (lambda (new-vars preamble compiled-output)
                (implementation-specific:eval
                 `(BEGIN
                    ,@preamble
                    (LET* ((!MULTIPLE-VALUES (VECTOR '()))
                           (!RESULT ,compiled-output))
                      (IF (EQ? !RESULT !MULTIPLE-VALUES)
                          (LET RESULT-LOOP
                              ((COUNT 1)
                               (RESULTS (VECTOR-REF !MULTIPLE-VALUES 0)))
                            (IF (PAIR? RESULTS)
                                (LET ((RESULT (CAR RESULTS)))
                                  (NEWLINE)
                                  (DISPLAY ";Value[")(DISPLAY COUNT)
                                  (DISPLAY "]: ")
;(WRITE RESULT)
  (if (record? RESULT)
    (WRITE (record-type-name (record-type-descriptor RESULT)))
    (WRITE RESULT))

                                  (RESULT-LOOP (+ 1 COUNT) (CDR RESULTS)))
                                (NEWLINE)))
                          (BEGIN
;                            (NEWLINE)(DISPLAY ";Value: ")(WRITE !RESULT)
                            (NEWLINE)(DISPLAY ";Value: ")
  (if (record? !result)
    (WRITE (record-type-name (record-type-descriptor !result)))
    (WRITE !RESULT))
                             (NEWLINE))))))
                (set! thomas-rep-module-variables
                      (append new-vars thomas-rep-module-variables))
                (loop)))))))))



(define (display-simple-error format-string format-args)
  (display format-string)
  (do ((args format-args (cdr args)))
      ((null? args) #t)
    (display " ")
;(write (car args))
 (if (record? (car args))
   (WRITE (record-type-name (record-type-descriptor (car args))))
   (WRITE (car args)))
))

(define (implementation-specific:induce-error format-string format-args)
;  (apply error format-string format-args)
  (error format-string))