forked from JuliaLang/julia
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathaliases.scm
76 lines (61 loc) · 1.99 KB
/
aliases.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
; definitions of standard scheme procedures in terms of femtolisp procedures
(define-macro (begin0 first . rest)
`(prog1 ,first ,@rest))
(define vector-ref aref)
(define vector-set! aset!)
(define vector-length length)
(define char=? eqv?)
(define char<? <)
(define char>? >)
(define char<=? <=)
(define char>=? >=)
(define (char-whitespace? c) (not (not (string.find *whitespace* c))))
(define (char-numeric? c) (not (not (string.find "0123456789" c))))
(define string-append string)
(define string-length string.count)
(define string->symbol symbol)
(define (symbol->string s) (string s))
(define (list->string l) (apply string l))
(define (string->list s)
(do ((i (sizeof s) i)
(l '() (cons (string.char s i) l)))
((= i 0) l)
(set! i (string.dec s i))))
(define (substring s start end)
(string.sub s (string.inc s 0 start) (string.inc s 0 end)))
(define (port? x) (iostream? x))
(define (read-char (s *input-stream*)) (io.getc s))
(define (peek-char (s *input-stream*)) (io.peekc s))
(define (write-char c (s *output-stream*)) (io.putc s c))
(define (port-eof? p) (io.eof? p))
(define (open-input-string str)
(let ((b (buffer)))
(io.write b str)
(io.seek b 0)
b))
(define (open-output-string) (buffer))
(define (open-string-output-port)
(let ((b (buffer)))
(values b (lambda () (io.tostring! b)))))
(define (get-output-string b)
(let ((p (io.pos b)))
(io.seek b 0)
(let ((s (io.readall b)))
(io.seek b p)
(if (eof-object? s) "" s))))
(define (open-input-file name) (file name :read))
(define (open-output-file name) (file name :write :create))
(define (current-input-port (p *input-stream*))
(set! *input-stream* p))
(define (current-output-port (p *output-stream*))
(set! *output-stream* p))
(define (display x (port *output-stream*))
(with-output-to port (princ x))
#t)
; --- gambit
(define (with-exception-catcher hand thk)
(trycatch (thk)
(lambda (e) (hand e))))
(define make-table table)
(define table-ref get)
(define table-set! put!)