Skip to content

Instantly share code, notes, and snippets.

@kesava
Last active June 23, 2021 10:24
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save kesava/ec1518495387928d35ec9fc5a764ddbf to your computer and use it in GitHub Desktop.
Save kesava/ec1518495387928d35ec9fc5a764ddbf to your computer and use it in GitHub Desktop.
Need help porting macros from EOPL first edition

I am trying to work through EOPL first edition and I have made fairly good progress till chapter 5, working diligently through exercises[1]. I've been using Dr.Racket and #lang eopl[2] for the exercies.

Earlier in the the book, the authors define a couple of key macros define-record and variant-case which are used through out the book. Here is a brief usage of the macros.

(define-record leaf (number))

; that should define three methods
; a. make-leaf - constructor
; b. leaf? - predicate method
; c. leaf->number - a method to look up the members of the record

(define-record interior (symbol left-tree right-tree))

; Equivalent of this would be
; a. make-interior
; b. interior?
; c. interior->symbol, interior->left-tree, interior->right-tree

(define tree-1 (make-interior 'foo (make-interior 'bar (make-leaf 1) (make-leaf 2)) (make-leaf 3)))

(define leaf-sum
  (lambda (tree)
    (variant-case tree
                  (leaf (number) number)
                  (interior (left-tree right-tree)
                            (+ (leaf-sum left-tree) (leaf-sum right-tree)))
                  (else (error "leaf-sum: Invalid tree" tree)))))
                  
; variant-case is essentially pattern matching on the record type we defined earlier.
(leaf-sum tree-1)
; Should be 6

#lang eopl, howvever, doesn't support these macros. A key string parser uses these macros and I cannot proceed further in the book with out these macros. :(

Fortunately, the authors provide source code for the macros in scheme in the appendix of the book. So, I have taken upon myself a non-trivial task for me - I started writing these macros in Racket. I made some progress, but I have been struck for two+ weeks. I am writing this to explain my thinking and seek help to move forward.

The first macro of writing define-record has been relatively easy. Here is my source code for it.

#lang racket
(require racket/syntax)
(require (for-syntax racket/syntax))
(require macro-debugger/expand)
(require syntax/parse/define)
(require
  racket/stxparam
  (for-syntax syntax/parse))

