diff options
| author |  Peter McGoron
| 2025-07-09 17:35:20 -0400 |
|---|---|---|
| committer | Peter McGoron
| 2025-07-09 17:35:20 -0400 |
| commit | 3f563dc7a682003e5fd3e4d4c1b88a109e046ddc (patch) | |
| tree | 411fdbf6e480a05d77977f562448f4bc5dc3db3e | |
| parent | add syntax-error, only evaluate defined terms to weak head normal form (diff) | |
fix improper list patterns
Diffstat (limited to '')
| -rw-r--r-- | multisyntax/examples/untyped-lambda-calculus-prelude.scm | 2 | ||||
| -rw-r--r-- | multisyntax/examples/untyped-lambda-calculus.scm | 3 | ||||
| -rw-r--r-- | multisyntax/pattern/internal.scm | 14 |
3 files changed, 10 insertions, 9 deletions
diff --git a/multisyntax/examples/untyped-lambda-calculus-prelude.scm b/multisyntax/examples/untyped-lambda-calculus-prelude.scm index 04403a3..8048f41 100644 --- a/multisyntax/examples/untyped-lambda-calculus-prelude.scm +++ b/multisyntax/examples/untyped-lambda-calculus-prelude.scm @@ -87,5 +87,5 @@ ((define (name . args) body ...) (define name (rec (name . args) body ...))) ((define name body) - (%define name (letrec ((name body)) name)))))) + (%define name (Y (λ (name) body))))))) diff --git a/multisyntax/examples/untyped-lambda-calculus.scm b/multisyntax/examples/untyped-lambda-calculus.scm index 1f0ea7e..2488b14 100644 --- a/multisyntax/examples/untyped-lambda-calculus.scm +++ b/multisyntax/examples/untyped-lambda-calculus.scm @@ -439,7 +439,7 @@ (define (eval-identifier expr env) (hashmap-ref env expr - (lambda () (error "unbound variable" expr)) + (lambda () (error "unbound variable" (syntax->datum expr))) (lambda (x) (cond ((eq? x 'variable) expr) @@ -537,7 +537,6 @@ (define (lcrepl) (let ((expr (read))) (unless (eof-object? expr) - (display (list "expanding" expr)) (newline) (let-values (((exprs newmap) (lceval (list (empty-wrap expr)) (unbox (current-environment))))) (set-box! (current-environment) newmap) diff --git a/multisyntax/pattern/internal.scm b/multisyntax/pattern/internal.scm index 38059c8..d0593ac 100644 --- a/multisyntax/pattern/internal.scm +++ b/multisyntax/pattern/internal.scm @@ -119,12 +119,14 @@ ;; Returns (values has-ellipsis? next). `has-ellipsis?` is true if the ;; pair is an ellipsis pattern, and false otherwise. `next` is the next ;; pattern that will be matched. - (if (null? patcdr) - (values #f patcdr) - (let ((patcadr (unwrap-syntax (car patcdr)))) - (if (actual-ellipsis? patcadr) - (values #t (cdr patcdr)) - (values #f patcdr))))) + (cond + ((null? patcdr) (values #f patcdr)) + ((not (pair? patcdr)) (values #f patcdr)) + (else + (let ((patcadr (unwrap-syntax (car patcdr)))) + (if (actual-ellipsis? patcadr) + (values #t (cdr patcdr)) + (values #f patcdr)))))) (define (literal? identifier) (set-contains? (literals) identifier)) |