blob: a2f308ebfd1303f6e937fa67dbd35fb84e87b3e1 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
#| Copyright (c) Peter McGoron 2025
|
| Licensed under the Apache License, Version 2.0 (the "License");
| you may not use this file except in compliance with the License.
| You may obtain a copy of the License at
|
| http://www.apache.org/licenses/LICENSE-2.0
|
| Unless required by applicable law or agreed to in writing, software
| distributed under the License is distributed on an "AS IS" BASIS,
| WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
| See the License for the specific language governing permissions and
| limitations under the License.
|#
(define-syntax test-alpha
(syntax-rules ()
((test-alpha name (inputs ...) output)
(let-values (((global-map expanded-list)
(expand initial-environment
(list (empty-wrap (quote inputs)) ...))))
(test-equal name
(quote output)
(map (lambda (term)
(debruijnize global-map term '()))
expanded-list))))))
(define (test-expander)
(test-alpha "identity"
((lambda x x))
((lambda 0)))
(test-alpha "let-syntax of identifier"
((let-syntax ((λ lambda))
(λ x x))
(λ x x))
((lambda 0)
(λ x x)))
(test-alpha "define-syntax of identifier"
((define-syntax λ lambda)
(λ x x))
((lambda 0)))
(test-alpha "lexical renaming of keywords"
((lambda lambda (lambda lambda)))
((lambda (0 0))))
(test-alpha "simple syntax-rules"
((define-syntax let
(syntax-rules ()
((let ((name value)) body)
((lambda name body) value))))
(let ((x (f y))) (f x)))
(((lambda (f 0)) (f y))))
(test-alpha "syntax-rules with ellipsis"
((define-syntax let
(syntax-rules ()
((let ((name value)) body)
((lambda name body) value))))
(define-syntax or
(syntax-rules ()
((or) false)
((or x y ...)
(let ((tmp x))
(if tmp tmp (or y ...))))))
(or a tmp b))
(((lambda (if 0
0
((lambda (if 0
0
((lambda (if 0
0
false))
b))) tmp))) a)))
(test-alpha "splicing-let-syntax"
((splicing-let-syntax ((λ lambda))
(define-syntax lambda
(syntax-rules ()
((_ (name) body) (λ name body))
((_ (name rest ...) body)
(λ name (lambda (rest ...) body)))
((_ name body) (λ name body)))))
(lambda (x y) (x y)))
((lambda (lambda (1 0))))))
(define (test-untyped-lambda-calculus)
(test-group "untyped lambda calculus"
(test-expander)))
|
