[racket] Evaluating code written in non-SEXP language

From: Matthew Flatt (mflatt at cs.utah.edu)
Date: Thu Sep 12 21:33:32 EDT 2013

I'm not sure I understand what you want, but here are some ideas about
evaluating a text that would a module if only a "#lang" line were
added.

To start, here's a function to `require` an input port that contains a
module's source. It uses the current namespace, and it gensyms a name
for the module if you don't provide one. The part that I think is least
obvious is using `current-module-declare-name` to set the name of the
module to that it can be found by `dynamic-require`:

 (require syntax/modread)

 (define (require-input-port p [name (gensym)])
   (define module-name (make-resolved-module-path name))
   (parameterize ([current-module-declare-name module-name])
     (eval-syntax (check-module-form ; ensures that `module` is bound
                   (with-module-reading-parameterization
                    (lambda ()
                      (read-syntax (object-name p) p)))
                   'ignored
                   #f)))
   (dynamic-require module-name #f))

The `require-input-port` function assumes that the source starts with
"#lang". You could use `input-port-append`, as others have suggested,
to add a "#lang" line:

 (define p (input-port-append #t
                              (open-input-string "#lang racket/base\n")
                              (open-input-file "body.rktd")))
 (port-count-lines! p)
 (require-input-port p)

A problem with `input-port-append` is that line numbers are off by one
for error reporting, and positions are off by the length of the first
line. That's an annoyingly difficult problem to fix, but
`prefix-input-port` below is my attempt (and maybe `input-port-append`
should just work better along similar lines).

 (define p (prefix-input-port #"#lang racket/base\n"
                              (open-input-file "body.rktd")))
 (port-count-lines! p)
 (require-input-port p)

----------------------------------------

;; prefix-input-port : bytes input-port -> input-port
;;  Directs position requests to the given port after the
;;  prefix is read.
;;  Closes the given input port when the result port is closed.
(define (prefix-input-port prefix base-p)
  (define-values (prefix-i prefix-o) (make-pipe))
  (write-bytes prefix prefix-o)
  (close-output-port prefix-o)
  (define (prefix-done?)
    (zero? (pipe-content-length prefix-i)))

  (make-input-port
   (object-name base-p)
   ;; read
   (lambda (bstr)
     (define n (read-bytes-avail!* bstr 
                                   (if (prefix-done?)
                                       base-p
                                       prefix-i)))
     (if (equal? n 0)
         (wrap-evt base-p (lambda (v) 0))
         n))
   ;; peek
   (lambda (bstr offset evt)
     (define pre-n (pipe-content-length prefix-i))
     (define n (if (offset . >= . pre-n)
                   (peek-bytes-avail!* bstr
                                       (- offset pre-n)
                                       #f
                                       base-p)
                   (peek-bytes-avail!* bstr
                                       offset
                                       #f
                                       prefix-i)))
     (if (equal? n 0)
         (wrap-evt base-p (lambda (v) 0))
         n))
   ;; close
   (lambda ()
     (close-input-port base-p))
   ;; get-progress-evt
   ;;  Difficult (impossible?) to support at the
   ;;  prefix--base boundary.
   #f
   ;; commit
   #f
   ;; get-location
   (lambda ()
     (if (prefix-done?)
         (port-next-location base-p)
         (port-next-location prefix-i)))
   ;; count-lines!
   (lambda ()
     (port-count-lines! prefix-i)
     (port-count-lines! base-p))))


Posted on the users mailing list.