fixup

9 files changed, 261 insertions, 22 deletions

diff --git a/coding-exercises/2/78.rkt b/coding-exercises/2/78.rkt
index 637ea10..1043e66 100644
--- a/coding-exercises/2/78.rkt
+++ b/coding-exercises/2/78.rkt
@@ -1,7 +1,8 @@
 #lang racket
 (require "../../shared/data-directed-programming.rkt")
-(require "./78/complex-rectangular.rkt")
-(require "./78/complex-polar.rkt")
+(require "./78/scheme-number.rkt")
+(require "./78/install-rational-package.rkt")
+(require "./78/install-complex-package.rkt")
 ;; We are basically making a data directed framework for arithmethic operations in this module
 (define pkg (make-dispatch-table))
 (define put (putter pkg))
@@ -9,5 +10,66 @@
 (define print-tbl (printer pkg))
 (define apply-generic (make-apply put get))
 
-(install-rectangular-package put)
-(install-polar-package put)
+(install-scheme-number-package put)
+(install-rational-package put)
+(install-complex-package apply-generic get put)
+
+;; test running
+;; num
+(define (make-scheme-number n)
+  ((get 'make 'scheme-number) n))
+(define test-num (make-scheme-number 3))
+
+;; rational
+(define (make-rat n d)
+  ((get 'make 'rational) n d))
+(define test-rat (make-rat 1 2))
+
+;; complex
+(define (make-complex x y)
+  ((get 'make-from-real-imag 'complex) x y))
+(define test-complex (make-complex 1 2))
+
+((lambda ()
+   (println "add sub mul div")
+   (print (apply-generic 'add test-num test-num))
+   (print (apply-generic 'add test-rat test-rat))
+   (print (apply-generic 'add test-complex test-complex))
+   (newline)
+   (print (apply-generic 'sub test-num test-num))
+   (print (apply-generic 'sub test-rat test-rat))
+   (print (apply-generic 'sub test-complex test-complex))
+   (newline)
+   (print (apply-generic 'div test-num test-num))
+   (print (apply-generic 'div test-rat test-rat))
+   (print (apply-generic 'div test-complex test-complex))
+   (newline)
+   (print (apply-generic 'mul test-num test-num))
+   (print (apply-generic 'mul test-rat test-rat))
+   (print (apply-generic 'mul test-complex test-complex))))
+
+;; 78
+((lambda ()
+   (newline)
+   ;; Should be represented just as a scheme number
+   (display test-num)))
+
+;; 79
+(define (equ? a b)
+  (apply-generic 'equ? a b))
+((lambda ()
+   (newline)
+   (display "testing equ?")
+   (newline)
+   (println (equ? test-num test-num))
+   (println (equ? test-rat test-rat))
+   (println (equ? test-complex test-complex))))
+
+;; 80
+(define (=zero? n)
+  (apply-generic '=zero? n))
+((lambda ()
+   (newline)
+   (println (=zero? test-num))
+   (println (=zero? test-rat))
+   (println (=zero? test-complex))))
diff --git a/coding-exercises/2/78/complex-polar.rkt b/coding-exercises/2/78/complex-polar.rkt
index 661627d..3c8cfe8 100644
--- a/coding-exercises/2/78/complex-polar.rkt
+++ b/coding-exercises/2/78/complex-polar.rkt
@@ -1,7 +1,8 @@
 #lang racket
 (provide install-polar-package)
+(require "../../../shared/data-directed-programming.rkt")
 
-(define (install-polar-package)
+(define (install-polar-package put)
   (define (magnitude z)
     (car z))
   (define (angle z)
@@ -21,4 +22,7 @@
   (put 'real-part '(polar) real-part)
   (put 'imag-part '(polar) imag-part)
   (put 'magnitude '(polar) magnitude)
-  (put 'angle '(polar)))
+  (put 'angle '(polar) angle)
+  (put 'make-from-real-imag 'polar (lambda (x y) (typtag (make-from-real-imag x y))))
+  (put 'make-from-mag-ang 'polar (lambda (r a) (typtag (make-from-mag-ang r a))))
+  'done)
diff --git a/coding-exercises/2/78/complex-rectangular.rkt b/coding-exercises/2/78/complex-rectangular.rkt
index 41e93b6..bbc2b8c 100644
--- a/coding-exercises/2/78/complex-rectangular.rkt
+++ b/coding-exercises/2/78/complex-rectangular.rkt
@@ -26,4 +26,5 @@
   (put 'make-from-real-imag 'rectangular
        (lambda (x y) (typtag (make-from-real-imag x y))))
   (put 'make-from-mag-ang 'rectangular
-       (lambda (r a) (typtag (make-from-mag-ang r a)))))
+       (lambda (r a) (typtag (make-from-mag-ang r a))))
+  'done)
diff --git a/coding-exercises/2/78/install-complex-package.rkt b/coding-exercises/2/78/install-complex-package.rkt
new file mode 100644
index 0000000..a656495
--- /dev/null
+++ b/coding-exercises/2/78/install-complex-package.rkt
@@ -0,0 +1,73 @@
+#lang racket
+(provide install-complex-package)
+(require "../../../shared/data-directed-programming.rkt")
+(require "./complex-rectangular.rkt")
+(require "./complex-polar.rkt")
+
+
+(define (install-complex-package apply-generic get put)
+  ;; install and import methods
+  (install-rectangular-package put)
+  (install-polar-package put)
+  (define (make-from-real-imag x y)
+    ((get 'make-from-real-imag 'rectangular) x y))
+  (define (make-from-mag-ang r a)
+    ((get 'make-from-mag-ang 'polar) r a))
+
+  (define (real-part z)
+    (apply-generic 'real-part z))
+  (define (imag-part z)
+    (apply-generic 'imag-part z))
+  (define (magnitude z)
+    (apply-generic 'magnitude z))
+  (define (angle z)
+    (apply-generic 'angle z))
+
+  ;; internal
+  (define (add-complex z1 z2)
+    (make-from-real-imag (+ (real-part z1) (real-part z2))
+                         (+ (imag-part z1) (imag-part z2))))
+  (define (sub-complex z1 z2)
+    (make-from-real-imag (- (real-part z1) (real-part z2))
+                         (- (imag-part z1) (imag-part z2))))
+  (define (mul-complex z1 z2)
+    (make-from-mag-ang (* (magnitude z1) (magnitude z2))
+                       (+ (angle z1) (angle z2))))
+  (define (div-complex z1 z2)
+    (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
+                       (- (angle z1) (angle z2))))
+
+  ;; predicates (...) -> bool
+  (define (equ? z1 z2)
+    (and (equal? (real-part z1) (real-part z2))
+         (equal? (imag-part z1) (imag-part z2))))
+  (define (=zero? z)
+    (and (= (real-part z)) (= (imag-part z))))
+
+  ;; interface
+  (define (typetag z) (attach-tag 'complex z))
+  (put 'real-part '(complex) real-part)
+  (put 'imag-part '(complex) imag-part)
+  (put 'magnitude '(complex) magnitude)
+  (put 'angle '(complex) angle)
+
+  (put 'add '(complex complex)
+       (lambda (z1 z2) (typetag (add-complex z1 z2))))
+  (put 'sub '(complex complex)
+       (lambda (z1 z2) (typetag (sub-complex z1 z2))))
+  (put 'mul '(complex complex)
+       (lambda (z1 z2) (typetag (mul-complex z1 z2))))
+  (put 'div '(complex complex)
+       (lambda (z1 z2) (typetag (div-complex z1 z2))))
+
+  (put 'equ? '(complex complex)
+       (lambda (z1 z2) (equ? z1 z2)))
+  (put '=zero? '(complex)
+       (lambda (z1) (=zero? z1)))
+
+  (put 'make-from-real-imag 'complex
+       (lambda (x y) (typetag (make-from-real-imag x y))))
+  (put 'make-from-mag-ang 'complex
+       (lambda (r a) (typetag (make-from-mag-ang r a))))
+  'done)
+
diff --git a/coding-exercises/2/78/install-rational-package.rkt b/coding-exercises/2/78/install-rational-package.rkt
new file mode 100644
index 0000000..db4475e
--- /dev/null
+++ b/coding-exercises/2/78/install-rational-package.rkt
@@ -0,0 +1,58 @@
+#lang racket
+(provide install-rational-package)
+(require "../../../shared/data-directed-programming.rkt")
+
+
+(define (install-rational-package put)
+  ;; internal
+  (define (numer x) (car x))
+  (define (denom x) (cdr x))
+  (define (make-rat n d)
+    (define (sign x)
+      (cond
+        ((and (< x 0) (< d 0)) (* -1 x))
+        ((and (< 0 x) (< d 0)) (* -1 x))
+        (else x)))
+    (let ((g (gcd n d)))
+      (cons (sign (/ n g)) (abs (/ d g)))))
+  (define (add-rat x y)
+    (make-rat (+ (* (numer x) (denom y))
+                 (* (numer y) (denom x)))
+              (* (denom x) (denom y))))
+  (define (sub-rat x y)
+    (make-rat (- (* (numer x) (denom y))
+                 (* (numer y) (denom x)))
+              (* (denom x) (denom y))))
+  (define (mul-rat x y)
+    (make-rat (* (numer x) (numer y))
+              (* (denom x) (denom y))))
+  (define (div-rat x y)
+    (make-rat (* (numer x) (denom y))
+              (* (denom x) (numer y))))
+
+  ;; predicates
+  (define (equ? x y)
+    (and (equal? (numer x) (numer y))
+         (equal? (denom x) (denom y))))
+  (define (=zero? x)
+    (equal? (numer x) 0))
+
+  ;; interface
+  (define (typetag x) (attach-tag 'rational x))
+  (put 'add '(rational rational)
+       (lambda (x y) (typetag (add-rat x y))))
+  (put 'sub '(rational rational)
+       (lambda (x y) (typetag (sub-rat x y))))
+  (put 'mul '(rational rational)
+       (lambda (x y) (typetag (mul-rat x y))))
+  (put 'div '(rational rational)
+       (lambda (x y) (typetag (div-rat x y))))
+
+  (put 'equ? '(rational rational)
+       (lambda (x y) (equ? x y)))
+  (put '=zero? '(rational)
+       (lambda (x) (=zero? x)))
+
+  (put 'make 'rational
+       (lambda (x y) (typetag (make-rat x y))))
+  'done)
diff --git a/coding-exercises/2/78/scheme-number.rkt b/coding-exercises/2/78/scheme-number.rkt
new file mode 100644
index 0000000..fa9c0ec
--- /dev/null
+++ b/coding-exercises/2/78/scheme-number.rkt
@@ -0,0 +1,18 @@
+#lang racket
+(provide install-scheme-number-package)
+(require "../../../shared/data-directed-programming.rkt")
+
+
+(define (install-scheme-number-package put)
+  ;; interface part
+  (define (typtag x)
+    (attach-tag 'scheme-number x))
+
+  (put 'add '(scheme-number scheme-number) (lambda (x y) (typtag (+ x y))))
+  (put 'sub '(scheme-number scheme-number) (lambda (x y) (typtag (- x y))))
+  (put 'mul '(scheme-number scheme-number) (lambda (x y) (typtag (* x y))))
+  (put 'div '(scheme-number scheme-number) (lambda (x y) (typtag (/ x y))))
+  (put 'equ? '(scheme-number scheme-number) (lambda (x y) (= x y)))
+  (put '=zero? '(scheme-number) (lambda (x) (= 0 x)))
+  (put 'make 'scheme-number (lambda (x) (typtag x)))
+  'done)
diff --git a/flake.lock b/flake.lock
index 2133be8..3ce6e4c 100644
--- a/flake.lock
+++ b/flake.lock
@@ -1,12 +1,15 @@
 {
   "nodes": {
     "flake-utils": {
+      "inputs": {
+        "systems": "systems"
+      },
       "locked": {
-        "lastModified": 1667395993,
-        "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=",
+        "lastModified": 1681202837,
+        "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=",
         "owner": "numtide",
         "repo": "flake-utils",
-        "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f",
+        "rev": "cfacdce06f30d2b68473a46042957675eebb3401",
         "type": "github"
       },
       "original": {
@@ -17,11 +20,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1668326430,
-        "narHash": "sha256-fJEsHe+lzFf3qcQVTTdK9jqRtUUVXH71tdfgjcKJNpA=",
+        "lastModified": 1682181988,
+        "narHash": "sha256-CYWhlNi16cjGzMby9h57gpYE59quBcsHPXiFgX4Sw5k=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "fc07622617a373a742ed96d4dd536849d4bc1ec6",
+        "rev": "6c43a3495a11e261e5f41e5d7eda2d71dae1b2fe",
         "type": "github"
       },
       "original": {
@@ -36,6 +39,21 @@
         "flake-utils": "flake-utils",
         "nixpkgs": "nixpkgs"
       }
+    },
+    "systems": {
+      "locked": {
+        "lastModified": 1681028828,
+        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+        "owner": "nix-systems",
+        "repo": "default",
+        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-systems",
+        "repo": "default",
+        "type": "github"
+      }
     }
   },
   "root": "root",
diff --git a/flake.nix b/flake.nix
index 414ee15..3f447d2 100644
--- a/flake.nix
+++ b/flake.nix
@@ -16,7 +16,6 @@
   in {
     devShell = pkgs.mkShell {
       buildInputs = with pkgs; [
-        mitscheme
         racket
       ];
     };
diff --git a/shared/data-directed-programming.rkt b/shared/data-directed-programming.rkt
index 6cecaf1..7566e30 100644
--- a/shared/data-directed-programming.rkt
+++ b/shared/data-directed-programming.rkt
@@ -15,15 +15,21 @@
 
 ;; Type tagged data
 (define (attach-tag type-tag contents)
-  (cons type-tag contents))
+  (cond ((number? contents) contents)
+        ((symbol? contents) contents)
+        (else (cons type-tag contents))))
 (define (type-tag datum)
-  (if (pair? datum)
-    (car datum)
-    (error "Bad tagged datum -- TYPE-TAG" datum)))
+  (cond
+    ((pair? datum) (car datum))
+    ((number? datum) 'scheme-number)
+    ((symbol? datum) 'symbol)
+    (else (error "Bad tagged datum -- TYPE-TAG" datum))))
 (define (contents datum)
-  (if (pair? datum)
-    (cdr datum)
-    (error "Bad tagged datum -- CONTENTS" datum)))
+  (cond
+    ((pair? datum) (cdr datum))
+    ((number? datum) datum)
+    ((symbol? datum) datum)
+    (else (error "Bad tagged datum -- CONTENTS" datum))))
 
 (define (find-type type seq)
   (define (rec items)
@@ -39,7 +45,7 @@
   (define dispatch-table '())
   (define (printer)
     (newline)
-    (display dispatch-table))
+    (println dispatch-table))
   (define (get op types)
     (let ((op-datum (find-type op dispatch-table)))
       (if op-datum