suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

debuggin

Browse Source
This commit is contained in:
Danny Yoo 2011-02-21 15:47:11 -05:00
parent 5599bc125f
commit 6391f614d9
3 changed files with 58 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
assemble.rkt
View File

@ -1,5 +1,6 @@
#lang typed/racket/base #lang typed/racket/base
(require "typed-structs.rkt" (require "typed-structs.rkt"
"helpers.rkt"
racket/string racket/string
racket/list) 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))))

73
find-toplevel-variables.rkt
View File

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

19
helpers.rkt
View File

@ -1,6 +1,6 @@
#lang typed/racket/base #lang typed/racket/base
(provide list-union list-difference) (provide list-union list-difference unique)
(: list-union ((Listof Symbol) (Listof Symbol) -> (Listof Symbol))) (: list-union ((Listof Symbol) (Listof Symbol) -> (Listof Symbol)))
@ -17,4 +17,19 @@
[(memq (car s1) s2) [(memq (car s1) s2)
(list-difference (cdr s1) s2)] (list-difference (cdr s1) s2)]
[else [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<?))))