diff --git a/compile.rkt b/compile.rkt index 9324a5d..e12e238 100644 --- a/compile.rkt +++ b/compile.rkt @@ -1,6 +1,8 @@ #lang typed/racket/base -(require "typed-structs.rkt" +(require "expression-structs.rkt" + "lexical-structs.rkt" + "il-structs.rkt" "lexical-env.rkt" "helpers.rkt" "find-toplevel-variables.rkt" @@ -202,31 +204,7 @@ after-lambda))) -(: collect-lexical-references ((Listof LexicalAddress) - -> - (Listof (U EnvLexicalReference EnvWholePrefixReference)))) -;; Given a list of lexical addresses, computes a set of unique references. -;; Multiple lexical addresses to a single prefix should be treated identically. -(define (collect-lexical-references addresses) - (let: ([prefix-references : (Setof EnvWholePrefixReference) (new-set)] - [lexical-references : (Setof EnvLexicalReference) (new-set)]) - (let: loop : (Listof (U EnvLexicalReference EnvWholePrefixReference)) - ([addresses : (Listof LexicalAddress) addresses]) - (cond - [(empty? addresses) - (append (set->list prefix-references) (set->list lexical-references))] - [else - (let ([addr (first addresses)]) - (cond - [(LocalAddress? addr) - (set-insert! lexical-references - (make-EnvLexicalReference (LocalAddress-depth addr) - (LocalAddress-pos addr))) - (loop (rest addresses))] - [(PrefixAddress? addr) - (set-insert! prefix-references - (make-EnvWholePrefixReference (PrefixAddress-depth addr))) - (loop (rest addresses))]))])))) + diff --git a/expression-structs.rkt b/expression-structs.rkt new file mode 100644 index 0000000..df8a6f2 --- /dev/null +++ b/expression-structs.rkt @@ -0,0 +1,36 @@ +#lang typed/racket/base +(require "lexical-structs.rkt") + +(provide (all-defined-out)) + +;; Expressions + +(define-type ExpressionCore (U Top Constant Var Branch Def Lam Seq #;App)) +(define-type Expression (U ExpressionCore #;Assign)) + +(define-struct: Top ([prefix : Prefix] + [code : ExpressionCore]) #:transparent) +(define-struct: Constant ([v : Any]) #:transparent) +(define-struct: Var ([id : Symbol]) #:transparent) +(define-struct: Assign ([variable : Symbol] + [value : Expression]) #:transparent) +(define-struct: Branch ([predicate : Expression] + [consequent : Expression] + [alternative : Expression]) #:transparent) +(define-struct: Def ([variable : Symbol] + [value : Expression]) #:transparent) +(define-struct: Lam ([parameters : (Listof Symbol)] + [body : Expression]) #:transparent) +(define-struct: Seq ([actions : (Listof Expression)]) #:transparent) +(define-struct: App ([operator : Expression] + [operands : (Listof Expression)]) #:transparent) + +(: last-exp? ((Listof Expression) -> Boolean)) +(define (last-exp? seq) + (null? (cdr seq))) + +(: first-exp ((Listof Expression) -> Expression)) +(define (first-exp seq) (car seq)) + +(: rest-exps ((Listof Expression) -> (Listof Expression))) +(define (rest-exps seq) (cdr seq)) \ No newline at end of file diff --git a/find-toplevel-variables.rkt b/find-toplevel-variables.rkt index b3217bc..7098444 100644 --- a/find-toplevel-variables.rkt +++ b/find-toplevel-variables.rkt @@ -1,5 +1,6 @@ #lang typed/racket/base -(require "typed-structs.rkt" +(require "expression-structs.rkt" + "lexical-structs.rkt" "helpers.rkt" racket/list) diff --git a/typed-structs.rkt b/il-structs.rkt similarity index 67% rename from typed-structs.rkt rename to il-structs.rkt index fa16cfa..46c7815 100644 --- a/typed-structs.rkt +++ b/il-structs.rkt @@ -2,37 +2,6 @@ (provide (all-defined-out)) -;; Expressions - -(define-type ExpressionCore (U Top Constant Var Branch Def Lam Seq #;App)) -(define-type Expression (U ExpressionCore #;Assign)) - -(define-struct: Top ([prefix : Prefix] - [code : ExpressionCore]) #:transparent) -(define-struct: Constant ([v : Any]) #:transparent) -(define-struct: Var ([id : Symbol]) #:transparent) -(define-struct: Assign ([variable : Symbol] - [value : Expression]) #:transparent) -(define-struct: Branch ([predicate : Expression] - [consequent : Expression] - [alternative : Expression]) #:transparent) -(define-struct: Def ([variable : Symbol] - [value : Expression]) #:transparent) -(define-struct: Lam ([parameters : (Listof Symbol)] - [body : Expression]) #:transparent) -(define-struct: Seq ([actions : (Listof Expression)]) #:transparent) -(define-struct: App ([operator : Expression] - [operands : (Listof Expression)]) #:transparent) - -(: last-exp? ((Listof Expression) -> Boolean)) -(define (last-exp? seq) - (null? (cdr seq))) - -(: first-exp ((Listof Expression) -> Expression)) -(define (first-exp seq) (car seq)) - -(: rest-exps ((Listof Expression) -> (Listof Expression))) -(define (rest-exps seq) (cdr seq)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -173,27 +142,3 @@ (define-struct: BasicBlock ([name : Symbol] [stmts : (Listof UnlabeledStatement)]) #:transparent) - -;;;;;;;;;;;;;; - -;; Lexical environments - -;; A toplevel prefix contains a list of toplevel variables. -(define-struct: Prefix ([names : (Listof Symbol)]) - #:transparent) - -;; A compile-time environment is a (listof (listof symbol)). -;; A lexical address is either a 2-tuple (depth pos), or 'not-found. -(define-type CompileTimeEnvironment (Listof (U (Listof Symbol) - Prefix))) -(define-type LexicalAddress (U LocalAddress PrefixAddress)) - -(define-struct: LocalAddress ([depth : Natural] - [pos : Natural]) - ;; These need to be treated transparently for equality checking. - #:transparent) -(define-struct: PrefixAddress ([depth : Natural] - [pos : Natural] - [name : Symbol]) - ;; These need to be treated transparently for equality checking. - #:transparent) \ No newline at end of file diff --git a/lexical-env.rkt b/lexical-env.rkt index da44f4f..576728c 100644 --- a/lexical-env.rkt +++ b/lexical-env.rkt @@ -1,8 +1,14 @@ #lang typed/racket/base (require racket/list - "typed-structs.rkt") -(provide find-variable extend-lexical-environment lexical-environment-pop-depth) + "il-structs.rkt" + "lexical-structs.rkt" + "sets.rkt") +(provide find-variable + extend-lexical-environment + lexical-environment-pop-depth + collect-lexical-references + lexical-references->compile-time-environment) ;; find-variable: symbol compile-time-environment -> lexical-address @@ -51,4 +57,49 @@ [(Prefix? (first cenv)) 1] [(list? (first cenv)) - 1])) \ No newline at end of file + 1])) + + + + +(: collect-lexical-references ((Listof LexicalAddress) + -> + (Listof (U EnvLexicalReference EnvWholePrefixReference)))) +;; Given a list of lexical addresses, computes a set of unique references. +;; Multiple lexical addresses to a single prefix should be treated identically. +(define (collect-lexical-references addresses) + (let: ([prefix-references : (Setof EnvWholePrefixReference) (new-set)] + [lexical-references : (Setof EnvLexicalReference) (new-set)]) + (let: loop : (Listof (U EnvLexicalReference EnvWholePrefixReference)) + ([addresses : (Listof LexicalAddress) addresses]) + (cond + [(empty? addresses) + (append (set->list prefix-references) (set->list lexical-references))] + [else + (let ([addr (first addresses)]) + (cond + [(LocalAddress? addr) + (set-insert! lexical-references + (make-EnvLexicalReference (LocalAddress-depth addr) + (LocalAddress-pos addr))) + (loop (rest addresses))] + [(PrefixAddress? addr) + (set-insert! prefix-references + (make-EnvWholePrefixReference (PrefixAddress-depth addr))) + (loop (rest addresses))]))])))) + + +(: lexical-references->compile-time-environment ((Listof (U EnvLexicalReference EnvWholePrefixReference)) + CompileTimeEnvironment + -> CompileTimeEnvironment)) +(define (lexical-references->compile-time-environment refs cenv) + cenv + #;(cond + [(empty? refs) + cenv] + [else + (let ([a-ref (first refs)]) + (cond + [(EnvLexicalReference? a-ref) + ...]))])) + diff --git a/lexical-structs.rkt b/lexical-structs.rkt new file mode 100644 index 0000000..0a4a6cd --- /dev/null +++ b/lexical-structs.rkt @@ -0,0 +1,27 @@ +#lang typed/racket/base + +(provide (all-defined-out)) + +;;;;;;;;;;;;;; + +;; Lexical environments + +;; A toplevel prefix contains a list of toplevel variables. +(define-struct: Prefix ([names : (Listof Symbol)]) + #:transparent) + +;; A compile-time environment is a (listof (listof symbol)). +;; A lexical address is either a 2-tuple (depth pos), or 'not-found. +(define-type CompileTimeEnvironment (Listof (U (Listof Symbol) + Prefix))) +(define-type LexicalAddress (U LocalAddress PrefixAddress)) + +(define-struct: LocalAddress ([depth : Natural] + [pos : Natural]) + ;; These need to be treated transparently for equality checking. + #:transparent) +(define-struct: PrefixAddress ([depth : Natural] + [pos : Natural] + [name : Symbol]) + ;; These need to be treated transparently for equality checking. + #:transparent) \ No newline at end of file