From f09ea1f8066ad92aac701b0b515f2510b3063ebc Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Thu, 23 Jun 2011 13:34:15 -0400 Subject: [PATCH] Add types for evaluation and compilation operations. original commit: 41e23fee696fcdf6e069713b300cc05b7c742620 --- collects/typed-scheme/base-env/base-env.rkt | 41 +++++++++++++++++++-- collects/typed-scheme/types/abbrev.rkt | 1 + 2 files changed, 39 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-scheme/base-env/base-env.rkt index 87b3971d..f944a75d 100644 --- a/collects/typed-scheme/base-env/base-env.rkt +++ b/collects/typed-scheme/base-env/base-env.rkt @@ -676,7 +676,6 @@ [seconds->date (-Integer . -> . (make-Name #'date))] [current-seconds (-> -Integer)] -[current-print (-Param (Univ . -> . Univ) (Univ . -> . Univ))] ;Section 14.2 @@ -1036,7 +1035,6 @@ -[eval (->opt Univ [-Namespace] Univ)] @@ -1655,7 +1653,44 @@ [mreverse! (-poly (a) (-> (-mlst a) (-mlst a)))] [mappend (-poly (a) (->* (list) (-mlst a) (-mlst a)))] -;; module names and loading +;Section 13.2 (Evaluation and Compilation) +[current-eval (-Param (-> Univ ManyUniv) (-> Univ ManyUniv))] +[eval (->opt Univ [-Namespace] ManyUniv)] +[eval-syntax (->opt (-Syntax Univ) [-Namespace] ManyUniv)] + +[current-load (-Param (-> -Path (-opt Sym) ManyUniv) (-> -Path (-opt Sym) ManyUniv))] +[load (-> -Pathlike ManyUniv)] +[load-relative (-> -Pathlike ManyUniv)] +[load/cd (-> -Pathlike ManyUniv)] + +[current-load-extension (-Param (-> -Path (-opt Sym) ManyUniv) (-> -Path (-opt Sym) ManyUniv))] +[load-extension (-> -Pathlike ManyUniv)] +[load-relative-extension (-> -Pathlike ManyUniv)] + +[current-load/use-compiled (-Param (-> -Path (-opt Sym) ManyUniv) (-> -Path (-opt Sym) ManyUniv))] +[load/use-compiled (-> -Pathlike ManyUniv)] + +[current-load-relative-directory (-Param (-opt -Pathlike) (-opt -Path))] +[use-compiled-file-paths (-Param (-lst -Path) (-lst -Path))] + +[read-eval-print-loop (-> -Void)] +[current-prompt-read (-Param (-> Univ) (-> Univ))] +[current-get-interaction-input-port (-Param (-> -Input-Port) (-> -Input-Port))] +[current-read-interaction (-Param (-> Univ -Input-Port Univ) (-> Univ -Input-Port Univ))] +[current-print (-Param (-> Univ ManyUniv) (-> Univ ManyUniv))] + +[current-compile (-Param (-> Univ B -CompiledExpression) (-> Univ B -CompiledExpression))] +[compile (-> Univ -CompiledExpression)] +[compile-syntax (-> (-Syntax Univ) -CompiledExpression)] +[compiled-expression? (make-pred-ty -CompiledExpression)] + +[compile-enforce-module-constants (-Param B B)] +[compile-allow-set!-undefined (-Param B B)] +[compile-context-preservation-enabled (-Param B B)] +[eval-jit-enabled (-Param B B)] +[load-on-demand-enabled (-Param B B)] + +;;Section 13.4 (Module Names and Loading) [resolved-module-path? (make-pred-ty -Resolved-Module-Path)] [make-resolved-module-path (-> (Un -Symbol -Path) -Resolved-Module-Path)] [resolved-module-path-name (-> -Resolved-Module-Path (Un -Path -Symbol))] diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index bea3571a..051621b5 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -159,6 +159,7 @@ (define -Resolved-Module-Path (make-Base 'Resolved-Module-Path #'resolved-module-path? resolved-module-path? #'-Resolved-Module-Path)) (define -Module-Path-Index (make-Base 'Module-Path-Index #'module-path-index? module-path-index? #'-Module-Path-Index)) (define -Compiled-Module-Expression (make-Base 'Compiled-Module-Expression #'compiled-module-expression? compiled-module-expression? #'-Compiled-Module-Expression)) +(define -CompiledExpression (make-Base 'CompiledExpression #'compiled-expression? compiled-expression? #'-CompiledExpression)) (define -Prompt-Tag (make-Base 'Prompt-Tag #'continuation-prompt-tag? continuation-prompt-tag? #'-Prompt-Tag)) (define -Cont-Mark-Set (make-Base 'Continuation-Mark-Set #'continuation-mark-set? continuation-mark-set? #'-Cont-Mark-Set)) (define -Path (make-Base 'Path #'path? path? #'-Path))