removing dead module
This commit is contained in:
Danny Yoo
parent
b1384b71dd
commit
80ad749022
|
|
@ -2,14 +2,8 @@
|
|||
(require "expression-structs.rkt"
|
||||
"lexical-structs.rkt"
|
||||
"il-structs.rkt"
|
||||
"lexical-env.rkt"
|
||||
"helpers.rkt"
|
||||
"find-toplevel-variables.rkt"
|
||||
"sets.rkt"
|
||||
"compile.rkt"
|
||||
"typed-parse.rkt"
|
||||
racket/list)
|
||||
|
||||
"typed-parse.rkt")
|
||||
|
||||
|
||||
(provide get-bootstrapping-code)
|
||||
|
|
@ -46,14 +40,13 @@
|
|||
,(make-AssignPrimOpStatement (adjust-target-depth (make-EnvLexicalReference 0 #f) 2)
|
||||
(make-MakeCompiledProcedure call/cc-closure-entry
|
||||
1 ;; the continuation consumes a single value
|
||||
(list (make-EnvLexicalReference 0 #f)
|
||||
(make-EnvLexicalReference 1 #f))
|
||||
(list 0 1)
|
||||
'call/cc))
|
||||
,(make-PopEnvironment 2 0)))
|
||||
|
||||
;; Finally, do a tail call into f.
|
||||
(compile-procedure-call '()
|
||||
(extend-lexical-environment/placeholders '() 1)
|
||||
(compile-procedure-call 0
|
||||
1
|
||||
1
|
||||
'val
|
||||
'return)
|
||||
|
|
|
|||
|
|
@ -158,8 +158,7 @@
|
|||
(define (compile-toplevel-set exp cenv target linkage)
|
||||
(let* ([var (ToplevelSet-name exp)]
|
||||
[lexical-pos (make-EnvPrefixReference (ToplevelSet-depth exp)
|
||||
(ToplevelSet-pos exp)
|
||||
(ToplevelSet-name exp))])
|
||||
(ToplevelSet-pos exp))])
|
||||
(let ([get-value-code
|
||||
(parameterize ([current-defined-name var])
|
||||
(compile (ToplevelSet-value exp) cenv lexical-pos
|
||||
|
|
@ -225,7 +224,7 @@
|
|||
target
|
||||
(make-MakeCompiledProcedure proc-entry
|
||||
(Lam-num-parameters exp)
|
||||
(map make-Const (Lam-closure-map exp))
|
||||
(Lam-closure-map exp)
|
||||
(current-defined-name))))))
|
||||
(compile-lambda-body exp proc-entry)
|
||||
after-lambda)))
|
||||
|
|
@ -354,7 +353,7 @@
|
|||
|
||||
|
||||
|
||||
(: compile-proc-appl (CompileTimeEnvironment Natural Target Linkage -> InstructionSequence))
|
||||
(: compile-proc-appl (Natural Natural Target Linkage -> InstructionSequence))
|
||||
;; Three fundamental cases for general compiled-procedure application.
|
||||
;; 1. Non-tail calls that write to val
|
||||
;; 2. Calls in argument position that write to the environment
|
||||
|
|
@ -438,7 +437,7 @@
|
|||
|
||||
|
||||
|
||||
(: compile-let-void (LetVoid CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
(: compile-let-void (LetVoid Natural Target Linkage -> InstructionSequence))
|
||||
(define (compile-let-void exp cenv target linkage)
|
||||
(let*: ([n : Natural (LetVoid-count exp)]
|
||||
[after-let : Symbol (make-label 'afterLet)]
|
||||
|
|
|
|||
|
|
@ -1,68 +0,0 @@
|
|||
#lang typed/racket/base
|
||||
(require "typed-structs.rkt"
|
||||
"lexical-env.rkt"
|
||||
"find-toplevel-variables.rkt")
|
||||
|
||||
|
||||
(: find-boxed-bindings (Expression -> (HashTable Expression Boolean)))
|
||||
;; Collects the list of toplevel variables we need.
|
||||
(define (find-boxed-bindings exp)
|
||||
|
||||
(: ht (HashTable Expression Boolean))
|
||||
(define ht (make-hasheq))
|
||||
|
||||
(: loop (Expression CompileTimeEnvironment -> 'ok))
|
||||
(define (loop exp cenv)
|
||||
(cond
|
||||
[(Constant? exp)
|
||||
'ok]
|
||||
|
||||
[(Quote? exp)
|
||||
'ok]
|
||||
|
||||
[(Var? exp)
|
||||
'ok]
|
||||
|
||||
[(Assign? exp)
|
||||
(let ([lexical-address
|
||||
(find-variable (Assign-variable exp) cenv)])
|
||||
(cond
|
||||
[(LocalAddress? lexical-address)
|
||||
(hash-set! ht exp #t)
|
||||
'ok]
|
||||
[(PrefixAddress? lexical-address)
|
||||
'ok]))
|
||||
(loop (Assign-value exp) cenv)]
|
||||
|
||||
[(Def? exp)
|
||||
(loop (Def-value exp) cenv)]
|
||||
|
||||
[(Branch? exp)
|
||||
(loop (Branch-predicate exp) cenv)
|
||||
(loop (Branch-consequent exp) cenv)
|
||||
(loop (Branch-alternative exp) cenv)
|
||||
'ok]
|
||||
|
||||
[(Lam? exp)
|
||||
(let ([extended-cenv
|
||||
(extend-lexical-environment cenv (Lam-parameters exp))])
|
||||
|
||||
(for-each (lambda: ([e : Expression]) (loop e extended-cenv))
|
||||
(Lam-body exp))
|
||||
'ok)]
|
||||
|
||||
|
||||
[(Seq? exp)
|
||||
(for-each (lambda: ([e : Expression]) (loop e cenv)) (Seq-actions exp))
|
||||
'ok]
|
||||
|
||||
[(App? exp)
|
||||
(loop (App-operator exp) cenv)
|
||||
(for-each (lambda: ([e : Expression]) (loop e cenv)) (App-operands exp))
|
||||
'ok]))
|
||||
|
||||
(let*: ([names : (Listof Symbol) (find-toplevel-variables exp)]
|
||||
[cenv : CompileTimeEnvironment (list (make-Prefix names))])
|
||||
|
||||
(loop exp cenv))
|
||||
ht)
|
||||
|
|
@ -1,67 +0,0 @@
|
|||
#lang typed/racket/base
|
||||
(require "expression-structs.rkt"
|
||||
"lexical-structs.rkt"
|
||||
"helpers.rkt"
|
||||
racket/list)
|
||||
|
||||
(provide find-toplevel-variables)
|
||||
|
||||
|
||||
(: find-toplevel-variables (ExpressionCore -> (Listof Symbol)))
|
||||
;; Collects the list of toplevel variables we need.
|
||||
(define (find-toplevel-variables exp)
|
||||
(: loop (ExpressionCore -> (Listof Symbol)))
|
||||
(define (loop exp)
|
||||
(cond
|
||||
[(Top? exp)
|
||||
(list-difference (loop (Top-code exp))
|
||||
(filter symbol? (Prefix-names (Top-prefix exp))))]
|
||||
[(Constant? exp)
|
||||
empty]
|
||||
|
||||
[(Var? exp)
|
||||
(list (Var-id exp))]
|
||||
|
||||
[(Def? exp)
|
||||
(cons (Def-variable exp)
|
||||
(loop (Def-value exp)))]
|
||||
|
||||
[(Branch? exp)
|
||||
(append (loop (Branch-predicate exp))
|
||||
(loop (Branch-consequent exp))
|
||||
(loop (Branch-alternative exp)))]
|
||||
|
||||
[(Lam? exp)
|
||||
(list-difference (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))))]
|
||||
|
||||
[(Let1? exp)
|
||||
(append (loop (Let1-rhs exp))
|
||||
(list-difference (loop (Let1-body exp))
|
||||
(list (Let1-name exp))))]
|
||||
|
||||
[(Let? exp)
|
||||
(append (apply append (map loop (Let-rhss exp)))
|
||||
(list-difference (loop (Let-body exp))
|
||||
(Let-names exp)))]
|
||||
[(LetRec? exp)
|
||||
(append (apply append (map (lambda: ([rhs : ExpressionCore])
|
||||
(list-difference (loop rhs)
|
||||
(LetRec-names exp)))
|
||||
(LetRec-rhss exp)))
|
||||
(list-difference (loop (LetRec-body exp))
|
||||
(LetRec-names exp)))]
|
||||
|
||||
#;[(Letrec? exp)
|
||||
(list-difference (append (apply append (map loop (Letrec-procs exp)))
|
||||
(loop (Letrec-body exp)))
|
||||
(Letrec-names exp))]))
|
||||
|
||||
(unique/eq? (loop exp)))
|
||||
|
||||
|
|
@ -131,7 +131,7 @@
|
|||
;; closure needs to close over.
|
||||
(define-struct: MakeCompiledProcedure ([label : Symbol]
|
||||
[arity : Natural]
|
||||
[closed-vals : (Listof EnvReference)]
|
||||
[closed-vals : (Listof Natural)]
|
||||
[display-name : (U Symbol False)])
|
||||
#:transparent)
|
||||
|
||||
|
|
@ -177,8 +177,7 @@
|
|||
;; Check that the value in the prefix has been defined.
|
||||
;; If not, raise an error and stop evaluation.
|
||||
(define-struct: CheckToplevelBound! ([depth : Natural]
|
||||
[pos : Natural]
|
||||
[name : Symbol])
|
||||
[pos : Natural])
|
||||
#:transparent)
|
||||
|
||||
;; Check the closure procedure value in 'proc and make sure it can accept n values.
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(require "test-find-toplevel-variables.rkt"
|
||||
(require "test-parse.rkt"
|
||||
"test-simulator.rkt"
|
||||
"test-compiler.rkt"
|
||||
"test-assemble.rkt"
|
||||
|
|
|
|||
|
|
@ -1,46 +0,0 @@
|
|||
#lang racket
|
||||
(require "find-toplevel-variables.rkt"
|
||||
"parse.rkt")
|
||||
|
||||
;; test-find-toplevel-variables
|
||||
(define-syntax (test stx)
|
||||
(syntax-case stx ()
|
||||
[(_ s exp)
|
||||
(with-syntax ([stx stx])
|
||||
(syntax/loc #'stx
|
||||
(let ([results (find-toplevel-variables (parse s))])
|
||||
(unless (equal? results exp)
|
||||
(raise-syntax-error #f (format "Expected ~s, got ~s" exp results)
|
||||
#'stx)))))]))
|
||||
|
||||
|
||||
(test '(define (factorial n)
|
||||
(if (= n 0)
|
||||
1
|
||||
(* (factorial (- n 1))
|
||||
n)))
|
||||
|
||||
'(* - = factorial))
|
||||
|
||||
(test '(begin
|
||||
(define (factorial n)
|
||||
(fact-iter n 1))
|
||||
(define (fact-iter n acc)
|
||||
(if (= n 0)
|
||||
acc
|
||||
(fact-iter (- n 1) (* acc n)))))
|
||||
'(* - = fact-iter factorial))
|
||||
|
||||
(test '(define (gauss n)
|
||||
(if (= n 0)
|
||||
0
|
||||
(+ (gauss (- n 1))
|
||||
n)))
|
||||
'(+ - = gauss))
|
||||
|
||||
(test '(define (fib n)
|
||||
(if (< n 2)
|
||||
1
|
||||
(+ (fib (- n 1))
|
||||
(fib (- n 2)))))
|
||||
'(+ - < fib))
|
||||
Loading…
Reference in New Issue
Block a user