www

commit 46598499d108b3553036853f459014a1a0469e52
parent dafa992176d0376988cc879c9fdd775d9fd4d66f
Author: Stephen Chang <stchang@ccs.neu.edu>
Date:   Wed,  8 Jul 2015 17:15:08 -0400

move define to stlc+var.rkt; cleanup

Diffstat:
M
tapl/stlc+box.rkt
 | 
8
++++----
M
tapl/stlc+cons.rkt
 | 
20
++++----------------
M
tapl/stlc+var.rkt
 | 
23
+++++++++++++++++------

3 files changed, 25 insertions(+), 26 deletions(-)
diff --git a/tapl/stlc+box.rkt b/tapl/stlc+box.rkt
@@ -1,9 +1,9 @@
 #lang racket/base
 (require "typecheck.rkt")
-(require (prefix-in stlc: (only-in "stlc+cons.rkt" #%app λ))
-         (except-in "stlc+cons.rkt" #%app λ))
-(provide (rename-out [stlc:#%app #%app] [stlc:λ λ]))
-(provide (except-out (all-from-out "stlc+cons.rkt") stlc:#%app stlc:λ))
+(require (prefix-in stlc: (only-in "stlc+cons.rkt" #%app))
+         (except-in "stlc+cons.rkt" #%app))
+(provide (rename-out [stlc:#%app #%app]))
+(provide (except-out (all-from-out "stlc+cons.rkt") stlc:#%app))
 (provide ref deref :=)
 
 ;; Simply-Typed Lambda Calculus, plus mutable references
diff --git a/tapl/stlc+cons.rkt b/tapl/stlc+cons.rkt
@@ -1,10 +1,9 @@
 #lang racket/base
 (require "typecheck.rkt")
-(require (prefix-in stlc: (only-in "stlc+var.rkt" #%app λ let begin))
-         (except-in "stlc+var.rkt" #%app λ let begin))
-(provide (rename-out [stlc:#%app #%app] [stlc:λ λ] [stlc:let let] [stlc:begin begin]
-                     [cons/tc cons] [define/tc define]))
-(provide (except-out (all-from-out "stlc+var.rkt") stlc:#%app stlc:λ stlc:let stlc:begin))
+(require (prefix-in stlc: (only-in "stlc+var.rkt" #%app))
+         (except-in "stlc+var.rkt" #%app))
+(provide (rename-out [stlc:#%app #%app] [cons/tc cons]))
+(provide (except-out (all-from-out "stlc+var.rkt") stlc:#%app))
 (provide nil isnil head tail)
 
 ;; Simply-Typed Lambda Calculus, plus cons
@@ -13,20 +12,9 @@
 ;; - List constructor
 ;; Terms:
 ;; - terms from stlc+var.rkt
-;; - define, constants only
 
 ;; TODO: enable HO use of list primitives
 
-;; constants only
-(define-syntax (define/tc stx)
-  (syntax-parse stx
-    [(_ x:id e)
-     #:with (e- τ) (infer+erase #'e)
-     #:with y (generate-temporary)
-     #'(begin
-         (define-syntax x (make-rename-transformer (⊢ #'y #'τ)))
-         (define y e-))]))
-
 (define-type-constructor List #:arity 1)
 
 (define-syntax (nil stx)
diff --git a/tapl/stlc+var.rkt b/tapl/stlc+var.rkt
@@ -1,10 +1,11 @@
 #lang racket/base
 (require "typecheck.rkt")
-(require (prefix-in stlc: (only-in "stlc+tup.rkt" #%app λ tup proj let type=?))
-         (except-in "stlc+tup.rkt" #%app λ tup proj let type=?))
-(provide (rename-out [stlc:#%app #%app] [stlc:λ λ] [stlc:let let]))
+(require (prefix-in stlc: (only-in "stlc+tup.rkt" #%app begin tup proj let type=?))
+         (except-in "stlc+tup.rkt" #%app begin tup proj let type=?))
+(provide (rename-out [stlc:#%app #%app] [stlc:let let] [stlc:begin begin]
+                     [define/tc define]))
 (provide (except-out (all-from-out "stlc+tup.rkt")
-                     stlc:#%app stlc:λ stlc:let stlc:tup stlc:proj
+                     stlc:#%app stlc:let stlc:begin stlc:tup stlc:proj
                      (for-syntax stlc:type=?)))
 (provide tup proj var case)
 (provide (for-syntax type=?))
@@ -22,6 +23,8 @@
 ;; - terms from stlc+tup.rkt
 ;; - extend tup to include records
 ;; - sums (var)
+;; TopLevel:
+;; - define (values only)
 
 (begin-for-syntax
   ; extend to:
@@ -88,4 +91,12 @@
      (⊢ #'(let ([l_e (car e-)])
             (cond [(string=? l_e l) (let ([x- (cadr e-)]) e_l-)] ...))
         (stx-car #'(τ_el ...)))]))
-     
-\ No newline at end of file
+
+(define-syntax (define/tc stx)
+  (syntax-parse stx
+    [(_ x:id e)
+     #:with (e- τ) (infer+erase #'e)
+     #:with y (generate-temporary)
+     #'(begin
+         (define-syntax x (make-rename-transformer (⊢ #'y #'τ)))
+         (define y e-))]))
+\ No newline at end of file