Macros are now properly getting baked in Modules bug still persists

This commit is contained in:
Felix Brendel
2020-03-10 00:30:27 +01:00
parent 3b85873039
commit aac3985a61
20 changed files with 593 additions and 508 deletions
+18 -19
View File
@@ -1,22 +1,21 @@
;; (define-module math
;; :exports
;; (pi tau pow sqrt)
;; (define pi 3.1415)
;; (define tau (* 2 pi))
;; (define (pow a b) (** a b))
;; (define (sqrt a) (** a 0.5)))
;; (assert (= math::pi 3.1415))
;; (assert (= math::tau (* 2 math::tau)))
(tdefine-module 'math
(define-module math
:exports
'(pi tau pow sqrt)
(pi tau pow sqrt)
'(define pi 3.1415)
'(define tau (* 2 pi))
'(define (pow a b) (** a b))
'(define (sqrt a) (** a 0.5)))
(define pi 3.1415)
(define tau (* 2 pi))
(define (pow a b) (** a b))
(define (sqrt a) (** a 0.5)))
(assert (= math::pi 3.1415))
(assert (= math::tau (* 2 math::tau)))
;; (tdefine-module 'math
;; :exports
;; '(pi tau pow sqrt)
;; '(define pi 3.1415)
;; '(define tau (* 2 pi))
;; '(define (pow a b) (** a b))
;; '(define (sqrt a) (** a 0.5)))
+226 -233
View File
@@ -1,149 +1,149 @@
;; (define (abs x)
;; (cond ((< x 0) (- x))
;; (else x)))
(define (abs x)
(cond ((< x 0) (- x))
(else x)))
;; (assert (= (abs 1) 1))
;; (assert (= (abs (- 2)) 2))
(assert (= (abs 1) 1))
(assert (= (abs (- 2)) 2))
;; (define (abs x)
;; (if (< x 0)
;; (- x)
;; x))
(define (abs x)
(if (< x 0)
(- x)
x))
;; (assert (= (abs 12) 12))
;; (assert (= (abs (- 32)) 32))
(assert (= (abs 12) 12))
(assert (= (abs (- 32)) 32))
;; (define (>= x y)
;; (or (> x y)
;; (= x y)))
(define (>= x y)
(or (> x y)
(= x y)))
;; (assert (>= 2 2))
;; (assert (>= 3 2))
;; (assert (not (>= 1 2)))
;; (assert (not (>= 12 44)))
(assert (>= 2 2))
(assert (>= 3 2))
(assert (not (>= 1 2)))
(assert (not (>= 12 44)))
;; (define (>= x y)
;; (not (< x y)))
(define (>= x y)
(not (< x y)))
;; (assert (>= 2 2))
;; (assert (>= 3 2))
;; (assert (not (>= 1 2)))
;; (assert (not (>= 12 44)))
(assert (>= 2 2))
(assert (>= 3 2))
(assert (not (>= 1 2)))
(assert (not (>= 12 44)))
;; (define (a-plus-abs-b a b)
;; ((if (> b 0) + -) a b))
(define (a-plus-abs-b a b)
((if (> b 0) + -) a b))
;; (assert (= (a-plus-abs-b 1 2) 3))
;; (assert (= (a-plus-abs-b 1 -2) 3))
(assert (= (a-plus-abs-b 1 2) 3))
(assert (= (a-plus-abs-b 1 -2) 3))
;; (define (square x) (* x x))
;; (define (cube x) (* x x x))
(define (square x) (* x x))
(define (cube x) (* x x x))
;; (assert (= ((lambda (x y z)
;; (+ x y (square z)))
;; 1 2 3)
;; 12))
(assert (= ((lambda (x y z)
(+ x y (square z)))
1 2 3)
12))
;; ;;; --------------------
;; ;;; newtons method
;; ;;; --------------------
;; (define tolerance 0.001)
(define tolerance 0.001)
;; (define (square x)
;; (* x x))
(define (square x)
(* x x))
;; (define (average x y)
;; (/ (+ x y) 2))
(define (average x y)
(/ (+ x y) 2))
;; (define (improve guess x)
;; (average guess (/ x guess)))
(define (improve guess x)
(average guess (/ x guess)))
;; (define (good-enough? guess x)
;; (< (abs (- (square guess) x)) tolerance))
(define (good-enough? guess x)
(< (abs (- (square guess) x)) tolerance))
;; (define (sqrt-iter guess x)
;; (if (good-enough? guess x)
;; guess
;; (sqrt-iter (improve guess x) x)))
(define (sqrt-iter guess x)
(if (good-enough? guess x)
guess
(sqrt-iter (improve guess x) x)))
;; (define (sqrt x)
;; (sqrt-iter 1.0 x))
(define (sqrt x)
(sqrt-iter 1.0 x))
;; (define (sqrt2 x)
;; (define (good-enough? guess x)
;; (< (abs (- (square guess) x)) 0.001))
(define (sqrt2 x)
(define (good-enough? guess x)
(< (abs (- (square guess) x)) 0.001))
;; (define (improve guess x)
;; (average guess (/ x guess)))
(define (improve guess x)
(average guess (/ x guess)))
;; (define (sqrt-iter guess x)
;; (if (good-enough? guess x)
;; guess
;; (sqrt-iter (improve guess x) x)))
(define (sqrt-iter guess x)
(if (good-enough? guess x)
guess
(sqrt-iter (improve guess x) x)))
;; (sqrt-iter 1.0 x))
(sqrt-iter 1.0 x))
;; (define (sqrt3 x)
;; (define (good-enough? guess)
;; (< (abs (- (square guess) x)) 0.001))
(define (sqrt3 x)
(define (good-enough? guess)
(< (abs (- (square guess) x)) 0.001))
;; (define (improve guess)
;; (average guess (/ x guess)))
(define (improve guess)
(average guess (/ x guess)))
;; (define (sqrt-iter guess)
;; (if (good-enough? guess)
;; guess
;; (sqrt-iter (improve guess))))
(define (sqrt-iter guess)
(if (good-enough? guess)
guess
(sqrt-iter (improve guess))))
;; (sqrt-iter 1.0))
(sqrt-iter 1.0))
;; (assert (< (abs (- 3 (sqrt 9))) tolerance))
;; (assert (< (abs (- 4 (sqrt 16))) tolerance))
;; (assert (not (< (abs (- 4 (sqrt 15))) tolerance)))
(assert (< (abs (- 3 (sqrt 9))) tolerance))
(assert (< (abs (- 4 (sqrt 16))) tolerance))
(assert (not (< (abs (- 4 (sqrt 15))) tolerance)))
;; (assert (< (abs (- 3 (sqrt2 9))) tolerance))
;; (assert (< (abs (- 4 (sqrt2 16))) tolerance))
;; (assert (not (< (abs (- 4 (sqrt2 15))) tolerance)))
(assert (< (abs (- 3 (sqrt2 9))) tolerance))
(assert (< (abs (- 4 (sqrt2 16))) tolerance))
(assert (not (< (abs (- 4 (sqrt2 15))) tolerance)))
;; (assert (< (abs (- 3 (sqrt3 9))) tolerance))
;; (assert (< (abs (- 4 (sqrt3 16))) tolerance))
;; (assert (not (< (abs (- 4 (sqrt3 15))) tolerance)))
(assert (< (abs (- 3 (sqrt3 9))) tolerance))
(assert (< (abs (- 4 (sqrt3 16))) tolerance))
(assert (not (< (abs (- 4 (sqrt3 15))) tolerance)))
;; ;;; -----------------
;; ;;; factorial
;; ;;; -----------------
;;; -----------------
;;; factorial
;;; -----------------
;; (define (factorial n)
;; (if (= n 1)
;; 1
;; (* n (factorial (- n 1)))))
(define (factorial n)
(if (= n 1)
1
(* n (factorial (- n 1)))))
;; (define (factorial2 n)
;; (fact-iter 1 1 n))
(define (factorial2 n)
(fact-iter 1 1 n))
;; (define (fact-iter product counter max-count)
;; (if (> counter max-count)
;; product
;; (fact-iter (* counter product) (+ counter 1) max-count)))
(define (fact-iter product counter max-count)
(if (> counter max-count)
product
(fact-iter (* counter product) (+ counter 1) max-count)))
;; (define (factorial3 n)
;; (define (iter product counter)
;; (if (> counter n)
;; product
;; (iter (* counter product) (+ counter 1))))
(define (factorial3 n)
(define (iter product counter)
(if (> counter n)
product
(iter (* counter product) (+ counter 1))))
;; (iter 1 1))
(iter 1 1))
;; (assert (= (factorial 6) 720))
;; (assert (= (factorial2 6) 720))
;; (assert (= (factorial3 6) 720))
(assert (= (factorial 6) 720))
(assert (= (factorial2 6) 720))
(assert (= (factorial3 6) 720))
;;; ----------------
;;; ackermann
@@ -154,13 +154,6 @@
((= n 0) (A (- m 1) 1))
(else (A (- m 1) (A m (- n 1))))))
;; (define (A m n)
;; (if (= m 0)
;; (+ n 1)
;; (if (= n 0)
;; (A (- m 1) 1)
;; (A (- m 1) (A m (- n 1))))))
(assert (= (A 0 0) 1))
(assert (= (A 1 2) 4))
(assert (= (A 3 1) 13))
@@ -170,50 +163,50 @@
;; ;;; Fibonacci
;; ;;; ---------------
;; (define (fib n)
;; (cond ((= n 0) 0)
;; ((= n 1) 1)
;; (else (+ (fib (- n 1)) (fib (- n 2))))))
(define (fib n)
(cond ((= n 0) 0)
((= n 1) 1)
(else (+ (fib (- n 1)) (fib (- n 2))))))
;; (define (fib2 n)
;; (fib-iter 1 0 n))
(define (fib2 n)
(fib-iter 1 0 n))
;; (define (fib-iter a b count)
;; (if (= count 0)
;; b
;; (fib-iter (+ a b) a (- count 1))))
(define (fib-iter a b count)
(if (= count 0)
b
(fib-iter (+ a b) a (- count 1))))
;; (assert (= (fib 2) 1))
;; (assert (= (fib 3) 2))
;; (assert (= (fib 4) 3))
;; (assert (= (fib 5) 5))
;; (assert (= (fib 6) 8))
(assert (= (fib 2) 1))
(assert (= (fib 3) 2))
(assert (= (fib 4) 3))
(assert (= (fib 5) 5))
(assert (= (fib 6) 8))
;; (assert (= (fib2 2) 1))
;; (assert (= (fib2 3) 2))
;; (assert (= (fib2 4) 3))
;; (assert (= (fib2 5) 5))
;; (assert (= (fib2 6) 8))
(assert (= (fib2 2) 1))
(assert (= (fib2 3) 2))
(assert (= (fib2 4) 3))
(assert (= (fib2 5) 5))
(assert (= (fib2 6) 8))
;; ;;; ------------------
;; ;;; count change
;; ;;; ------------------
;;; ------------------
;;; count change
;;; ------------------
;; (define (count-change amount)
;; (define (cc amount kinds-of-coins)
;; (cond ((= amount 0) 1)
;; ((or (< amount 0) (= kinds-of-coins 0)) 0)
;; (else (+ (cc amount (- kinds-of-coins 1))
;; (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins)))))
(define (count-change amount)
(define (cc amount kinds-of-coins)
(cond ((= amount 0) 1)
((or (< amount 0) (= kinds-of-coins 0)) 0)
(else (+ (cc amount (- kinds-of-coins 1))
(cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins)))))
;; (define (first-denomination kinds-of-coins)
;; (cond ((= kinds-of-coins 1) 1)
;; ((= kinds-of-coins 2) 5)
;; ((= kinds-of-coins 3) 10)
;; ((= kinds-of-coins 4) 25)
;; ((= kinds-of-coins 5) 50)))
(define (first-denomination kinds-of-coins)
(cond ((= kinds-of-coins 1) 1)
((= kinds-of-coins 2) 5)
((= kinds-of-coins 3) 10)
((= kinds-of-coins 4) 25)
((= kinds-of-coins 5) 50)))
;; (cc amount 5))
(cc amount 5))
;; (assert (= (count-change 100) 292))
@@ -221,128 +214,128 @@
;; ;;; exponentiation
;; ;;; --------------------
;; (define (expt b n)
;; (if (= n 0)
;; 1
;; (* b (expt b (- n 1)))))
(define (expt b n)
(if (= n 0)
1
(* b (expt b (- n 1)))))
;; (define (expt2 b n)
;; (define (expt-iter b counter product)
;; (if (= counter 0)
;; product
;; (expt-iter b (- counter 1) (* b product))))
(define (expt2 b n)
(define (expt-iter b counter product)
(if (= counter 0)
product
(expt-iter b (- counter 1) (* b product))))
;; (expt-iter b n 1))
(expt-iter b n 1))
;; (define (fast-expt b n)
;; (define (even? n)
;; (= (% n 2) 0))
(define (fast-expt b n)
(define (even? n)
(= (% n 2) 0))
;; (cond ((= n 0) 1)
;; ((even? n) (square (fast-expt b (/ n 2))))
;; (else (* b (fast-expt b (- n 1))))))
(cond ((= n 0) 1)
((even? n) (square (fast-expt b (/ n 2))))
(else (* b (fast-expt b (- n 1))))))
;; (assert (= (expt 1 2) 1))
;; (assert (= (expt 2 2) 4))
;; (assert (= (expt 2 3) 8))
(assert (= (expt 1 2) 1))
(assert (= (expt 2 2) 4))
(assert (= (expt 2 3) 8))
;; (assert (= (expt2 1 2) 1))
;; (assert (= (expt2 2 2) 4))
;; (assert (= (expt2 2 3) 8))
(assert (= (expt2 1 2) 1))
(assert (= (expt2 2 2) 4))
(assert (= (expt2 2 3) 8))
;; (assert (= (fast-expt 1 2) 1))
;; (assert (= (fast-expt 2 2) 4))
;; (assert (= (fast-expt 2 3) 8))
(assert (= (fast-expt 1 2) 1))
(assert (= (fast-expt 2 2) 4))
(assert (= (fast-expt 2 3) 8))
;; ;;; ----------
;; ;;; gcd
;; ;;; ----------
;;; ----------
;;; gcd
;;; ----------
;; (define (gcd a b)
;; (if (= b 0)
;; a
;; (gcd b (% a b))))
(define (gcd a b)
(if (= b 0)
a
(gcd b (% a b))))
;; (assert (= (gcd 40 6) 2))
;; (assert (= (gcd 13 4) 1))
(assert (= (gcd 40 6) 2))
(assert (= (gcd 13 4) 1))
;; ;;; ----------
;; ;;; primes
;; ;;; ----------
;;; ----------
;;; primes
;;; ----------
;; (define (smallest-divisor n)
;; (find-divisor n 2))
(define (smallest-divisor n)
(find-divisor n 2))
;; (define (find-divisor n test-divisor)
;; (cond ((> (square test-divisor) n) n)
;; ((divides? test-divisor n) test-divisor)
;; (else (find-divisor n (+ test-divisor 1)))))
(define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (+ test-divisor 1)))))
;; (define (divides? a b)
;; (= (% b a) 0))
(define (divides? a b)
(= (% b a) 0))
;; (define (prime? n)
;; (= n (smallest-divisor n)))
(define (prime? n)
(= n (smallest-divisor n)))
;; (assert (prime? 13))
;; (assert (prime? 11))
;; (assert (not (prime? 12)))
(assert (prime? 13))
(assert (prime? 11))
(assert (not (prime? 12)))
;;; ----------------------
;;; simple integral
;;; ----------------------
;; ----------------------
;; simple integral
;; ----------------------
;; (define (sum term a next b)
;; (if (> a b)
;; 0
;; (+ (term a) (sum term (next a) next b))))
(define (sum term a next b)
(if (> a b)
0
(+ (term a) (sum term (next a) next b))))
;; (define (integral f a b dx)
;; (define (add-dx x) (+ x dx))
;; (* (sum f (+ a (/ dx 2.0)) add-dx b) dx))
(define (integral f a b dx)
(define (add-dx x) (+ x dx))
(* (sum f (+ a (/ dx 2.0)) add-dx b) dx))
;; (define (pi-sum a b)
;; (define (pi-term x) (/ 1.0 (* x (+ x 2))))
;; (define (pi-next x) (+ x 4))
;; (sum pi-term a pi-next b))
(define (pi-sum a b)
(define (pi-term x) (/ 1.0 (* x (+ x 2))))
(define (pi-next x) (+ x 4))
(sum pi-term a pi-next b))
;; (assert (< (abs (- (* 8 (pi-sum 1 100)) 3.121595)) 0.0001))
;; (assert (< (abs (- (integral cube 0 1 0.02) 0.249950)) 0.0001))
(assert (< (abs (- (* 8 (pi-sum 1 100)) 3.121595)) 0.0001))
(assert (< (abs (- (integral cube 0 1 0.02) 0.249950)) 0.0001))
;; ------------------------------------------------------------
;; F(x,y) = x(1 + xy)^2 + y(1 − y) + (1 + xy)(1 − y)
;; F(x,y) = x(1 + xy)^2 + y(1 − y) + (1 + xy)(1 − y)
;; ------------------------------------------------------------
;; (define (f x y)
;; (let ((a (+ 1 (* x y)))
;; (b (- 1 y)))
;; (+ (* x (square a))
;; (* y b)
;; (* a b))))
(define (f x y)
(let ((a (+ 1 (* x y)))
(b (- 1 y)))
(+ (* x (square a))
(* y b)
(* a b))))
;; (assert (= (f 0 0) 1))
;; (assert (= (f 1 1) 4))
(assert (= (f 0 0) 1))
(assert (= (f 1 1) 4))
;; ;;; ---------------
;; ;;; find zero
;; ;;; ---------------
;;; ---------------
;;; find zero
;;; ---------------
;; (define (positive? x) (< 0 x))
;; (define (negative? x) (< x 0))
(define (positive? x) (< 0 x))
(define (negative? x) (< x 0))
;; (define (search f neg-point pos-point)
;; (let ((midpoint (average neg-point pos-point)))
;; (if (close-enough? neg-point pos-point)
;; midpoint
;; (let ((test-value (f midpoint)))
;; (cond ((positive? test-value) (search f neg-point midpoint))
;; ((negative? test-value) (search f midpoint pos-point))
;; (else midpoint))))))
(define (search f neg-point pos-point)
(let ((midpoint (average neg-point pos-point)))
(if (close-enough? neg-point pos-point)
midpoint
(let ((test-value (f midpoint)))
(cond ((positive? test-value) (search f neg-point midpoint))
((negative? test-value) (search f midpoint pos-point))
(else midpoint))))))
;; (define (close-enough? x y) (< (abs (- x y)) 0.001))
(define (close-enough? x y) (< (abs (- x y)) 0.001))
;; (assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1))
(assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1))