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

removed some junk files that were in the repository.

This commit is contained in:
Abdulaziz Ghuloum 2007-12-10 12:00:12 -05:00
parent b6299fbec2
commit 0b648054b8
6 changed files with 24 additions and 271 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
R6RS-TODO.txt
View File

@ -1,89 +0,0 @@
TODO for (R6RS BASE)
* Compiler + libraries:
- letrec and letrec* restrictions (references and multiple returns)
- prohibit export of mutable bindings
- library versioning
- library phases (simply ignore)
- internal imports
- Recognize (define x)
- Add identifier-syntax
- Add do, let*-values.
* Numerics:
- Add rational, complex, and single-precision numbers
- Make sure the following primitives work:
rationalize
make-rectangular make-polar
real-part imag-part
magnitude angle
expt log
sin cos tan
asin acos atan
sqrt exact-integer-sqrt
number? complex? real? rational? integer?
real-valued? rational-valued? integer-values?
exact? inexact? ->exact ->inexact
real->flonum real->single real->double
= < <= > >=
zero? positive? negative?
odd? even?
finite? infinite? nan?
min max abs
+ - * /
div mod div-and-mod
div0 mod0 div0-and-mod0
gcd lcm (don't deal with inexact ints yet)
floor ceiling truncate round
number->string(radix,precision) string->number(radix)
* Read:
- recognize rational, complex and flonum syntax
- recognize inline-hex sequences (strings, chars, and symbols)
- #!r6rs
- #\ sequnces: nul, alarm, backspace, tab, linefeed, vtab, page,
return, esc, space, delete
- respect unicode constituents
- recognize \a, \b, \t, \n, \v, \f, \r, \", \\, \<lf>, \<spc>,
\xXXX; sequences in strings.
- Add unsyntax, unsyntax-splicing, and quasisyntax.
* Bytevectors:
- equal? for bytevectors
* Strings:
- string-copy
- string-fill!
* Vectors:
- vector-fill!
- vector-map
- vector-for-each
* Errors:
- (error who msg irritants ...)
- (assertion-violation who message irritants ...)
Completed for (R6RS BASE):
- Add let-syntax and letrec-syntax
numerator denominator

32
TODO
View File

@ -1,32 +0,0 @@
* Fix pretty-print to handle shared/cyclic data.
* Fix pretty-print to print records properly.
CHECK * Recognize calls to call-with-values where the second argument is a
case-lambda and handle them sensibly.
* Guardians:
CHECK - Implement guardians.
CHECK - clean up after file ports are dead by flushing/closing the
underlying file handle.
- Flush and close output-port on exit.
* Interrupts:
CHECK - pcb should have an engine-counter field that's decremented on
every procedure call.
CHECK - a do-event procedure must be called when the counter goes
negative. It should capture the current continuation and
reschedule the process.
CHECK - figure out what to do when a process gets interrupted while
reading from a file.
CHECK - Implement [CTRL-C] keyboard interruption with the ability to
resume the computation, reset to the repl, or terminate the
program (at least for now).
* FFI:
- provide a general mechanism for calling foreign procedures
without having to extend the VM.
(foreign-call void: FOO int32: x char*: y ptr: z)
- may dump the bignum stuff in the VM and move it to scheme.
CHECK * Read-invariant gensym.

0
scheme/asm-tests.ss → lab/asm-tests.ss
View File

61
scheme/dotests.ss
View File

@ -1,61 +0,0 @@
#!/usr/bin/env ikarus --script
;;; Ikarus Scheme -- A compiler for R6RS Scheme.
;;; Copyright (C) 2006,2007 Abdulaziz Ghuloum
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License version 3 as
;;; published by the Free Software Foundation.
;;;
;;; This program is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(import scheme)
(define (test-one input str)
(printf " T: ~s " input)
(let ([v0 (eval input)])
(printf "c")
; (collect)
(let ([v1 (alt-compile input)])
(printf "r")
(if (equal? v0 v1)
(printf "d ok\n")
(error "values differed, expected ~s, got ~s" v0 v1)))))
(define-syntax add-tests-with-string-output
(syntax-rules (=>)
[(_ name [test => res] ...)
(begin
(printf "TESTING ~a ...\n" 'name)
(test-one 'test 'res) ...
(printf "OK\n"))]))
(load "tests/tests-1.1-req.scm")
(load "tests/tests-1.2-req.scm")
(load "tests/tests-1.3-req.scm")
(load "tests/tests-1.4-req.scm")
(load "tests/tests-1.5-req.scm")
(load "tests/tests-1.6-req.scm")
(load "tests/tests-1.7-req.scm")
(load "tests/tests-1.8-req.scm")
(load "tests/tests-1.9-req.scm")
(load "tests/tests-2.1-req.scm")
(load "tests/tests-2.2-req.scm")
(load "tests/tests-2.3-req.scm")
(load "tests/tests-2.4-req.scm")
(load "tests/tests-2.6-req.scm")
(load "tests/tests-4.1-req.scm")
(load "tests/tests-new.scm")
;(load "tests/tests-5.2-req.scm")
;(load "tests/tests-5.3-req.scm")
(printf "HAPPY HAPPY JOY JOY\n")
(exit)

61
scheme/ikarus.hash-tables.ss
View File

@ -15,23 +15,23 @@
(library (ikarus hash-tables)
(export make-eq-hashtable hashtable-ref hashtable-set! hashtable?
hashtable-size hashtable-delete! hashtable-contains?
hashtable-update! hashtable-keys hashtable-mutable?
hashtable-clear! hashtable-entries hashtable-copy
string-hash string-ci-hash symbol-hash)
(import
(ikarus system $pairs)
(ikarus system $vectors)
(ikarus system $tcbuckets)
(ikarus system $fx)
(except (ikarus) make-eq-hashtable hashtable-ref hashtable-set! hashtable?
hashtable-size hashtable-delete! hashtable-contains?
hashtable-update! hashtable-keys hashtable-mutable?
hashtable-clear! hashtable-entries hashtable-copy
string-hash string-ci-hash symbol-hash))
(export make-eq-hashtable hashtable-ref hashtable-set! hashtable?
hashtable-size hashtable-delete! hashtable-contains?
hashtable-update! hashtable-keys hashtable-mutable?
hashtable-clear! hashtable-entries hashtable-copy
string-hash string-ci-hash symbol-hash)
(import
(ikarus system $pairs)
(ikarus system $vectors)
(ikarus system $tcbuckets)
(ikarus system $fx)
(except (ikarus) make-eq-hashtable hashtable-ref hashtable-set! hashtable?
hashtable-size hashtable-delete! hashtable-contains?
hashtable-update! hashtable-keys hashtable-mutable?
hashtable-clear! hashtable-entries hashtable-copy
string-hash string-ci-hash symbol-hash))
(define-struct hasht (vec count tc mutable?))
(define-struct hasht (vec count tc mutable?))
;;; directly from Dybvig's paper
(define tc-pop
@ -45,10 +45,6 @@
($set-cdr! x #f)
v)))))
(define-syntax inthash
(syntax-rules ()
[(_ x) x]))
;;; assq-like lookup
(define direct-lookup
(lambda (x b)
@ -108,19 +104,17 @@
($set-tcbucket-tconc! b (hasht-tc h))
;;; then add it to the new place
(let ([k ($tcbucket-key b)])
(let ([ih (inthash (pointer-value k))])
(let ([ih (pointer-value k)])
(let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))])
(let ([n ($vector-ref vec idx)])
($set-tcbucket-next! b n)
($vector-set! vec idx b)
(void))))))))
(define (get-bucket h x)
(let ([pv (pointer-value x)]
[vec (hasht-vec h)])
(let ([ih (inthash pv)])
(let ([ih pv])
(let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))])
(let ([b ($vector-ref vec idx)])
(or (direct-lookup x b)
@ -132,7 +126,7 @@
(lambda (b) ($tcbucket-val b))]
[else v]))
(define (in-hash? h x)
(define (in-hash? h x)
(and (get-bucket h x) #t))
(define (del-hash h x)
@ -164,7 +158,7 @@
(lambda (h x v)
(let ([pv (pointer-value x)]
[vec (hasht-vec h)])
(let ([ih (inthash pv)])
(let ([ih pv])
(let ([idx ($fxlogand ih ($fx- ($vector-length vec) 1))])
(let ([b ($vector-ref vec idx)])
(cond
@ -178,7 +172,7 @@
($make-tcbucket (hasht-tc h) x v ($vector-ref vec idx))])
(if ($fx= (pointer-value x) pv)
($vector-set! vec idx bucket)
(let* ([ih (inthash (pointer-value x))]
(let* ([ih (pointer-value x)]
[idx
($fxlogand ih ($fx- ($vector-length vec) 1))])
($set-tcbucket-next! bucket ($vector-ref vec idx))
@ -187,8 +181,6 @@
(set-hasht-count! h ($fxadd1 ct))
(when ($fx> ct ($vector-length vec))
(enlarge-table h)))])))))))
(define (update-hash! h x proc default)
(cond
@ -196,13 +188,11 @@
(lambda (b) ($set-tcbucket-val! b (proc ($tcbucket-val b))))]
[else (put-hash! h x (proc default))]))
(define insert-b
(lambda (b vec mask)
(let* ([x ($tcbucket-key b)]
[pv (pointer-value x)]
[ih (inthash pv)]
[ih pv]
[idx ($fxlogand ih mask)]
[next ($tcbucket-next b)])
($set-tcbucket-next! b ($vector-ref vec idx))
@ -330,7 +320,6 @@
(get-hash h x v)
(error 'hashtable-ref "not a hash table" h))))
(define hashtable-contains?
(lambda (h x)
(if (hasht? h)
@ -345,7 +334,6 @@
(error 'hashtable-set! "hashtable is immutable" h))
(error 'hashtable-set! "not a hash table" h))))
(define hashtable-update!
(lambda (h x proc default)
(if (hasht? h)
@ -356,7 +344,6 @@
(error 'hashtable-update! "hashtable is immutable" h))
(error 'hashtable-update! "not a hash table" h))))
(define hashtable-size
(lambda (h)
(if (hasht? h)
@ -398,13 +385,13 @@
(define hashtable-copy
(case-lambda
[(h)
(if (hasht? h)
(if (hasht? h)
(if (hasht-mutable? h)
(hasht-copy h #f)
h)
(error 'hashtable-copy "not a hash table" h))]
[(h mutable?)
(if (hasht? h)
(if (hasht? h)
(if (or mutable? (hasht-mutable? h))
(hasht-copy h (and mutable? #t))
h)

52
scheme/r6rs-records.ss
View File

@ -1,52 +0,0 @@
;;; procedural layer:
(make-record-type-descriptor name parent uid sealed? opaque? fields)
;;; name is a symbol, for informational purposes only
;;; parent is #f or an rtd
;;; uid is #f or symbol.
;;; symbol => nongenerative (or interned by that name)
;;; #f => generative (can use a gensym for uid)
;;; if parent is sealed?, then it cannot be extended,
;;; therefore, parent must not be sealed.
;;; if parent is opaque, then so is the rtd (overrides opaque?)
;;; if parent is not opaque, then use opaque?
;;; fields is a vector where each element is either:
;;; (mutable <symbol>) or (immutable <symbol>)
;;; symbols need not be unique, they're informational.
(record-type-descriptor? x)
;;; self explanatory.
(make-record-constructor-descriptor
rtd parent-constructor-descriptor protocol)
;;; returns a record constructor descriptor
;;; protocol is either a procedure or #f
;;; if rtd has no parent, then protocol must be #f
;;; typical protocol procedure is:
;;; (lambda (new)
;;; (lambda (bar baz) ;;; constructor of 2 args
;;; ;;; for a record of three fields
;;; (new bar baz (* bar baz))))
;;; default protocol procedure is (lambda (new) new)
;;; an extension protocol is typically:
;;; (lambda (parent-new)
;;; (lambda (px py pz x y z)
;;; (let ([new (parent-new px py pz)])
;;; (new x y z))))
;;; or (lambda (parent-new)
;;; (lambda (px py pz x y z)
;;; ((parent-new px py pz) x y z)))
;;;
(record-constructor rcd)
;;; returns a procedure that constructs records. The number of
;;; arguments that the procedure takes is the same number of
;;; arguments in the protocol's inner lambda.
(record-predicate rtd) ;=> predicate procedure.
(record-accessor rtd k) ;=> accessor procedure.
(record-mutator rtd k) ;=> mutator procedure.