;;; David Golombek
;;; Problem Set 10

;;;----------------------------------------------------------------------------
;;; PreLab Exercise 1A:

delq1 :  time n
         space n

delq2 :  time n
         space constant

;;;----------------------------------------------------------------------------
;;; PreLab Exercise 1B:


(define my-machine
  (make-machine
   '(x l a continue)
   standard-primitives
   '(
     delq1
     (test (op null?) (reg l))
     (branch (label continue-label))
     (assign a (op car) (reg l))
     (test (op eq?) (reg x) (reg a))
     (branch (label found-it))
     (save a)
     (save continue)
     (assign l (op cdr) (reg l))
     (assign continue (label after-list))
     (goto (label delq1))
     after-list
     (restore continue)
     (restore a)
     (assign l (op cons) (reg a) (reg l))
     (goto (reg continue))
     found-it
     (assign l (op cdr) (reg l))
     (goto (label delq1))
     continue-label
     (goto (reg continue)))))

(define my-machine
  (make-machine
   '(x l a maybe-xs no-xs continue)
   standard-primitives
   '(
     (assign maybe-xs (reg l))
     (assign no-xs (const #f))
     (save continue)
     (assign continue (label done-first))
     (goto (label delete-reverse))
     done-first
     (assign maybe-xs (reg l))
     (assign no-xs (const #f))
     (restore continue)
     (goto (label delete-reverse))
     delete-reverse
     (test (op null?) (reg maybe-xs))
     (branch (label done))
     (assign a (op car) (reg maybe-xs))
     (test (op eq?) (reg x) (reg a))
     (branch (label found-it))
     (assign maybe-xs (op cdr) (reg maybe-xs))
     (assign no-xs (op cons) (reg a) (reg no-xs))
     (goto (label delete-reverse))
     found-it
     (assign maybe-xs (op cdr) (reg maybe-xs))
     (goto (label delete-reverse))
     done
     (assign l (reg no-xs))
     (goto (reg continue)))))


;;;----------------------------------------------------------------------------
;;; Lab Exercise 2A:


(define (test-machine x l)
  (set-register-contents! my-machine 'x x)
  (set-register-contents! my-machine 'l l)
  (my-machine 'initialize-stack)
  (my-machine 'initialize-ops-counter)
  (start my-machine)
  (my-machine 'print-stack-statistics)
  (my-machine 'print-ops)
  (get-register-contents my-machine 'l))
;Value: test-machine

;;; WITH delq1
(trace-reg-on my-machine 'l)
;Value: (l)

(test-machine 'a '(g a r f c))
(total-pushes = 8 maximum-depth = 8)
(machine-ops = 66)
;Value 4: (g r f c)



Size   |   pushes   |  max-depth   |  machine-ops
-------------------------------------------------
0            0             0               3
1            2             2               17
2            4             4               31
3            6             6               45
4            8             8               59

10           20            20              143
20           40            40              283


;;; With delq2
(test-machine 'a '(g a r f c))
(total-pushes = 1 maximum-depth = 1)
(machine-ops = 88)
;Value 7: (g r f c)

(test-machine 'a '(g r f c))
(total-pushes = 1 maximum-depth = 1)
(machine-ops = 81)
;Value 8: (g r f c)


Size   |   pushes   |  max-depth   |  machine-ops
-------------------------------------------------
0             1           1                17
1             1           1                33
2             1           1                49
3             1           1                65

10            1           1                177
20            1           1                337


;;;----------------------------------------------------------------------------
;;; PostLab Exercise 2B:

;;; delq1
pushes = 2 * size
max-depth = 2 * size
machine-ops = 3 + (14 * size)

;;; delq2
pushes = 1
max-depth = 1
machine-ops = 17 + (16 * size)


;;;----------------------------------------------------------------------------
;;; Lab Exercise 3A:


(compile-and-go
 '(define (delq1 x l)
    (cond ((null? l) '())
	  ((eq? x (car l)) (delq1 x (cdr l)))
	  (else (cons (car l) (delq1 x (cdr l)))))))


Size   |   pushes   |  max-depth   |  machine-ops
-------------------------------------------------
0            10            5               110
1            22            5               187
2            34            8               264
3            46            11              341
4            58            14              418

10           130           32              880


(compile-and-go
 '(define (delq2 x l)
    (define (delete-reverse maybe-xs no-xs)
      (cond ((null? maybe-xs) no-xs)
	    ((eq? x (car maybe-xs)) (delete-reverse (cdr maybe-xs) no-xs))
	    (else (delete-reverse (cdr maybe-xs) (cons (car maybe-xs) no-xs)))))
    (delete-reverse (delete-reverse l '()) '())))


Size   |   pushes   |  max-depth   |  machine-ops
-------------------------------------------------
0            15           5               156
1            39           8               306
2            63           8               456
3            87           8               606
4            111          8               756

10           255          8               1656


;;;----------------------------------------------------------------------------
Lab Exercise 3B:

;;; Interpreted delq1

Size   |   pushes   |  max-depth   |  machine-ops
-------------------------------------------------
0            16            6              218
1            66            9              802
2            116           12             1386
3            166           15             1970

;;; Interpreted delq2

Size   |   pushes   |  max-depth   |  machine-ops
-------------------------------------------------
0            45            11             576
1            145           16             1744
2            245           16             2912
3            345           16             4080

;;;----------------------------------------------------------------------------
PostLab Exercise 3C:

Compiled delq1:
machine-ops: 110 + (77 * size)
pushes: 10 + (12 * size)
max-depth: 2 + (3 * size)

Compiled delq2:
machine-ops: 156 + (150 * size)
pushes: 15 + (14 * size)
max-depth: 8

Interpreted delq1:
machine-ops: 218 + (584 * size)
pushes: 16 + (50 * size)
max-depth: 6 + (3 * size)

Interpreted delq2:
machine-ops: 576 + (1168 * size)
pushes: 45 + (100 * size)
max-depth: 16

;;;----------------------------------------------------------------------------
Lab Exercise 4:

(define (test)
  (list 'begin
        '(define (yo)
           'a)
        '(define (yo2)
           '(1 2))
        '(define (delq1 x l)
           (cond ((null? l) '())
                 ((eq? x (car l)) (delq1 x (cdr l)))
                 (else (cons (car l) (delq1 x (cdr l))))))
        (list 'delq1 '(yo) '(yo2))))



Size   |   pushes   |  max-depth   |  machine-ops
-------------------------------------------------
0            29           6               134
1            68           9               308
2            107          12              482


(define (test2)
  (list 'begin
	'(define (yo)
	   'a)
	'(define (yo2)
	   '(1 2))
	'(define (delq2 x l)
	   (define (delete-reverse maybe-xs no-xs)
	     (cond ((null? maybe-xs) no-xs)
		   ((eq? x (car maybe-xs)) (delete-reverse (cdr maybe-xs) no-xs))
		   (else (delete-reverse (cdr maybe-xs) (cons (car maybe-xs) no-xs)))))
	   (delete-reverse (delete-reverse l '()) '()))
	(list 'delq2 '(yo) '(yo2))))
	   

Size   |   pushes   |  max-depth   |  machine-ops
-------------------------------------------------
0            52            8               238
1            130           12              586
2            208           12              934


naive-Compiled delq1:
machine-ops: 134 + (174 * size)
pushes: 29 + (39 * size)
max-depth: 6 + (3 * size)

naive-Compiled delq2:
machine-ops: 238 + (348 * size)
pushes: 52 + (78 * size)
max-depth: 12





;;;----------------------------------------------------------------------------
PostLab Exercise 5:

Space:
my delq1:             2 * size
my delq2:             1
compiled delq1:       3 * size
compiled delq2:       8
naive-compiled delq1: 3 * size
naive-compiled delq2: 16
interpreted delq1:    3 * size
interpreted delq2:    12

Time:
my delq1:             14 * size
my delq2:             16 * size
compiled delq1:       77 * size
compiled delq2:       150 * size
naive-compiled delq1: 584 * size
naive-compiled delq2: 1168 * size
interpreted delq1:    178 * size
interpreted delq2:    348 * size

In other words, the compilers aren't bad as far as space goes, but in time
they are absolutely horrible.

;;;----------------------------------------------------------------------------
Lab Exercise 6A:

(compile-and-display test1)

  (assign val (op make-compiled-procedure) (label entry587) (reg env))
  (goto (label after-lambda586))
entry587
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (x l)) (reg argl) (reg env))
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const null?) (reg env))
  (assign val (op lookup-variable-value) (const l) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch620))
compiled-branch619
  (assign continue (label after-call618))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch620
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call618
  (restore env)
  (restore continue)
  (test (op false?) (reg val))
  (branch (label false-branch589))
true-branch590
  (assign val (const ()))
  (goto (reg continue))
false-branch589
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const eq?) (reg env))
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const car) (reg env))
  (assign val (op lookup-variable-value) (const l) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch614))
compiled-branch613
  (assign continue (label after-call612))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch614
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call612
  (assign argl (op list) (reg val))
  (restore env)
  (assign val (op lookup-variable-value) (const x) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch617))
compiled-branch616
  (assign continue (label after-call615))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch617
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call615
  (restore env)
  (restore continue)
  (test (op false?) (reg val))
  (branch (label false-branch592))
true-branch593
  (assign proc (op lookup-variable-value) (const delq1) (reg env))
  (save continue)
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const cdr) (reg env))
  (assign val (op lookup-variable-value) (const l) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch608))
compiled-branch607
  (assign continue (label after-call606))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch608
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call606
  (assign argl (op list) (reg val))
  (restore env)
  (assign val (op lookup-variable-value) (const x) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch611))
compiled-branch610
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch611
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call609
false-branch592
  (assign proc (op lookup-variable-value) (const cons) (reg env))
  (save continue)
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const delq1) (reg env))
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const cdr) (reg env))
  (assign val (op lookup-variable-value) (const l) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch596))
