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))
;; 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)
(cond
[(redundant-check? domain-type knowledge)
@ -216,6 +217,7 @@
(: redundant-check? (OperandDomain CompileTimeEnvironmentEntry -> Boolean))
;; Produces true if we know the knowledge implies the domain-type.
(define (redundant-check? domain-type knowledge)
(cond [(Const? knowledge)
(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.
;; Note: the toplevel generates the lambda body streams at the head, and then the
;; rest of the instruction stream.
@ -35,11 +35,11 @@
[cenv : CompileTimeEnvironment]))
(: collect-all-lams (ExpressionCore -> (Listof lam+cenv)))
(: collect-all-lams (Expression -> (Listof lam+cenv)))
;; Finds all the lambdas in the expression.
(define (collect-all-lams exp)
(let: loop : (Listof lam+cenv)
([exp : ExpressionCore exp]
([exp : Expression exp]
[cenv : CompileTimeEnvironment '()])
(cond
@ -62,13 +62,13 @@
(loop (Lam-body exp)
(extract-lambda-cenv exp cenv)))]
[(Seq? exp)
(apply append (map (lambda: ([e : ExpressionCore]) (loop e cenv))
(apply append (map (lambda: ([e : Expression]) (loop e cenv))
(Seq-actions exp)))]
[(App? exp)
(let ([new-cenv (append (build-list (length (App-operands exp)) (lambda: ([i : Natural]) '?))
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)
(append (loop (Let1-rhs exp)
(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.
(define (compile exp cenv target linkage)
(cond
@ -366,7 +366,7 @@
;; Known kernel primitive
;; In the general case, we do general procedure application.
(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))
cenv)])
@ -439,7 +439,7 @@
;; of hardcoded primitives.
(define (compile-kernel-primitive-application kernel-op exp cenv extended-cenv target linkage)
(let* ([n (length (App-operands exp))]
[operand-knowledge (map (lambda: ([arg : ExpressionCore])
[operand-knowledge (map (lambda: ([arg : Expression])
(extract-static-knowledge arg extended-cenv))
(App-operands exp))])
(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.
(define (all-operands-are-constant-or-stack-references rands)
(cond [(andmap (lambda: ([rand : ExpressionCore])
(cond [(andmap (lambda: ([rand : Expression])
(or (Constant? rand)
(LocalRef? rand)
(ToplevelRef? rand)))
rands)
(map (lambda: ([e : ExpressionCore])
(map (lambda: ([e : Expression])
(cond
[(Constant? e)
(make-Const (Constant-v e))]
@ -730,7 +730,7 @@
(: extract-static-knowledge (ExpressionCore CompileTimeEnvironment ->
(: extract-static-knowledge (Expression CompileTimeEnvironment ->
CompileTimeEnvironmentEntry))
;; Statically determines what we know about exp, given the compile time environment.
(define (extract-static-knowledge exp cenv)

35
expression-structs.rkt
View File

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

2
typed-parse.rkt
View File

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