diff options
| -rw-r--r-- | lc.rkt | 31 | ||||
| -rw-r--r-- | stlc-let.rkt | 36 |
2 files changed, 37 insertions, 30 deletions
@@ -1,21 +1,26 @@ -#lang racket +#lang racket ; note: do NOT use racket/base (require "lib.rkt") -;; the untyped lambda calculus +;; The Untyped Lambda Calculus -(define (interpret expr [ctx #hash()]) +; note: default arguments MUST all be at the end +(define (interpret expr [ctx '()]) (match expr - [val #:when (or (number? val) (string? val)) val] - [val #:when (symbol? val) - (with-handlers - ([exn:fail? (λ (exn) val)]) ; note: unbound identifiers are supported - (interpret (dict-ref ctx val) ctx))] - [`(λ ,id ,body) `(λ ,id ,body)] + [`(λ ,id ,body) + `(λ ,id ,(interpret body ctx))] + [`((λ ,id ,body) ,arg) + (interpret body (dict-set ctx id arg))] + [`(,id ,arg) #:when (dict-has-key? ctx id) + (interpret `(,(interpret (dict-ref ctx id) ctx) ,arg))] [`(,body ,arg) - (match (interpret body ctx) - [`(λ ,id ,body) (interpret body (dict-set ctx id (interpret arg ctx)))] - [expr `(,(interpret expr ctx) ,(interpret arg ctx))])] - [expr (err (format "unknown expression ~a" expr))])) + (let ([reduced (interpret body ctx)]) + (if (equal? body reduced) + `(,reduced ,(interpret arg ctx)) + (interpret `(,reduced ,arg) ctx)))] + [id #:when (dict-has-key? ctx id) + (interpret (dict-ref ctx id) ctx)] + [val #:when (symbol? val) val] + [_ (err (format "unknown expression ~a" expr))])) (require rackunit) (check-equal? (interpret '(λ x x)) '(λ x x)) diff --git a/stlc-let.rkt b/stlc-let.rkt index 84bf588..b2de7c8 100644 --- a/stlc-let.rkt +++ b/stlc-let.rkt @@ -1,29 +1,31 @@ -#lang racket ; note: do NOT use racket/base +#lang racket (require "lib.rkt") -;; the simply-typed lambda calculus, with let sugar +;; The Simply-Typed Lambda Calculus, with let sugar -(define (value? val) (or (number? val) (string? val))) +(define (value? val) (or (number? val) (string? val) (symbol? val))) -; note: default arguments MUST all be at the end -; no function overloading ;_; +; note: no function overloading ;_; ;; (interpret Expr Table[Sym, Expr]): Value -(define (interpret expr [ctx #hash()]) (interpret- (strip expr) ctx)) +(define (interpret expr) (interpret- (strip expr) '())) (define (interpret- expr ctx) (match expr - [val #:when (value? val) val] - [val #:when (symbol? val) - (with-handlers - ([exn:fail? (λ (exn) val)]) - (interpret- (dict-ref ctx val) ctx))] [`(λ ,id ,body) `(λ ,id ,body ,ctx)] [`(λ ,id ,body ,env) `(λ ,id ,body ,env)] - [`(,body ,arg) - (match (interpret- body ctx) - [`(λ ,id ,body) (interpret- body (dict-set ctx id (interpret- arg ctx)))] - [`(λ ,id ,body ,env) (interpret- body (dict-set env id (interpret- arg ctx)))] - [expr `(,(interpret- expr ctx) ,(interpret- arg ctx))])] - ; desugaring and error handling + [`((λ ,id ,body) ,arg) + (interpret- body (dict-set ctx id (interpret- arg ctx)))] + [`((λ ,id ,body ,env) ,arg) + (interpret- body (dict-set env id (interpret- arg ctx)))] + [`(,id ,arg) #:when (dict-has-key? ctx id) + (interpret- `(,(interpret- (dict-ref ctx id) ctx) ,arg) ctx)] + [`(,body ,arg) ; todo: how to recognize an irreducible term? this is kinda cheating, i think + (let ([reduced (interpret- body ctx)]) + (if (equal? body reduced) + `(,reduced ,(interpret- arg ctx)) + (interpret- `(,reduced ,arg) ctx)))] + [id #:when (dict-has-key? ctx id) + (interpret- (dict-ref ctx id) ctx)] + [val #:when (value? val) val] [`(let ,id ,expr ,body) (interpret- `((λ ,id ,body) ,expr) ctx)] [expr (err (format "interpreting an unknown expression ~a" expr))])) |