diff options
| author |  Peter McGoron
| 2025-06-28 13:45:46 -0400 |
|---|---|---|
| committer | Peter McGoron
| 2025-06-28 13:45:46 -0400 |
| commit | 8e228a0d7d02802b375e102f03eccf539b839606 (patch) | |
| tree | 49b04d20347e67ade9f19be086f81f6b7434d6be /test | |
| parent | fix self-syntax and shadowing of syntax keywords (diff) | |
Change environments in untyped LC to use location comparators instead of
bound identifier comparators
NOTE: location comparators are a non-standard thing equivalent to a free
identifier comparator. Should replace later.
The previous code would fail when attempting to process identifiers that
came from the output of a macro transformer, because those are marked.
Diffstat (limited to '')
| -rw-r--r-- | test/run.scm | 32 | ||||
| -rw-r--r-- | test/syntax-object.scm | 12 |
2 files changed, 31 insertions, 13 deletions
diff --git a/test/run.scm b/test/run.scm index bb2fca0..201c849 100644 --- a/test/run.scm +++ b/test/run.scm @@ -31,18 +31,36 @@ (import (multisyntax examples untyped-lambda-calculus) (multisyntax syntax-object)) -#;(let-values (((global-map expanded-list) - (expand initial-environment (list (empty-wrap '(lambda x x))))))) +(let-values (((global-map expanded-list) + (expand initial-environment (list (empty-wrap '(lambda x x)))))) + (display (alpha expanded-list)) (newline)) -#;(define-values (global-map expanded-list) - (expand initial-environment - (list (empty-wrap '(let-syntax ((λ lambda)) - (λ x x)))))) +(let-values (((global-map expanded-list) + (expand initial-environment + (list (empty-wrap '(let-syntax ((λ lambda)) + (λ x x))))))) + (display (alpha expanded-list)) (newline)) (let-values (((global-map expanded-list) (expand initial-environment (list (empty-wrap '(lambda lambda (lambda lambda))))))) - (alpha expanded-list)) + (display (alpha expanded-list)) (newline)) + +(let-values (((global-map expanded-list) + (expand initial-environment + (list (empty-wrap '(define I (lambda x x))) + (empty-wrap '(I (lambda I I))))))) + (display (alpha expanded-list)) (newline)) + +(let-values (((global-map expanded-list) + (expand initial-environment + (list (empty-wrap + '(define-syntax let + (syntax-rules () + ((let (name value) body) + ((lambda name body) value))))) + (empty-wrap '(let (x (lambda x x)) (x x))))))) + (display (alpha expanded-list)) (newline)) #;(begin (load "examples/untyped-lambda-calculus.sld") diff --git a/test/syntax-object.scm b/test/syntax-object.scm index 674a675..31d6b22 100644 --- a/test/syntax-object.scm +++ b/test/syntax-object.scm @@ -17,9 +17,9 @@ (list '() 1 #\a #f "a" #u8(1 2 3 4))) (define (test-locations) - (test-assert (comparator-test-type environment-key-comparator + (test-assert (comparator-test-type location-comparator (generate-lexical-location 'test))) - (test-assert (comparator-test-type environment-key-comparator + (test-assert (comparator-test-type location-comparator 'test))) (define (test-self-syntax) @@ -98,7 +98,7 @@ (generate-timestamp)) (empty-wrap 'test) newloc))) - (test-assert (=? environment-key-comparator + (test-assert (=? location-comparator 'test (resolve stx))))) (test-group "mismatched resolved name" @@ -106,7 +106,7 @@ (stx (add-substitution (empty-wrap 'test) (empty-wrap 'test2) newloc))) - (test-assert (=? environment-key-comparator + (test-assert (=? location-comparator 'test (resolve stx))))) (test-group "multiple names in environment" @@ -118,7 +118,7 @@ (stx (add-substitution stx (empty-wrap 'test2) loc2))) - (test-assert (=? environment-key-comparator + (test-assert (=? location-comparator (resolve stx) loc1)))) (test-group "intermediate substitutions" @@ -128,7 +128,7 @@ (empty-wrap 'test) loc1)) (stx (add-substitution stx stx loc2))) - (test-assert (=? environment-key-comparator + (test-assert (=? location-comparator (resolve stx) loc2))))) |