diff --git a/assemble-open-coded.rkt b/assemble-open-coded.rkt index c1fd767..1036fdc 100644 --- a/assemble-open-coded.rkt +++ b/assemble-open-coded.rkt @@ -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 diff --git a/compile.rkt b/compile.rkt index 87dac45..10c2a0d 100644 --- a/compile.rkt +++ b/compile.rkt @@ -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) diff --git a/expression-structs.rkt b/expression-structs.rkt index cdd2c57..53102b7 100644 --- a/expression-structs.rkt +++ b/expression-structs.rkt @@ -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)) diff --git a/parse.rkt b/parse.rkt index 23b69a4..9a032b0 100644 --- a/parse.rkt +++ b/parse.rkt @@ -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 diff --git a/typed-parse.rkt b/typed-parse.rkt index e35eb97..6619c53 100644 --- a/typed-parse.rkt +++ b/typed-parse.rkt @@ -1,6 +1,6 @@ #lang typed/racket/base (require "expression-structs.rkt") (require/typed "parse.rkt" - [parse (Any -> ExpressionCore)]) + [parse (Any -> Expression)]) (provide parse) \ No newline at end of file