compiled-branch595
  (assign continue (label after-call594))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch596
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call594
  (assign argl (op list) (reg val))
  (restore env)
  (assign val (op lookup-variable-value) (const x) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch599))
compiled-branch598
  (assign continue (label after-call597))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch599
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call597
  (assign argl (op list) (reg val))
  (restore env)
  (save argl)
  (assign proc (op lookup-variable-value) (const car) (reg env))
  (assign val (op lookup-variable-value) (const l) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch602))
compiled-branch601
  (assign continue (label after-call600))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch602
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call600
  (restore argl)
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch605))
compiled-branch604
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch605
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call603
after-if591
after-if588
after-lambda586
  (perform (op define-variable!) (const delq1) (reg val) (reg env))
  (assign val (const (the-unspecified-value)))
  (goto (reg continue))
;No value


(compile-and-display test2)

  (assign val (op make-compiled-procedure) (label entry622) (reg env))
  (goto (label after-lambda621))
entry622
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (x l)) (reg argl) (reg env))
  (assign val (op make-compiled-procedure) (label entry630) (reg env))
  (goto (label after-lambda629))
entry630
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (maybe-xs no-xs)) (reg argl) (reg env))
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const null?) (reg env))
  (assign val (op lookup-variable-value) (const maybe-xs) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch663))
compiled-branch662
  (assign continue (label after-call661))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch663
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call661
  (restore env)
  (restore continue)
  (test (op false?) (reg val))
  (branch (label false-branch632))
true-branch633
  (assign val (op lookup-variable-value) (const no-xs) (reg env))
  (goto (reg continue))
false-branch632
  (save continue)
  (save env)
  (assign proc (op lookup-variable-value) (const eq?) (reg env))
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const car) (reg env))
  (assign val (op lookup-variable-value) (const maybe-xs) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch657))
compiled-branch656
  (assign continue (label after-call655))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch657
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call655
  (assign argl (op list) (reg val))
  (restore env)
  (assign val (op lookup-variable-value) (const x) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch660))
compiled-branch659
  (assign continue (label after-call658))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch660
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call658
  (restore env)
  (restore continue)
  (test (op false?) (reg val))
  (branch (label false-branch635))
true-branch636
  (assign proc (op lookup-variable-value) (const delete-reverse) (reg env))
  (save continue)
  (save proc)
  (assign val (op lookup-variable-value) (const no-xs) (reg env))
  (assign argl (op list) (reg val))
  (save argl)
  (assign proc (op lookup-variable-value) (const cdr) (reg env))
  (assign val (op lookup-variable-value) (const maybe-xs) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch651))
