From 7e2cb02cb9e846b9502de7f677e69ebcc710cdce Mon Sep 17 00:00:00 2001
From: JJ
Date: Wed, 23 Oct 2024 17:26:11 -0700
Subject: refactor all implementations to use contracts

---
 stlc.rkt | 56 ++++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 42 insertions(+), 14 deletions(-)

(limited to 'stlc.rkt')

diff --git a/stlc.rkt b/stlc.rkt
index 2ed7d90..3058bf2 100644
--- a/stlc.rkt
+++ b/stlc.rkt
@@ -1,23 +1,48 @@
 #lang racket
 (require "lib.rkt")
 (require "base.rkt")
-(provide interpret check infer)
+(provide (all-defined-out))
 
 ;; The Simply-Typed Lambda Calculus
 
-;;      (interpret Expr Context): Value
-(define (interpret expr [Γ #hash()])
-  (match (strip expr)
+;; Checks an expression for syntactic well-formedness.
+(define (stlc/expr? expr)
+  (match expr
+    [x #:when (symbol? x) #t]
+    [`(,e1 ,e2) (and (stlc/expr? e1) (stlc/expr? e2))]
+    [`(λ (,x : ,t) ,e) (and (symbol? x) (stlc/type? t) (stlc/expr? e))]
+    [_ #f]))
+
+;; Checks a type for syntactic well-formedness.
+(define (stlc/type? type)
+  (match type
+    [t #:when (symbol? t) #t]
+    [`(,t1 → ,t2) (and (stlc/type? t1) (stlc/type? t2))]
+    [_ #f]))
+
+;; Checks a value for syntactic well-formedness.
+(define (stlc/value? value)
+  (match value
+    [x #:when (symbol? x) #t]
+    [`(,v1 ,v2) (and (stlc/value? v1) (stlc/value? v2))]
+    [`(λ ,x ,e ,env) (and (symbol? x) (stlc/expr? e) (dict? env))]
+    [_ #f]))
+
+;; Interprets an expression down to a value, in a given context.
+(define/contract (interpret expr [Γ #hash()])
+  (->* (stlc/expr?) (dict?) stlc/value?)
+  (match expr
     [x #:when (dict-has-key? Γ x) (dict-ref Γ x)]
-    [`(λ ,x ,e) `(λ ,x ,e ,Γ)]
+    [f #:when (symbol? f) f]
+    [`(λ (,x : ,t) ,e) `(λ ,x ,e ,Γ)]
     [`(,e1 ,e2)
       (match (interpret e1 Γ)
         [`(λ ,x ,e ,env) (interpret e (dict-set env x (interpret e2 Γ)))]
-        [e `(,e ,(interpret e2 Γ))])]
-    [e e]))
+        [e `(,e ,(interpret e2 Γ))])]))
 
-;;      (check Expr Type Context): Bool
-(define (check expr with [Γ #hash()])
+;; Checks an expression against some type, in a given context.
+(define/contract (check expr with [Γ #hash()])
+  (->* (stlc/expr? stlc/type?) (dict?) boolean?)
   (match expr
     [`(λ (,x : ,t) ,e)
       (match with
@@ -26,16 +51,19 @@
         [_ #f])]
     [_ (equal? with (infer with Γ))]))
 
-;;      (infer Expr Context): Type
-(define (infer expr [Γ #hash()])
+;; Infers a type from some expression, in a given context.
+(define/contract (infer expr [Γ #hash()])
+  (->* (stlc/expr?) (dict?) stlc/type?)
   (match expr
     [x #:when (dict-has-key? Γ x) (dict-ref Γ x)]
-    [`(λ (,x : ,t) ,e)
-      `(,t → ,(infer e (dict-set Γ x t)))]
+    [f #:when (symbol? f)
+      (err (format "attempting to infer type of free variable ~a" f))]
     [`(,e1 ,e2)
       (match (infer e1 Γ)
         [`(,t1 → ,t2)
           (if (check e2 t1 Γ) t2
             (err (format "inferred argument type ~a does not match arg ~a" t1 e2)))]
         [t (err (format "expected → type on application body, got ~a" t))])]
-    [e (err (format "attempting to infer an unknown expression ~a" e))]))
+    [`(λ (,x : ,t) ,e)
+      `(,t → ,(infer e (dict-set Γ x t)))]))
+
-- 
cgit v1.2.3-70-g09d2