https://pastein.ru/t/szS
Загрузка данных
% Лабораторная работа № 2. Типы данных. Модульное тестирование
% <лабораторная ещё не сдана>
% Кирилл Меньшиков, ИУ9-12/6
# Цель работы
На практике ознакомиться с системой типов языка Scheme.
На практике ознакомиться с юнит-тестированием.
Разработать свои средства отладки программ на языке Scheme.
На практике ознакомиться со средствами метапрограммирования языка Scheme.
# Индивидуальный вариант
Процедура `reverse!` — деструктивное обращение списка, вектора или строки (с необязательным приёмником).
Процедура `factorize` — разложение на множители выражений вида `a² − b²`, `a³ − b³`, `a³ + b³`.
Также реализованы макрос `trace`, макрос `test` и процедуры `run-test`, `run-tests`.
# Реализация
```scheme
;; trace.scm
(define-syntax trace
(syntax-rules ()
((trace expr)
(begin
(write 'expr)
(display " => ")
(let ((value expr))
(display value)
(newline)
value)))))
```
```scheme
;; unit-test.scm
(define-syntax test
(syntax-rules ()
((test expr expected)
(list 'expr (lambda () expr) expected))))
(define (run-test t)
(let ((expr (car t))
(thunk (cadr t))
(expected (caddr t)))
(write expr)
(let ((actual (thunk)))
(if (equal? actual expected)
(begin (display " ok") (newline) #t)
(begin
(display " FAIL")
(newline)
(display " Expected: ")
(write expected)
(newline)
(display " Returned: ")
(write actual)
(newline)
#f)))))
(define (run-tests tests)
(let loop ((rest tests) (all-ok #t))
(if (null? rest)
all-ok
(let ((ok (run-test (car rest))))
(loop (cdr rest) (and all-ok ok))))))
```
```scheme
;; reverse!
(define (reverse! seq . opt)
(define (size x)
(cond ((vector? x) (vector-length x))
((string? x) (string-length x))
(else (length x))))
(define (ref x i)
(cond ((vector? x) (vector-ref x i))
((string? x) (string-ref x i))
(else (list-ref x i))))
(define (put! x i v)
(cond ((vector? x) (vector-set! x i v))
((string? x) (string-set! x i v))
(else (set-car! (list-tail x i) v))))
(let* ((dest (if (null? opt) seq (car opt)))
(n (size seq)))
(let loop ((i 0))
(if (<= i (- n i 1))
(let ((left (ref seq i))
(right (ref seq (- n i 1))))
(put! dest i right)
(put! dest (- n i 1) left)
(loop (+ i 1)))))
dest))
```
```scheme
;; factorize
(define (factorize expr)
(define (power-term? x)
(and (pair? x)
(eq? (car x) 'expt)
(= (length x) 3)
(number? (caddr x))
(or (= (caddr x) 2) (= (caddr x) 3))))
(define (base x) (cadr x))
(define (degree x) (caddr x))
(if (and (pair? expr)
(= (length expr) 3)
(or (eq? (car expr) '-) (eq? (car expr) '+))
(power-term? (cadr expr))
(power-term? (caddr expr))
(= (degree (cadr expr)) (degree (caddr expr))))
(let ((op (car expr))
(a (base (cadr expr)))
(b (base (caddr expr)))
(n (degree (cadr expr))))
(cond
((and (eq? op '-) (= n 2))
`(* (- ,a ,b) (+ ,a ,b)))
((and (eq? op '-) (= n 3))
`(* (- ,a ,b) (+ (expt ,a 2) (* ,a ,b) (expt ,b 2))))
((and (eq? op '+) (= n 3))
`(* (+ ,a ,b) (+ (- (expt ,a 2) (* ,a ,b)) (expt ,b 2))))
(else expr)))
expr))
```
# Тестирование
```
Welcome to DrRacket, version 6.10.1 [3m].
Language: R5RS; memory limit: 128 MB.
> (define (zip . xss)
(if (or (null? xss)
(null? (trace (car xss))))
'()
(cons (map car xss)
(apply zip (map cdr (trace xss))))))
> (zip '(1 2 3) '(one two three))
(car xss) => (1 2 3)
xss => ((1 2 3) (one two three))
(car xss) => (2 3)
xss => ((2 3) (two three))
(car xss) => (3)
xss => ((3) (three))
(car xss) => ()
((1 one) (2 two) (3 three))
> (define counter
(let ((n 0))
(lambda () (set! n (+ n 1)) n)))
> (+ (trace (counter)) (trace (counter)))
(counter) => 1
(counter) => 2
3
```
```scheme
(define (signum x)
(cond ((< x 0) -1)
((= x 0) 1) ; ошибка здесь
(else 1)))
(define counter
(let ((n 0))
(lambda () (set! n (+ n 1)) n)))
(define the-tests
(list (test (signum -2) -1)
(test (signum 0) 0)
(test (signum 2) 1)
(test (counter) 1)
(test (counter) 77) ; ошибка в тесте, должно быть 2
(test (counter) 3)
(test (* 7 7) "49")
(test (string-append "4" "9") 49)))
```
```
Welcome to DrRacket, version 6.10.1 [3m].
Language: R5RS; memory limit: 128 MB.
> (run-tests the-tests)
(signum -2) ok
(signum 0) FAIL
Expected: 0
Returned: 1
(signum 2) ok
(counter) ok
(counter) FAIL
Expected: 77
Returned: 2
(counter) ok
(* 7 7) FAIL
Expected: "49"
Returned: 49
(string-append "4" "9") FAIL
Expected: 49
Returned: "49"
#f
> (define bad-test (test (/ 10 0) 100))
> (run-test bad-test)
(/ 10 0)
/: division by zero
```
```scheme
(define (shared)
(let* ((as (list 'a 'b 'c))
(bs (append (list 'x 'y 'z) as)))
(set-car! as 1)
(list as bs)))
(define reverse-tests
(list
(test (let ((xs (list 1 2 3 4 5))) (reverse! xs) xs)
'(5 4 3 2 1))
(test (let ((xs (list 1 2 3 4))) (reverse! xs) xs)
'(4 3 2 1))
(test (let ((xs (list))) (reverse! xs) xs)
'())
(test (let ((ys (vector 1 2 3 4 5))) (reverse! ys) ys)
'#(5 4 3 2 1))
(test (let ((zs (string #\h #\e #\l #\l #\o))) (reverse! zs) zs)
"olleh")
(test (let ((xs (list 1 2 3))) (reverse! xs xs) xs)
'(3 2 1))
(test (let ((x (list 1 2 3)) (y (vector 0 0 0)))
(reverse! x y)
(list x y))
'((1 2 3) #(3 2 1)))
(test (let ((s (string #\a #\b)) (l (list 0 0)))
(reverse! s l)
(list s l))
'("ab" (#\b #\a)))
(test (let ((p (shared)))
(reverse! (cadr p))
p)
'((z y x) (c b 1 z y x)))
(test (let ((bs (cadr (shared))))
(reverse! bs)
(reverse! (cdr bs))
bs)
'(c x y z 1 b))))
```
```
Welcome to DrRacket, version 6.10.1 [3m].
Language: R5RS; memory limit: 128 MB.
> (run-tests reverse-tests)
(let ((xs (list 1 2 3 4 5))) (reverse! xs) xs) ok
(let ((xs (list 1 2 3 4))) (reverse! xs) xs) ok
(let ((xs (list))) (reverse! xs) xs) ok
(let ((ys (vector 1 2 3 4 5))) (reverse! ys) ys) ok
(let ((zs (string #\h #\e #\l #\l #\o))) (reverse! zs) zs) ok
(let ((xs (list 1 2 3))) (reverse! xs xs) xs) ok
(let ((x (list 1 2 3)) (y (vector 0 0 0))) (reverse! x y) (list x y)) ok
(let ((s (string #\a #\b)) (l (list 0 0))) (reverse! s l) (list s l)) ok
(let ((p (shared))) (reverse! (cadr p)) p) ok
(let ((bs (cadr (shared)))) (reverse! bs) (reverse! (cdr bs)) bs) ok
#t
```
```scheme
(define (value-of expr a b)
(eval (list (list 'lambda '(x y) expr) a b)
(interaction-environment)))
(define factorize-tests
(list
(test (factorize '(- (expt x 2) (expt y 2)))
'(* (- x y) (+ x y)))
(test (factorize '(- (expt x 3) (expt y 3)))
'(* (- x y) (+ (expt x 2) (* x y) (expt y 2))))
(test (factorize '(+ (expt x 3) (expt y 3)))
'(* (+ x y) (+ (- (expt x 2) (* x y)) (expt y 2))))
(test (factorize '(- (expt (+ first 1) 2) (expt (- second 1) 2)))
'(* (- (+ first 1) (- second 1))
(+ (+ first 1) (- second 1))))
(test (factorize '(+ (expt x 2) (expt y 2)))
'(+ (expt x 2) (expt y 2)))
(test (factorize '(* x y)) '(* x y))
(test (factorize 5) 5)
(test (value-of (factorize '(- (expt x 2) (expt y 2))) 1 2) -3)
(test (value-of (factorize '(- (expt x 3) (expt y 3))) 3 2) 19)
(test (value-of (factorize '(+ (expt x 3) (expt y 3))) 3 2) 35)))
```
```
Welcome to DrRacket, version 6.10.1 [3m].
Language: R5RS; memory limit: 128 MB.
> (run-tests factorize-tests)
(factorize (quote (- (expt x 2) (expt y 2)))) ok
(factorize (quote (- (expt x 3) (expt y 3)))) ok
(factorize (quote (+ (expt x 3) (expt y 3)))) ok
(factorize (quote (- (expt (+ first 1) 2) (expt (- second 1) 2)))) ok
(factorize (quote (+ (expt x 2) (expt y 2)))) ok
(factorize (quote (* x y))) ok
(factorize 5) ok
(value-of (factorize (quote (- (expt x 2) (expt y 2)))) 1 2) ok
(value-of (factorize (quote (- (expt x 3) (expt y 3)))) 3 2) ok
(value-of (factorize (quote (+ (expt x 3) (expt y 3)))) 3 2) ok
#t
> (eval (list (list 'lambda
'(x y)
(factorize '(- (expt x 2) (expt y 2))))
1 2)
(interaction-environment))
-3
```
# Вывод
В ходе лабораторной работы я познакомился с системой типов Scheme, макросами и метапрограммированием. Реализовал макрос `trace` для трассировки и каркас модульного тестирования, в котором тест не вычисляется при создании, а результаты сравниваются с помощью `equal?`. Реализовал процедуры `reverse!` для обращения списков, векторов и строк и `factorize` для разложения выражений на множители, проверил их модульными тестами.
