diff --git a/assemble.rkt b/assemble.rkt index bb4c8bb..db07ce7 100644 --- a/assemble.rkt +++ b/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)))) diff --git a/find-toplevel-variables.rkt b/find-toplevel-variables.rkt index 50e31af..0e146a4 100644 --- a/find-toplevel-variables.rkt +++ b/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))) + \ No newline at end of file diff --git a/helpers.rkt b/helpers.rkt index 786b65a..6e046c7 100644 --- a/helpers.rkt +++ b/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))])) \ No newline at end of file + (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