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

More precise types for typed MrEd wrappers.

Browse Source 
More precise types in auto-language.ss

svn: r18041
This commit is contained in:
Sam Tobin-Hochstadt 2010-02-10 20:23:59 +00:00
parent c0ce0debbe
commit c224d2ebfc
4 changed files with 52 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/drscheme/private/auto-language.ss
View File

@ -9,21 +9,23 @@
(: reader-tag String)
(define reader-tag "#reader")
(: pick-new-language ((Instance Text%)
(Listof
(Instance (Class () () ([get-reader-module (-> Any)]
[get-metadata-lines (-> Number)]
[metadata->settings (String -> Any)]))))
Any Any -> (values Any Any)))
(define-type-alias (Language% Settings)
(Class () () ([get-reader-module (-> Sexp)]
[get-metadata-lines (-> Number)]
[metadata->settings (String -> Settings)])))
(: pick-new-language (All (S)
((Instance Text%)
(Listof
(Instance (Language% S)))
(U #f (Instance (Language% S))) (U #f S) -> (values (U #f (Instance (Language% S))) (U #f S)))))
(define (pick-new-language text all-languages module-language module-language-settings)
(with-handlers ([exn:fail:read? (λ (x) (values #f #f))])
(let: ([found-language? : Any #f]
[settings : Any #f])
(let: ([found-language? : (U #f (Instance (Language% S))) #f]
[settings : (U #f S) #f])
(for-each
(λ: ([lang : (Instance (Class () () ([get-reader-module (-> Any)]
[get-metadata-lines (-> Number)]
[metadata->settings (String -> Any)])))])
(λ: ([lang : (Instance (Language% S))])
(let ([lang-spec (send lang get-reader-module)])
(when lang-spec
(let* ([lines (send lang get-metadata-lines)]
@ -51,7 +53,7 @@
(values found-language?
settings))))
(: looks-like-module? ((Instance Text%) -> Any))
(: looks-like-module? ((Instance Text%) -> Boolean))
(define (looks-like-module? text)
(or (looks-like-new-module-style? text)
(looks-like-old-module-style? text)))
@ -66,11 +68,11 @@
(pair? r1)
(eq? (car r1) 'module)))))
(: looks-like-new-module-style? ((Instance Text%) -> Any))
(: looks-like-new-module-style? ((Instance Text%) -> Boolean))
(define (looks-like-new-module-style? text)
(let* ([tp (open-input-text-editor text 0 'end (lambda (s) s) text #t)]
[l1 (with-handlers ([exn:fail? (lambda (exn) eof)])
;; If tp contains a snip, read-line fails.
(read-line tp))])
(and (string? l1)
(regexp-match #rx"#lang .*$" l1))))
(regexp-match? #rx"#lang .*$" l1))))

19
collects/typed/framework/framework.ss
View File

@ -1,7 +1,6 @@
#lang typed-scheme
(require typed/private/utils
(only-in typed/mred/mred Font%))
(require typed/private/utils typed/mred/mred)
(dt Style-List% (Class ()
()
@ -25,13 +24,15 @@
[get-end-position (-> Number)]
[insert (String Number Number -> Void)])))
(require/typed/provide framework/framework
[preferences:set-default (Symbol Any Any -> Void)]
[preferences:set (Symbol Any -> Void)]
[editor:get-standard-style-list
(-> (Instance Style-List%))]
[scheme:text% Scheme:Text%]
[gui-utils:ok/cancel-buttons (Any (Any Any -> Any) (Any Any -> Any) -> (values Any Any))])
(require/typed/provide
framework/framework
[preferences:set-default (Symbol Sexp (Any -> Boolean) -> Void)]
[preferences:set (Symbol Sexp -> Void)]
[editor:get-standard-style-list
(-> (Instance Style-List%))]
[scheme:text% Scheme:Text%]
[gui-utils:ok/cancel-buttons
((Instance Horizontal-Panel%) ((Instance Button%) (Instance Event%) -> Void) ((Instance Button%) (Instance Event%) -> Void) -> (values Any Any))])
(require/typed/provide "prefs-contract.ss"
[preferences:get-drscheme:large-letters-font (-> (U #f (Pair String Number)))])

38
collects/typed/mred/mred.ss
View File

@ -46,6 +46,8 @@
[draw-text (String Number Number -> Void)])))
(dt Color% (Class () () ([red (-> Number)])))
(dt Snip% (Class () () ()))
(dt Text% (Class ()
()
([begin-edit-sequence (-> Void)]
@ -63,20 +65,26 @@
[get-text (Integer (U Integer 'eof) -> String)]
[insert (String Number Number -> Void)])))
(dt Button% (Class () () ()))
(dt Event% (Class () () ()))
(require/typed/provide mred/mred
[the-font-list (Instance Font-List%)]
[dialog% Dialog%]
[text-field% Text-Field%]
[horizontal-panel% Horizontal-Panel%]
[choice% Choice%]
[get-face-list (-> (Listof String))]
[message% Message%]
[horizontal-pane% Horizontal-Pane%]
[editor-canvas% Editor-Canvas%]
[bitmap-dc% Bitmap-DC%]
[bitmap% Bitmap%]
[color% Color%]
[open-input-text-editor ((Instance Text%) Integer (U 'end Integer) (Any -> Any) Any Any -> Input-Port)])
(require/typed/provide
scheme/gui
[button% Button%]
[event% Event%]
[the-font-list (Instance Font-List%)]
[dialog% Dialog%]
[text-field% Text-Field%]
[horizontal-panel% Horizontal-Panel%]
[choice% Choice%]
[get-face-list (-> (Listof String))]
[message% Message%]
[horizontal-pane% Horizontal-Pane%]
[editor-canvas% Editor-Canvas%]
[bitmap-dc% Bitmap-DC%]
[bitmap% Bitmap%]
[color% Color%]
[snip% Snip%]
[open-input-text-editor
((Instance Text%) Integer (U 'end Integer) ((Instance Snip%) -> (Instance Snip%)) (Instance Text%) Boolean -> Input-Port)])

7
collects/typed/net/mime.ss
View File

@ -9,7 +9,7 @@
[modification : String]
[read : String]
[size : Number]
[params : Any])
[params : (Listof (Pair Symbol String))])
net/mime)
(require-typed-struct entity ([type : (U Symbol String)]
[subtype : (U Symbol String)]
@ -20,7 +20,7 @@
[id : String]
[description : String]
[other : String]
[fields : Any]
[fields : (Listof String)]
[parts : (Listof String) ]
[body : (Output-Port -> Void)])
net/mime)
@ -30,7 +30,7 @@
;; -- exceptions raised --
#|
#| ;; constructors not exported
(require-typed-struct mime-error () net/mime)
(require-typed-struct (unexpected-termination mime-error) ([msg : String]) net/mime)
(require-typed-struct (missing-multipart-boundary-parameter mime-error) () net/mime)
@ -40,7 +40,6 @@
(require-typed-struct (empty-subtype mime-error) () net/mime)
(require-typed-struct (empty-disposition-type mime-error) () net/mime)
|#
;; -- mime methods --
(require/typed/provide net/mime
[mime-analyze ((U Bytes Input-Port) Any -> message)])