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

Added types for full exception hierarchy.

Browse Source 
svn: r18092
This commit is contained in:
Carl Eastlund 2010-02-15 23:22:40 +00:00
parent b865bb7868
commit 08b53c715d
1 changed files with 76 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
collects/typed-scheme/private/base-special-env.ss
View File

@ -23,21 +23,82 @@
(define-for-syntax (initialize-others)
(d-s srcloc
([source : Univ]
[line : (*Un -Integer (-val #f))]
[column : (*Un -Integer (-val #f))]
[position : (*Un -Integer (-val #f))]
[span : (*Un -Integer (-val #f))])
())
(d-s date
([second : -Number] [minute : -Number] [hour : -Number] [day : -Number] [month : -Number]
[year : -Number] [weekday : -Number] [year-day : -Number] [dst? : -Boolean] [time-zone-offset : -Number])
())
(d-s exn ([message : -String] [continuation-marks : -Cont-Mark-Set]) ())
(d-s (exn:fail exn) () (-String -Cont-Mark-Set))
(d-s (exn:fail:read exn:fail) ([srclocs : (-lst Univ)]) (-String -Cont-Mark-Set))
(d-s (exn:fail:read:eof exn:fail:read) () (-String -Cont-Mark-Set (-lst Univ)))
(define-syntax define-hierarchy
(syntax-rules (define-hierarchy)
[(_ parent ([name : type] ...)
(define-hierarchy child (spec ...) grand ...)
...)
(begin
(d-s parent ([name : type] ...) ())
(define-sub-hierarchy [child parent] (type ...) (spec ...) grand ...)
...)]))
(define-syntax define-sub-hierarchy
(syntax-rules (define-hierarchy)
[(_ [child parent] (inheritance ...) ([name : type] ...)
(define-hierarchy grandchild (spec ...) great ...)
...)
(begin
(d-s [child parent] ([name : type] ...) (inheritance ...))
(define-sub-hierarchy [grandchild child]
(inheritance ... type ...) (spec ...)
great
...)
...)]))
(define-hierarchy srcloc
([source : Univ]
[line : (*Un -Integer (-val #f))]
[column : (*Un -Integer (-val #f))]
[position : (*Un -Integer (-val #f))]
[span : (*Un -Integer (-val #f))]))
(define-hierarchy date
([second : -Number]
[minute : -Number]
[hour : -Number]
[day : -Number]
[month : -Number]
[year : -Number]
[weekday : -Number]
[year-day : -Number]
[dst? : -Boolean]
[time-zone-offset : -Number]))
(define-hierarchy exn
([message : -String] [continuation-marks : -Cont-Mark-Set])
(define-hierarchy exn:fail ()
(define-hierarchy exn:fail:contract ()
(define-hierarchy exn:fail:contract:arity ())
(define-hierarchy exn:fail:contract:divide-by-zero ())
(define-hierarchy exn:fail:contract:non-fixnum-result ())
(define-hierarchy exn:fail:contract:continuation ())
(define-hierarchy exn:fail:contract:variable ()))
(define-hierarchy exn:fail:syntax ([exprs : (-lst (-Syntax Univ))]))
(define-hierarchy exn:fail:read
([srclocs : (-lst Univ)]) ;; cce: Univ here should be srcloc
(define-hierarchy exn:fail:read:eof ())
(define-hierarchy exn:fail:read:non-char ()))
(define-hierarchy exn:fail:filesystem ()
(define-hierarchy exn:fail:filesystem:exists ())
(define-hierarchy exn:fail:filesystem:version ()))
(define-hierarchy exn:fail:network ())
(define-hierarchy exn:fail:out-of-memory ())
(define-hierarchy exn:fail:unsupported ())
(define-hierarchy exn:fail:user ())))
;; cce: adding exn:break would require a generic type for continuations
)
(provide (for-syntax initial-env/special-case initialize-others initialize-type-env)