compiled-branch650
  (assign continue (label after-call649))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch651
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call649
  (restore argl)
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch654))
compiled-branch653
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch654
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call652
false-branch635
  (assign proc (op lookup-variable-value) (const delete-reverse) (reg env))
  (save continue)
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const cons) (reg env))
  (save proc)
  (assign val (op lookup-variable-value) (const no-xs) (reg env))
  (assign argl (op list) (reg val))
  (save argl)
  (assign proc (op lookup-variable-value) (const car) (reg env))
  (assign val (op lookup-variable-value) (const maybe-xs) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch639))
compiled-branch638
  (assign continue (label after-call637))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch639
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call637
  (restore argl)
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch642))
compiled-branch641
  (assign continue (label after-call640))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch642
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call640
  (assign argl (op list) (reg val))
  (restore env)
  (save argl)
  (assign proc (op lookup-variable-value) (const cdr) (reg env))
  (assign val (op lookup-variable-value) (const maybe-xs) (reg env))
  (assign argl (op list) (reg val))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch645))
compiled-branch644
  (assign continue (label after-call643))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch645
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call643
  (restore argl)
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch648))
compiled-branch647
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch648
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call646
after-if634
after-if631
after-lambda629
  (perform (op define-variable!) (const delete-reverse) (reg val) (reg env))
  (assign val (const (the-unspecified-value)))
  (assign proc (op lookup-variable-value) (const delete-reverse) (reg env))
  (save continue)
  (save proc)
  (assign val (const ()))
  (assign argl (op list) (reg val))
  (save argl)
  (assign proc (op lookup-variable-value) (const delete-reverse) (reg env))
  (assign val (const ()))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value) (const l) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch625))
compiled-branch624
  (assign continue (label after-call623))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch625
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call623
  (restore argl)
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch628))
compiled-branch627
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
primitive-branch628
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
after-call626
after-lambda621
  (perform (op define-variable!) (const delq2) (reg val) (reg env))
  (assign val (const (the-unspecified-value)))
  (goto (reg continue))
;No value


;;;----------------------------------------------------------------------------
PostLab Exercise 6B:

Given the high number of list related operations included in our
register machine, the most useful optimization would be to recognize
these procedures and not need to look them up.  Scheme is a heavily
list oriented language, and it is likely that any procedure will use
these procedures rather heavily.  It would be a rather simple task to,
during compilation, compare each procedure to the list of procedures
for our compiler.  We could then skip the step of going to primitive
branch and having to apply-primitive-procedure.  This is a very simple
enhancement, but very effective due to how often it comes into effect.
A simple seek on a list maintained by the compiler for the operation
being compiled would take a (very) little extra time during
compilation, and would greatly speed up the runtime code.


;;;----------------------------------------------------------------------------
;;; Notes

I really enjoyed this problem set (although it would have been cool to
do more coding).  The subject matter is a lot of fun, and I learned a
lot (not on the problem set actually, but the section.  Especially the
lecture on garbage collection).






