Mon May 4 08:51:36 CEST 2009

using machine/vm-stx.ss for compiler

In [1] there is some explanation of the syntax.  The gut of the syntax
transformer is in the function 'machine-nf which translates a
specification syntax to a normal form given a list and order of

 (syntax->datum (machine-nf '(A B C) #'((A) (B -> (cons A B)))))


 ((A A A) (B B (cons A B)) (C C C))

;; Convert machine definition form to a symbol-indexed dictionary.
;; Use hash table for usage marking and duplicate checks.

(define (form->clauses form)
  (define hash (make-hash))
   (lambda (clause)
     (match (syntax->list clause)
       ((list-rest name expr)
        (let ((key (syntax->datum name)))
          (when (hash-ref hash key (lambda () #f))
            (raise-syntax-error 'duplicate-name
                                "Form contains duplicate name"
                                clause name))
          (hash-set! hash key clause)))))
   (syntax->list form))

(define (clauses-ref/mark-defined! clauses r)
  ;; Hygienically introduce default (identifier not reachable from body code).
  (define (default) (list (datum->syntax #f r)))
  (let ((clause (hash-ref clauses r default)))
    ;; Mark it used.
    (hash-set! clauses r #f)

(define (clauses-check-undefined dict)
  (hash-map dict
            (lambda (key notused)
              (when notused
                (raise-syntax-error 'undefined-register
                                    "Undefined register"
                                    (datum->syntax notused key)

;; Convert machine definition clauses to normal form, completing
;; clauses if necessary, and sorting them in the correct order.
(define (machine-nf registers stx)
  (let* ((dict (form->clauses stx))
         (nf (datum->syntax
              (for/list ((r registers))
                (syntax-case (clauses-ref/mark-defined! dict r) ()

                  ;; Annotated syntax.  This makes it easier to use the same
                  ;; language for clauses with and without pattern matching.
                  ((reg -> expr)        #`(reg reg expr))
                  ((reg : pat -> expr)  #`(reg pat expr))

                  ;; Non-annotated.
                  ((reg)          #`(reg reg reg))
                  ((reg pat)      #`(reg pat reg))
                  ((reg pat expr) #`(reg pat expr))

    (clauses-check-undefined dict)

So what's next?  Make this work on structure fields.  How does
scheme/match do this?  It uses syntax certifiers to access the stuct

Now, it doesn't look like the original field names are preserved, only
the accessor and mutator names.

This means that the namespace has to be provided externally, possibly
by generating both the struct and the update form at the same time.

Ok.. basic form is working:

(define (machine-update-struct i struct-id registers stx)
  (let* ((info (extract-struct-info (syntax-local-value struct-id)))
         (make-struct-id (cadr info)))
    (printf "constructor: ~a\n" (syntax->datum make-struct-id))
    (syntax-case (machine-nf registers stx) ()
      (((reg pat expr) ...)
       #`(match #,i
                ((struct #,struct-id (pat ...))
                 (#,make-struct-id expr ...)))))))

Now to find some good names.

Function is updated to just copy non-defined fields:

(define (machine-update-struct-tx i struct-id registers-stx stx)
  (let* ((info (extract-struct-info (syntax-local-value struct-id)))
         (make-struct-id (cadr info))
         (size (length (cadddr info)))
         (registers (syntax->datum registers-stx)))
    (when (< size (length registers))
      (raise-syntax-error #f "Too many fields" registers-stx))
    ;; Pad fields if there aren't enough.
    (let ((registers
           (append registers
                   (for/list ((n (in-range (- size (length registers)))))
                     (string->uninterned-symbol (format "R~s" n))))))
      (syntax-case (machine-nf registers stx) ()
        (((reg pat expr) ...)
         #`(match #,i
                  ((struct #,struct-id (pat ...))
                   (#,make-struct-id expr ...))))))))

[1] entry://20090408-082123