Assignment 3, Due Monday, April 17, 2000

For these problems and for future reference, letrec-exp and prim-app variants of expression have been added, and a primitive data type has been defined.

Here are define-datatype definitions for expression and primitive and a definition of parse for converting Scheme syntax into abstract syntax.

Changes and additions are highlighted. Note, for example, that (plus x y) and (+ x y) have different abstract syntax.

(define-datatype expression expression?
  (var-exp
    (id symbol?))
  (lit-exp
    (datum number?))
  (primapp-exp
    (prim primitive?)
    (rands (list-of expression?)))
  (if-exp
    (test-exp expression?)
    (true-exp expression?)
    (false-exp expression?))
  (proc-exp
    (ids (list-of symbol?))
    (body expression?))
  (let-exp
    (ids (list-of symbol?))
    (exps (list-of expression?))
    (body expression?))
  (letrec-exp
    (ids (list-of symbol?))
    (exps (list-of expression?))
    (body expression?))
  (app-exp
    (rator expression?)
    (rands (list-of expression?))))

(define-datatype primitive primitive?
  (add-prim)
  (subtract-prim)
  (mult-prim)
  (incr-prim)
  (decr-prim))


(define parse
  (lambda (datum)
    (cond ((symbol? datum)
	   (var-exp datum))
	  ((number? datum)
	   (lit-exp datum))
	  ((pair? datum)
	   (cond ((eqv? (car datum) 'if)
		  (if-exp
		    (parse (cadr datum))
		    (parse (caddr datum))
		    (parse (cadddr datum))))
		 ((memv (car datum) '(+ - * add1 sub1))
		  (primapp-exp
		    (case (car datum)
		      ((+) (add-prim))
		      ((-) (subtract-prim))
		      ((*) (mult-prim))
		      ((add1) (incr-prim))
		      ((sub1) (decr-prim)))
		    (map parse (cdr datum))))
		 ((eqv? (car datum) 'lambda)
		  (proc-exp
		    (cadr datum)
		    (parse (caddr datum))))
		 ((eqv? (car datum) 'let)
		  (let ((ids (map car (cadr datum)))
			(datums (map cadr (cadr datum))))
		    (let-exp
		      ids
		      (map parse datums)
		      (parse (caddr datum)))))
		 ((eqv? (car datum) 'letrec)
		  (let ((ids (map car (cadr datum)))
			(datums (map cadr (cadr datum))))
		    (letrec-exp
		      ids
		      (map parse datums)
		      (parse (caddr datum)))))
		 (else
		   (app-exp
		     (parse (car datum))
		     (map parse (cdr datum))))))
	  (else
	    (error 'parse "bad syntax ~s" datum)))))

1. In Assignment 2, you extended lex-add-parsed from cs17d5.scm so

   (lexical-address datum) => lexical address of datum
   

   where

   (define lexical-address
     (lambda (datum)
       (lex-add-parsed (parse datum) '())))
   

   is correct for Scheme expressions with if or let.

   Extend it further so it works for Scheme expressions with

   1. a primitive procedure +, -, *, add1, decr1, or
   2. letrec

   For your convenience, here is a solution to the Assignment 2 problem.

   (define index-of
     (lambda (x lst)
       (if (null? lst)
   	#f
   	(if (eqv? x (car lst))
   	    0
   	    (let ((v (index-of x (cdr lst))))
   	      (if v
   		  (+ v 1)
   		  v))))))
   
   ;; (depth-pos v vlsts d0) -- returns depth and position, (: d p),
   ;; of a variable within a list of lists, vlsts, relative to d0,
   ;; else (: free).
   
   (define depth-pos
     (lambda (v vlsts d)
       (if (null? vlsts)
   	(list ': 'free)
       (let ((p (index-of v (car vlsts))))
         (if p
   	  (list ': d p)
   	  (depth-pos v (cdr vlsts) (+ d 1)))))))
   
   ;; (lex-add-parsed exp vlsts)
   ;;      => lexical address of abstract syntax exp relative to vlsts.
   
   (define lex-add-parsed
     (lambda (exp vlsts)
       (cases expression exp
         (lit-exp (datum)
   	datum)
         (var-exp (id)
   	(cons id (depth-pos id vlsts 0)))
         (if-exp (test-exp true-exp false-exp)
   	(list
   	  'if
   	  (lex-add-parsed test-exp vlsts)
   	  (lex-add-parsed true-exp vlsts)
   	  (lex-add-parsed false-exp vlsts)))
         (primapp-exp (prim rands)
   	ADD CODE HEE)
         (proc-exp (ids body)
   	(list
   	  'lambda
   	  ids
   	  (lex-add-parsed body (cons ids vlsts))))
         (let-exp (ids exps body)
   	(list
   	  'let
   	  (map (lambda (id exp)
   		 (list id (lex-add-parsed exp vlsts)))
   	    ids exps)
   	  (lex-add-parsed body (cons ids vlsts))))
         (letrec-exp (ids exps body)
   	ADD CODE HERE)
         (app-exp (rator rands)
   	(cons
   	  (lex-add-parsed rator vlsts)
   	  (map (lambda (rand)
   		   (lex-add-parsed rand vlsts))
   	      rands)))
         (else
   	(error 'lex-add-parsed "not done ~s" exp)))))
   

2. Define a do-tests expression which tests lexical-address on examples of your invention. Recall

   (define writeln
     (lambda args
       (for-each display args)
       (newline)))
   
   (define do-tests
     (lambda (proc-name proc tests results)
       (writeln "Testing " proc-name)
       (for-each (lambda (test result)
   		(let ((val (apply proc test)))
   		  (pretty-print `(,proc-name ,@test))
   		  (writeln "  => ")
   		  (pretty-print val)
   		  (if (equal? val result)
   		      (writeln "OK")
   		      (writeln "Not OK.  Should be " result))
   		  (newline)))
         tests results)
       (writeln "Done " proc-name)
       (newline)))
   

   Here is a start. Replace x, y and z by interesting cases and insert the correct answers so your tests pass all OK. You need to implement both primapp-exp and letrec-exp for the last to work.

   (do-tests
     'lexical-address
     lexical-address
     (map list
       '(
         x
         y
         z
         (let ((x a)
   	    (y b)
   	    (f (lambda (x) (plus x y))))
   	(f y))
         (letrec ((x a)
   	       (y b)
   	       (f (lambda (x) (+ x y))))
   	(f y))
         ))
     '(
       #f
       #f
       #f
       (let ((x (a : free))
   	  (y (b : free))
   	  (f (lambda (x) ((plus : free) (x : 0 0) (y : free)))))
         ((f : 0 2) (y : 0 1)))
       (letrec ((x (a : free))
   	     (y (b : free))
   	     (f (lambda (x) (+ (x : 0 0) (y : 1 1)))))
         ((f : 0 2) (y : 0 1)))
       ))
   

3. Optional -- Implement the unfinished procedures for pe from Day 8.

assgn3.scm must be loadable into Scheme and procedures must pass tests of correctness.