(define-syntax (define-record stx)
    (syntax-case stx ()
      [(_ id (fields ...))
       (with-syntax ([make-id (format-id #'id "make-~a" #'id)] [pred-id (format-id #'id "~a?" #'id)])
         #`(begin
             ; Define a constructor.
             (define (make-id fields ...)
               (apply vector (cons 'id  (list fields ...))))
             ; Define a predicate.
             (define (pred-id v)
               (and (vector? v)
                    (eq? (vector-ref v 0) 'id)))
             ; Define an accessor for each field.
             #,@(for/list ([x (syntax->list #'(fields ...))]
                           [n (in-naturals 1)])
                  (with-syntax ([acc-id (format-id #'id "~a->~a" #'id x)]
                                [ix n])
                    #`(define (acc-id v)
                        (unless (pred-id v)
                          (error 'acc-id "~a is not a ~a struct" v 'id))
                        (vector-ref v ix))))))]))

However, I have been stuck on variant-case for a while now. I really need some help here.

I have considered a couple of approaches, both of which I'll outline here. Both use syntax pattern matching. The difference is in how to capture the variable number of parameters possible in a particular matched pattern.

Approach 1

(define-syntax (variant-case stx)
  (syntax-case stx ()
    [(_ (a . d) clause ...)
     #'(let ([var (a . d)]) (variant-case var clause ...))]
    [(_ var)
     #'(error 'variant-case "no clause matches ~s" var)]
    [(_ var (else exp1 exp2 ...))
     #'(begin exp1 exp2 ...)]
    [(_ var (name (field ...) exp1 exp2 ...) clause ...)
     (with-syntax ([name? (format-id #'name "~a?" #'name)]
                   [name->field (format-id #'name "~a->~a" #'name #'field)] ...)
       #'(if (name? var)
                (let ([field (name->field var)] ...) exp1 exp2 ...)
                (variant-case var clause ...)))]))

A sample transformation should like like this -

(variant-case tree
    (leaf (number) number)
    (intrior (left-tree right-tree) (+ (leaf-sum left-tree) (leaf-sum right-tree)))
 
 =>
 
(if (leaf? tree) 
    (let ((number (leaf->number tree))) number)
    (if (interior? tree)
         (let ((left-tree (interior->left-tree tree))
              (let (right-tree (interior->right-tree tree))) 
                    (+ (rtt left-tree) (rtt right-tree)))
         (variant-case tree (else (error "leaf-sum: Invalid tree" tree)))))))

The general idea here is to define - a) a predicate name? to check if the record is of the matched type. b) a lookup method name->field to look up the field and use it the let expression later to evaluate exp1 exp2.

However, we can have variable number of fields for (b) and we need to define generate temporary variable names for name->field1, name->field2 etc. I was hoping the ... at the end of line 11 would expand, but doesnt seem to the case. This doesnt even seem to compile. Q1: How do I expand this?

Approach 2

Here instead of relying on ... to capture variable nunber of fields in the record pattern matching, I try to capture them as field . fields, with the rest being more of less.

(define-syntax (variant-case3 stx)
  (syntax-case stx ()
    [(_ (a . d) clause ...)
     #'(let ([var (a . d)]) (variant-case var clause ...))]
    [(_ var)
     #'(error 'variant-case "no clause matches ~s" var)]
    [(_ var (else exp1 exp2 ...))
     #'(begin exp1 exp2 ...)]
    [(_ var (name (field . fields) exp1 exp2 ...) clause ...)
     (displayln #'exp1)
     (with-syntax ([name? (format-id #'name "~a?" #'name)]
                   [name-field-pairs-list (map
                                     (lambda (fld) (list fld
                                                         (list (format-id #'name "~a->~a" #'name fld) #'var)))
                                     (cons (syntax->datum #'field) (syntax->datum #'fields)))])
       #'(if (name? var)
             (let name-field-pairs-list exp1 exp2 ...)
             (variant-case var clause ...)))]))

A sample transformation should like like this -

(variant-case tree
    (leaf (number) number)
    (intrior (left-tree right-tree) (+ (leaf-sum left-tree) (leaf-sum right-tree)))
 
 =>
 
(if (leaf? tree) 
    (let ((number (leaf->number tree))) number)
    (if (interior? tree)
         (let ((left-tree (interior->left-tree tree)) (right-tree (interior->right-tree tree))) 
                    (+ (rtt left-tree) (rtt right-tree)))
         (variant-case tree (else (error "leaf-sum: Invalid tree" tree))))))

So, after capturing all my fields as a list (line 9 and 15), I generate pairs of fields and field lookup methods and try to use them in the subsequent let expression. This however, fails saying number in unbound identifier, when i use my tree example from earlier in the post. Q2: Did I mess up with scopes? Whats going on here?

Approach 3

I tried to go completely analog, by consing lambda lists and then eval them as syntax-objects.

(define-syntax variant-case
  (syntax-rules (else)
    [(_ (a . d) clause ...)
     (let ([var (a . d)]) (variant-case var clause ...))]
    [(_ var) (error 'variant-case "no clause matches ~s" var)]
    [(_ var (else exp1 exp2 ...)) (begin exp1 exp2 ...)]
    [(_ var (name (field . fields) exp1 . exp2) clause ...)
     (with-syntax ([name? (format-id #'name "~a?" #'name)]
                   [name-field-pairs-list (map
                                     (lambda (fld) (list fld
                                                         (list (format-id #'name "~a->~a" #'name fld) #'var)))
                                     (cons (syntax->datum #'field) (syntax->datum #'fields)))]
                   [exps-list (cons #'exp1 #'exp2)])
       (if ((eval-syntax #'name?) var)
           (let ((pairs (syntax->datum #'name-field-pairs-list)))
             (let (
                   (vars (map (lambda (p) (car p)) pairs))
                   (exps (map (lambda (p)
                                (append
                                 (list (list 'lambda (list (syntax->datum #'var)) (cadr p)))
                                 (list (syntax->datum #'var))))
                              pairs)))
               (let ((exp (append (list 'lambda vars (car (syntax->datum #'exps-list))) exps)))
                 ((lambda (tree) (displayln tree) (displayln exp) (displayln (eval exp)) ((eval exp) tree)) var))))
             (variant-case var clause ...)))]))

A sample transformation should like like this -

(variant-case tree
    (leaf (number) number)
    (intrior (left-tree right-tree) (+ (leaf-sum left-tree) (leaf-sum right-tree)))
 
 =>

; I've transformed the let expression into lambda expression for ease of consing.
(if (leaf? tree) 
    ((lambda (number) number) ((lambda (tree) (leaf->number tree)) tree))))

This seems both painful and hard to debug. But the central problem seems to be the inability to pass parameter by reference to the eval exp.

Can you Please, please, please help me? I feel stuck for weeks now and hate to give up on EOPL book.


[1] Here is the git repo of my solutions to the exercises so far: https://github.com/kesava/eopl/tree/master/first-edition

[2] https://docs.racket-lang.org/eopl/index.html. I was able to all the progress using define-datatype, but the string parser in the appendix uses define-record and I hit a wall there.

@prathyvsh
Copy link

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment