conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

- compound conditions are made non-opaque. 

- more tag analysis for bytevectors and friends.
This commit is contained in:
Abdulaziz Ghuloum 2008-07-08 08:15:14 -07:00
parent 749080724c
commit 00970f12d2
4 changed files with 25 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
scheme/ikarus.compiler.tag-annotation-analysis.ss
View File

@ -25,17 +25,6 @@
#;
(define primitive-return-types
'(
[length fixnum]
[bytevector-length fixnum]
[bytevector-u8-ref fixnum]
[bytevector-s8-ref fixnum]
[bytevector-u16-ref fixnum]
[bytevector-s16-ref fixnum]
[bytevector-u16-native-ref fixnum]
[bytevector-s16-native-ref fixnum]
[fixnum-width fixnum]
[greatest-fixnum fixnum]
[least-fixnum fixnum]
[= boolean]
[< boolean]
[<= boolean]
@ -305,17 +294,30 @@
(inject T:object T:vector T:fixnum)]
[(vector-set!)
(inject T:void T:vector T:fixnum T:object)]
[(length)
(inject T:fixnum (T:or T:null T:pair))]
[(bytevector-length)
(inject T:fixnum T:bytevector)]
[(integer->char)
(inject T:char T:fixnum)]
[(char->integer)
(inject T:fixnum T:char)]
[(bytevector-u8-ref bytevector-s8-ref
bytevector-u16-native-ref bytevector-s16-native-ref)
(inject T:fixnum T:bytevector T:fixnum)]
[(bytevector-u16-ref bytevector-s16-ref)
(inject T:fixnum T:bytevector T:fixnum T:symbol)]
[(bytevector-u8-set! bytevector-s8-set!
bytevector-u16-native-set! bytevector-s16-native-set!)
(inject T:void T:bytevector T:fixnum T:fixnum)]
[(bytevector-u16-set! bytevector-s16-set!)
(inject T:void T:bytevector T:fixnum T:fixnum T:symbol)]
[(fx+ fx- fx* fxadd1 fxsub1
fxquotient fxremainder fxmodulo fxsll fxsra
fxand fxdiv fxdiv0 fxif fxior
fxlength fxmax fxmin fxmod fxmod0
fxnot fxxor fxlogand fxlogor fxlognot
fxlogxor fxlogand fxlogand fxlogand fxlogand
fxlogand fxlogand)
fxlogxor)
(inject* T:fixnum T:fixnum)]
[(fx= fx< fx<= fx> fx>= fx=? fx<? fx<=? fx>? fx>=?
fxeven? fxodd? fxnegative? fxpositive? fxzero?
@ -343,11 +345,12 @@
enum-set-indexer
make-guardian)
(return T:procedure)]
[(fixnum-width greatest-fixnum least-fixnum)
(return T:fixnum)]
[else
(return T:object)]))
;;;
(define (extend-env* x* v* env)
(cond
@ -429,6 +432,6 @@
[else T:object]))]))
(let-values ([(x env t) (V x empty-env)])
(when (tag-analysis-output)
(pretty-print (unparse x)))
(pretty-print (unparse-pretty x)))
x))

3
scheme/ikarus.conditions.ss
View File

@ -128,6 +128,7 @@
(define-record-type &condition
(nongenerative))
(define &condition-rtd (record-type-descriptor &condition))
(define &condition-rcd (record-constructor-descriptor &condition))
@ -135,7 +136,7 @@
(nongenerative)
(fields (immutable components))
(sealed #t)
(opaque #t))
(opaque #f))
(define (condition? x)
(or (&condition? x)

5
scheme/ikarus.ontology.ss
View File

@ -217,7 +217,7 @@
(let* ([ls '()]
[ls
(case (predname* x)
[(yes) (cons '(name* yes) ls)]
[(yes) (cons 'name* ls)]
[else ls])]
...)
ls))
@ -231,7 +231,8 @@
[immediate (exclusive fixnum boolean null char void)]
[obj-truth (exclusive false non-false)]
[obj-tag (exclusive procedure string vector pair null
boolean char number void other-object)]
boolean char number void bytevector
symbol other-object)]
[boolean (exclusive true false)]
[number (inclusive number-tag number-size number-exactness)]
[number-size (exclusive negative zero positive)]

2
scheme/last-revision
View File

@ -1 +1 @@
1532
1533