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

some name cleanup

Browse Source
This commit is contained in:
Danny Yoo 2011-03-29 20:25:52 -04:00
parent 7c473c8658
commit 7cd6c998c2
5 changed files with 32 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
assemble-open-coded.rkt
View File

@ -207,6 +207,7 @@
(: maybe-typecheck-operand (OperandDomain Natural String CompileTimeEnvironmentEntry -> String)) (: maybe-typecheck-operand (OperandDomain Natural String CompileTimeEnvironmentEntry -> String))
;; Adds typechecks if we can't prove that the operand is of the required type.
(define (maybe-typecheck-operand domain-type position operand-string knowledge) (define (maybe-typecheck-operand domain-type position operand-string knowledge)
(cond (cond
[(redundant-check? domain-type knowledge) [(redundant-check? domain-type knowledge)
@ -216,6 +217,7 @@
(: redundant-check? (OperandDomain CompileTimeEnvironmentEntry -> Boolean)) (: redundant-check? (OperandDomain CompileTimeEnvironmentEntry -> Boolean))
;; Produces true if we know the knowledge implies the domain-type.
(define (redundant-check? domain-type knowledge) (define (redundant-check? domain-type knowledge)
(cond [(Const? knowledge) (cond [(Const? knowledge)
(case domain-type (case domain-type

24
compile.rkt
View File

@ -15,7 +15,7 @@
(: -compile (ExpressionCore Target Linkage -> (Listof Statement))) (: -compile (Expression Target Linkage -> (Listof Statement)))
;; Generates the instruction-sequence stream. ;; Generates the instruction-sequence stream.
;; Note: the toplevel generates the lambda body streams at the head, and then the ;; Note: the toplevel generates the lambda body streams at the head, and then the
;; rest of the instruction stream. ;; rest of the instruction stream.
@ -35,11 +35,11 @@
[cenv : CompileTimeEnvironment])) [cenv : CompileTimeEnvironment]))
(: collect-all-lams (ExpressionCore -> (Listof lam+cenv))) (: collect-all-lams (Expression -> (Listof lam+cenv)))
;; Finds all the lambdas in the expression. ;; Finds all the lambdas in the expression.
(define (collect-all-lams exp) (define (collect-all-lams exp)
(let: loop : (Listof lam+cenv) (let: loop : (Listof lam+cenv)
([exp : ExpressionCore exp] ([exp : Expression exp]
[cenv : CompileTimeEnvironment '()]) [cenv : CompileTimeEnvironment '()])
(cond (cond
@ -62,13 +62,13 @@
(loop (Lam-body exp) (loop (Lam-body exp)
(extract-lambda-cenv exp cenv)))] (extract-lambda-cenv exp cenv)))]
[(Seq? exp) [(Seq? exp)
(apply append (map (lambda: ([e : ExpressionCore]) (loop e cenv)) (apply append (map (lambda: ([e : Expression]) (loop e cenv))
(Seq-actions exp)))] (Seq-actions exp)))]
[(App? exp) [(App? exp)
(let ([new-cenv (append (build-list (length (App-operands exp)) (lambda: ([i : Natural]) '?)) (let ([new-cenv (append (build-list (length (App-operands exp)) (lambda: ([i : Natural]) '?))
cenv)]) cenv)])
(append (loop (App-operator exp) new-cenv) (append (loop (App-operator exp) new-cenv)
(apply append (map (lambda: ([e : ExpressionCore]) (loop e new-cenv)) (App-operands exp)))))] (apply append (map (lambda: ([e : Expression]) (loop e new-cenv)) (App-operands exp)))))]
[(Let1? exp) [(Let1? exp)
(append (loop (Let1-rhs exp) (append (loop (Let1-rhs exp)
(cons '? cenv)) (cons '? cenv))
@ -111,7 +111,7 @@
(: compile (ExpressionCore CompileTimeEnvironment Target Linkage -> InstructionSequence)) (: compile (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence))
;; Compiles an expression into an instruction sequence. ;; Compiles an expression into an instruction sequence.
(define (compile exp cenv target linkage) (define (compile exp cenv target linkage)
(cond (cond
@ -366,7 +366,7 @@
;; Known kernel primitive ;; Known kernel primitive
;; In the general case, we do general procedure application. ;; In the general case, we do general procedure application.
(define (compile-application exp cenv target linkage) (define (compile-application exp cenv target linkage)
(let ([extended-cenv (append (map (lambda: ([op : ExpressionCore]) (let ([extended-cenv (append (map (lambda: ([op : Expression])
'?) '?)
(App-operands exp)) (App-operands exp))
cenv)]) cenv)])
@ -439,7 +439,7 @@
;; of hardcoded primitives. ;; of hardcoded primitives.
(define (compile-kernel-primitive-application kernel-op exp cenv extended-cenv target linkage) (define (compile-kernel-primitive-application kernel-op exp cenv extended-cenv target linkage)
(let* ([n (length (App-operands exp))] (let* ([n (length (App-operands exp))]
[operand-knowledge (map (lambda: ([arg : ExpressionCore]) [operand-knowledge (map (lambda: ([arg : Expression])
(extract-static-knowledge arg extended-cenv)) (extract-static-knowledge arg extended-cenv))
(App-operands exp))]) (App-operands exp))])
(cond (cond
@ -491,15 +491,15 @@
(: all-operands-are-constant-or-stack-references ((Listof ExpressionCore) -> (U False (Listof OpArg)))) (: all-operands-are-constant-or-stack-references ((Listof Expression) -> (U False (Listof OpArg))))
;; Produces a list of OpArgs if all the operands are particularly simple, and false otherwise. ;; Produces a list of OpArgs if all the operands are particularly simple, and false otherwise.
(define (all-operands-are-constant-or-stack-references rands) (define (all-operands-are-constant-or-stack-references rands)
(cond [(andmap (lambda: ([rand : ExpressionCore]) (cond [(andmap (lambda: ([rand : Expression])
(or (Constant? rand) (or (Constant? rand)
(LocalRef? rand) (LocalRef? rand)
(ToplevelRef? rand))) (ToplevelRef? rand)))
rands) rands)
(map (lambda: ([e : ExpressionCore]) (map (lambda: ([e : Expression])
(cond (cond
[(Constant? e) [(Constant? e)
(make-Const (Constant-v e))] (make-Const (Constant-v e))]
@ -730,7 +730,7 @@
(: extract-static-knowledge (ExpressionCore CompileTimeEnvironment -> (: extract-static-knowledge (Expression CompileTimeEnvironment ->
CompileTimeEnvironmentEntry)) CompileTimeEnvironmentEntry))
;; Statically determines what we know about exp, given the compile time environment. ;; Statically determines what we know about exp, given the compile time environment.
(define (extract-static-knowledge exp cenv) (define (extract-static-knowledge exp cenv)

35
expression-structs.rkt
View File

@ -5,7 +5,7 @@
;; Expressions ;; Expressions
(define-type ExpressionCore (U Top Constant (define-type Expression (U Top Constant
ToplevelRef LocalRef ToplevelRef LocalRef
ToplevelSet ToplevelSet
Branch Lam Seq App Branch Lam Seq App
@ -16,7 +16,7 @@
BoxEnv)) BoxEnv))
(define-struct: Top ([prefix : Prefix] (define-struct: Top ([prefix : Prefix]
[code : ExpressionCore]) #:transparent) [code : Expression]) #:transparent)
(define-struct: Constant ([v : Any]) #:transparent) (define-struct: Constant ([v : Any]) #:transparent)
@ -31,42 +31,42 @@
(define-struct: ToplevelSet ([depth : Natural] (define-struct: ToplevelSet ([depth : Natural]
[pos : Natural] [pos : Natural]
[name : Symbol] [name : Symbol]
[value : ExpressionCore]) #:transparent) [value : Expression]) #:transparent)
(define-struct: Branch ([predicate : ExpressionCore] (define-struct: Branch ([predicate : Expression]
[consequent : ExpressionCore] [consequent : Expression]
[alternative : ExpressionCore]) #:transparent) [alternative : Expression]) #:transparent)
(define-struct: Lam ([name : (U Symbol False)] (define-struct: Lam ([name : (U Symbol False)]
[num-parameters : Natural] [num-parameters : Natural]
[body : ExpressionCore] [body : Expression]
[closure-map : (Listof Natural)] [closure-map : (Listof Natural)]
[entry-label : Symbol]) #:transparent) [entry-label : Symbol]) #:transparent)
(define-struct: Seq ([actions : (Listof ExpressionCore)]) #:transparent) (define-struct: Seq ([actions : (Listof Expression)]) #:transparent)
(define-struct: App ([operator : ExpressionCore] (define-struct: App ([operator : Expression]
[operands : (Listof ExpressionCore)]) #:transparent) [operands : (Listof Expression)]) #:transparent)
(define-struct: Let1 ([rhs : ExpressionCore] (define-struct: Let1 ([rhs : Expression]
[body : ExpressionCore]) [body : Expression])
#:transparent) #:transparent)
(define-struct: LetVoid ([count : Natural] (define-struct: LetVoid ([count : Natural]
[body : ExpressionCore] [body : Expression]
[boxes? : Boolean]) [boxes? : Boolean])
#:transparent) #:transparent)
(define-struct: LetRec ([procs : (Listof Lam)] (define-struct: LetRec ([procs : (Listof Lam)]
[body : ExpressionCore]) [body : Expression])
#:transparent) #:transparent)
(define-struct: InstallValue ([depth : Natural] (define-struct: InstallValue ([depth : Natural]
[body : ExpressionCore] [body : Expression]
[box? : Boolean]) [box? : Boolean])
#:transparent) #:transparent)
(define-struct: BoxEnv ([depth : Natural] (define-struct: BoxEnv ([depth : Natural]
[body : ExpressionCore]) [body : Expression])
#:transparent) #:transparent)
@ -80,6 +80,3 @@
(: rest-exps ((Listof Expression) -> (Listof Expression))) (: rest-exps ((Listof Expression) -> (Listof Expression)))
(define (rest-exps seq) (cdr seq)) (define (rest-exps seq) (cdr seq))
(define-type Expression (U ExpressionCore))

2
parse.rkt
View File

@ -70,7 +70,7 @@
(add1 (find-prefix (rest cenv)))])) (add1 (find-prefix (rest cenv)))]))
;; parse: Any ParseTimeEnvironment -> ExpressionCore ;; parse: Any ParseTimeEnvironment -> Expression
;; Compile an expression. ;; Compile an expression.
(define (parse exp cenv) (define (parse exp cenv)
(cond (cond

2
typed-parse.rkt
View File

@ -1,6 +1,6 @@
#lang typed/racket/base #lang typed/racket/base
(require "expression-structs.rkt") (require "expression-structs.rkt")
(require/typed "parse.rkt" (require/typed "parse.rkt"
[parse (Any -> ExpressionCore)]) [parse (Any -> Expression)])
(provide parse) (provide parse)