debuggin

assemble.rkt

@@ -1,5 +1,6 @@
 #lang typed/racket/base
 (require "typed-structs.rkt"
+         "helpers.rkt"
          racket/string
          racket/list)
 
@@ -66,13 +67,6 @@
 
 
 
-;; unique: (listof symbol -> listof symbol)
-(: unique ((Listof Symbol) -> (Listof Symbol)))
-(define (unique los)
-  (let: ([ht : (HashTable Symbol Boolean) (make-hasheq)])
-    (for ([l los])
-      (hash-set! ht l #t))
-    (hash-map ht (lambda: ([k : Symbol] [v : Boolean]) k))))
 
 
 

find-toplevel-variables.rkt

@@ -3,37 +3,44 @@
          "helpers.rkt"
          racket/list)
 
+(provide find-toplevel-variables)
+
+
+(: find-toplevel-variables (Expression -> (Listof Symbol)))
 ;; Collects the list of toplevel variables we need.
-
-(: find-toplevel (Expression -> (Listof Symbol)))
-(define (find-toplevel exp)
-  (cond
-    [(Constant? exp)
-     empty]
-    
-    [(Quote? exp)
-     empty]
-    
-    [(Var? exp)
-     (list (Var-id exp))]
-    
-    [(Assign? exp)
-     (find-toplevel (Assign-value exp))]
-    
-    [(Def? exp)
-     (find-toplevel (Def-value exp))]
-
-    [(Branch? exp)
-     (append (find-toplevel (Branch-predicate exp))
-             (find-toplevel (Branch-consequent exp))
-             (find-toplevel (Branch-alternative exp)))]
-    
-    [(Lam? exp)
-     (list-difference (apply append (map find-toplevel (Lam-body exp)))
-                      (Lam-parameters exp))]
-    [(Seq? exp)
-     (apply append (map find-toplevel (Seq-actions exp)))]
-
-    [(App? exp)
-     (append (find-toplevel (App-operator exp))
-             (apply append (map find-toplevel (App-operands exp))))]))
+(define (find-toplevel-variables exp)
+  (: loop (Expression -> (Listof Symbol)))
+  (define (loop exp)
+    (cond
+      [(Constant? exp)
+       empty]
+      
+      [(Quote? exp)
+       empty]
+      
+      [(Var? exp)
+       (list (Var-id exp))]
+      
+      [(Assign? exp)
+       (loop (Assign-value exp))]
+      
+      [(Def? exp)
+       (loop (Def-value exp))]
+      
+      [(Branch? exp)
+       (append (loop (Branch-predicate exp))
+               (loop (Branch-consequent exp))
+               (loop (Branch-alternative exp)))]
+      
+      [(Lam? exp)
+       (list-difference (apply append (map loop (Lam-body exp)))
+                        (Lam-parameters exp))]
+      [(Seq? exp)
+       (apply append (map loop (Seq-actions exp)))]
+      
+      [(App? exp)
+       (append (loop (App-operator exp))
+               (apply append (map loop (App-operands exp))))]))
+  
+  (unique (loop exp)))
+  

helpers.rkt

@@ -1,6 +1,6 @@
 #lang typed/racket/base
 
-(provide list-union list-difference)
+(provide list-union list-difference unique)
 
 
 (: list-union ((Listof Symbol) (Listof Symbol) -> (Listof Symbol)))
@@ -17,4 +17,19 @@
         [(memq (car s1) s2)
          (list-difference (cdr s1) s2)]
         [else
-         (cons (car s1) (list-difference (cdr s1) s2))]))
+         (cons (car s1) (list-difference (cdr s1) s2))]))
+
+
+;; Trying to work around what looks like a bug in typed racket:
+(define string-sort (inst sort String String))
+
+(: unique ((Listof Symbol) -> (Listof Symbol)))
+(define (unique los)
+  (let: ([ht : (HashTable Symbol Boolean) (make-hasheq)])
+    (for ([l los])
+      (hash-set! ht l #t))
+    (map string->symbol
+         (string-sort
+          (hash-map ht (lambda: ([k : Symbol] [v : Boolean]) 
+                                (symbol->string k)))
+          string<?))))