[bpt/guile.git] / module / system / il / macros.scm

;;; GHIL macros

;; Copyright (C) 2001 Free Software Foundation, Inc.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 
;; 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(define-module (system il macros)
  :use-module (ice-9 match))

(define (make-label) (gensym ":L"))
(define (make-sym) (gensym "_"))

\f
;;;
;;; Syntax
;;;

;; (@and X Y...) =>
;; 
;; (@if X (@and Y...) #f)
(define @and
  (match-lambda*
    (() #t)
    ((x) x)
    ((x . rest) `(@if ,x (@and ,@rest) #f))))

;; (@or X Y...) =>
;; 
;; (@let ((@_ X)) (@if @_ @_ (@or Y...)))
(define @or
  (match-lambda*
    (() #f)
    ((x) x)
    ((x . rest)
     (let ((sym (make-sym)))
       `(@let ((,sym ,x)) (@if ,sym ,sym (@or ,@rest)))))))

;; (@while TEST BODY...) =>
;; 
;;     (@goto L1)
;; L0: BODY...
;; L1: (@if TEST (@goto L0) (@void))
;;; non-R5RS
(define (@while test . body)
  (let ((L0 (make-label)) (L1 (make-label)))
    `(@begin
       (@goto ,L1)
       (@label ,L0) ,@body
       (@label ,L1) (@if ,test (@goto ,L0) (@void)))))

;; (@cond (TEST BODY...) ...) =>
;;
;;   (@if TEST
;;        (@begin BODY...)
;;        (@cond ...))
(define (@cond . clauses)
  (cond ((null? clauses) (error "missing clauses"))
	((pair? (car clauses))
	 (let ((c (car clauses)) (l (cdr clauses)))
	   (let ((rest (if (null? l) '(@void) `(@cond ,@l))))
	     (cond ((eq? (car c) '@else) `(@begin (@void) ,@(cdr c)))
		   ((null? (cdr c)) `(@or ,(car c) ,rest))
		   (else `(@if ,(car c) (@begin ,@(cdr c)) ,rest))))))
	(else (error "bad clause:" (car clauses)))))

(define (@let* binds . body)
  (if (null? binds)
      `(@begin ,@body)
      `(@let (,(car binds)) (@let* ,(cdr binds) ,@body))))

\f
;;;
;;; R5RS Procedures
;;;

;; 6. Standard procedures

;;; 6.1 Equivalence predicates

(define (@eq? x y)     `(@@ eq? ,x ,y))
(define (@eqv? x y)    `(@@ eqv? ,x ,y))
(define (@equal? x y)  `(@@ equal? ,x ,y))

;;; 6.2 Numbers

(define (@number? x)   `(@@ number? ,x))
(define (@complex? x)  `(@@ complex? ,x))
(define (@real? x)     `(@@ real? ,x))
(define (@rational? x) `(@@ rational? ,x))
(define (@integer? x)  `(@@ integer? ,x))

(define (@exact? x)    `(@@ exact? ,x))
(define (@inexact? x)  `(@@ inexact? ,x))

(define (@= x y)       `(@@ ee? ,x ,y))
(define (@< x y)       `(@@ lt? ,x ,y))
(define (@> x y)       `(@@ gt? ,x ,y))
(define (@<= x y)      `(@@ le? ,x ,y))
(define (@>= x y)      `(@@ ge? ,x ,y))

(define (@zero? x)     `(@= ,x 0))
(define (@positive? x) `(@> ,x 0))
(define (@negative? x) `(@< ,x 0))
(define (@odd? x)      `(@= (@modulo ,x 2) 1))
(define (@even? x)     `(@= (@modulo ,x 2) 0))

(define (@max . args)  `(@@ max ,@args))
(define (@min . args)  `(@@ min ,@args))

(define @+
  (match-lambda*
    (() 0)
    ((x) x)
    ((x y) `(@@ add ,x ,y))
    ((x y . rest) `(@@ add ,x (@+ ,y ,@rest)))))

(define @*
  (match-lambda*
    (() 1)
    ((x) x)
    ((x y) `(@@ mul ,x ,y))
    ((x y . rest) `(@@ mul ,x (@* ,y ,@rest)))))

(define @-
  (match-lambda*
    ((x) `(@@ neg ,x))
    ((x y) `(@@ sub ,x ,y))
    ((x y . rest) `(@@ sub ,x (@+ ,y ,@rest)))))

(define @/
  (match-lambda*
    ((x) `(@@ rec ,x))
    ((x y) `(@@ div ,x ,y))
    ((x y . rest) `(@@ div ,x (@* ,y ,@rest)))))

(define (@abs x) `(@if (@< x 0) (@- x) x))

(define (@quotient x y) `(@@ quotient ,x ,y))
(define (@remainder x y) `(@@ remainder ,x ,y))
(define (@modulo x y) `(@@ modulo ,x ,y))

;;; gcd
;;; lcm
;;; 
;;; numerator
;;; denominator
;;; 
;;; floor
;;; ceiling
;;; truncate
;;; round
;;; 
;;; rationalize
;;; 
;;; exp
;;; log
;;; sin
;;; cos
;;; tan
;;; asin
;;; acos
;;; atan
;;; 
;;; sqrt
;;; expt
;;; 
;;; make-rectangular
;;; make-polar
;;; real-part
;;; imag-part
;;; magnitude
;;; angle
;;; 
;;; exact->inexact
;;; inexact->exact
;;; 
;;; number->string
;;; string->number

;;; 6.3 Other data types

;;;; 6.3.1 Booleans

(define (@not x) `(@@ not ,x))
(define (@boolean? x) `(@@ boolean? ,x))

;;;; 6.3.2 Pairs and lists

(define (@pair? x) `(@@ pair? ,x))
(define (@cons x y) `(@@ cons ,x ,y))

(define (@car x) `(@@ car ,x))
(define (@cdr x) `(@@ cdr ,x))
(define (@set-car! x) `(@@ set-car! ,x))
(define (@set-cdr! x) `(@@ set-cdr! ,x))

(define (@caar x) `(@@ car (@@ car ,x)))
(define (@cadr x) `(@@ car (@@ cdr ,x)))
(define (@cdar x) `(@@ cdr (@@ car ,x)))
(define (@cddr x) `(@@ cdr (@@ cdr ,x)))
(define (@caaar x) `(@@ car (@@ car (@@ car ,x))))
(define (@caadr x) `(@@ car (@@ car (@@ cdr ,x))))
(define (@cadar x) `(@@ car (@@ cdr (@@ car ,x))))
(define (@caddr x) `(@@ car (@@ cdr (@@ cdr ,x))))
(define (@cdaar x) `(@@ cdr (@@ car (@@ car ,x))))
(define (@cdadr x) `(@@ cdr (@@ car (@@ cdr ,x))))
(define (@cddar x) `(@@ cdr (@@ cdr (@@ car ,x))))
(define (@cdddr x) `(@@ cdr (@@ cdr (@@ cdr ,x))))
(define (@caaaar x) `(@@ car (@@ car (@@ car (@@ car ,x)))))
(define (@caaadr x) `(@@ car (@@ car (@@ car (@@ cdr ,x)))))
(define (@caadar x) `(@@ car (@@ car (@@ cdr (@@ car ,x)))))
(define (@caaddr x) `(@@ car (@@ car (@@ cdr (@@ cdr ,x)))))
(define (@cadaar x) `(@@ car (@@ cdr (@@ car (@@ car ,x)))))
(define (@cadadr x) `(@@ car (@@ cdr (@@ car (@@ cdr ,x)))))
(define (@caddar x) `(@@ car (@@ cdr (@@ cdr (@@ car ,x)))))
(define (@cadddr x) `(@@ car (@@ cdr (@@ cdr (@@ cdr ,x)))))
(define (@cdaaar x) `(@@ cdr (@@ car (@@ car (@@ car ,x)))))
(define (@cdaadr x) `(@@ cdr (@@ car (@@ car (@@ cdr ,x)))))
(define (@cdadar x) `(@@ cdr (@@ car (@@ cdr (@@ car ,x)))))
(define (@cdaddr x) `(@@ cdr (@@ car (@@ cdr (@@ cdr ,x)))))
(define (@cddaar x) `(@@ cdr (@@ cdr (@@ car (@@ car ,x)))))
(define (@cddadr x) `(@@ cdr (@@ cdr (@@ car (@@ cdr ,x)))))
(define (@cdddar x) `(@@ cdr (@@ cdr (@@ cdr (@@ car ,x)))))
(define (@cddddr x) `(@@ cdr (@@ cdr (@@ cdr (@@ cdr ,x)))))

(define (@null? x) `(@@ null? ,x))
(define (@list? x) `(@@ list? ,x))
(define (@list . args) `(@@ list ,@args))

;;; length
;;; append
;;; reverse
;;; list-tail
;;; list-ref
;;; 
;;; memq
;;; memv
;;; member
;;; 
;;; assq
;;; assv
;;; assoc

;;;; 6.3.3 Symbols

;;; symbol?
;;; symbol->string
;;; string->symbol

;;;; 6.3.4 Characters

;;; char?
;;; char=?
;;; char<?
;;; char>?
;;; char<=?
;;; char>=?
;;; char-ci=?
;;; char-ci<?
;;; char-ci>?
;;; char-ci<=?
;;; char-ci>=?
;;; char-alphabetic?
;;; char-numeric?
;;; char-whitespace?
;;; char-upper-case?
;;; char-lower-case?
;;; char->integer
;;; integer->char
;;; char-upcase
;;; char-downcase

;;;; 6.3.5 Strings

;;; string?
;;; make-string
;;; string
;;; string-length
;;; string-ref
;;; string-set!
;;; 
;;; string=?
;;; string-ci=?
;;; string<?
;;; string>?
;;; string<=?
;;; string>=?
;;; string-ci<?
;;; string-ci>?
;;; string-ci<=?
;;; string-ci>=?
;;; 
;;; substring
;;; string-append
;;; string->list
;;; list->string
;;; string-copy
;;; string-fill!

;;;; 6.3.6 Vectors

;;; vector?
;;; make-vector
;;; vector
;;; vector-length
;;; vector-ref
;;; vector-set!
;;; vector->list
;;; list->vector
;;; vector-fill!

;;;; 6.4 Control features

(define (@procedure? x) `(@@ procedure? x))

;; (define (@apply proc . args) ...)

;;; map
;;; for-each

;;; (define (@force promise) `(@@ force promise))

;;; (define (@call-with-current-continuation proc) `(@@ call/cc proc))

;;; (define @call/cc @call-with-current-continuation)

;;; values
;;; call-with-values
;;; dynamic-wind

;;; 6.5 Eval

;;; eval
;;; scheme-report-environment
;;; null-environment
;;; interaction-environment

;;; 6.6 Input and output

;;;; 6.6.1 Ports

;;; call-with-input-file
;;; call-with-output-file
;;; 
;;; input-port?
;;; output-port?
;;; current-input-port
;;; current-output-port
;;; 
;;; with-input-from-file
;;; with-output-to-file
;;; 
;;; open-input-file
;;; open-output-file
;;; close-input-port
;;; close-output-port

;;;; 6.6.2 Input

;;; read
;;; read-char
;;; peek-char
;;; eof-object?
;;; char-ready?

;;;; 6.6.3 Output

;;; write
;;; display
;;; newline
;;; write-char

;;;; 6.6.4 System interface

;;; load
;;; transcript-on
;;; transcript-off

\f
;;;
;;; Non-R5RS Procedures
;;;

(define @cons*
  (match-lambda*
    ((x) x)
    ((x y) `(@cons ,x ,y))
    ((x y . rest) `(@cons ,x (@cons* ,y ,@rest)))))

(define (@error . args) `(@@ display ,@args))

(define (@current-module)
  `((@ System::Base::module::current-module)))
Commit	Line	Data
17e90c5e KN	1	;;; GHIL macros
	2
	3	;; Copyright (C) 2001 Free Software Foundation, Inc.
	4
	5	;; This program is free software; you can redistribute it and/or modify
	6	;; it under the terms of the GNU General Public License as published by
	7	;; the Free Software Foundation; either version 2, or (at your option)
	8	;; any later version.
	9	;;
	10	;; This program is distributed in the hope that it will be useful,
	11	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	;; GNU General Public License for more details.
	14	;;
	15	;; You should have received a copy of the GNU General Public License
	16	;; along with this program; see the file COPYING. If not, write to
	17	;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	18	;; Boston, MA 02111-1307, USA.
	19
	20	;;; Code:
	21
	22	(define-module (system il macros)
	23	:use-module (ice-9 match))
	24
	25	(define (make-label) (gensym ":L"))
	26	(define (make-sym) (gensym "_"))
	27
17e90c5e KN	28	\f
	29	;;;
	30	;;; Syntax
	31	;;;
	32
	33	;; (@and X Y...) =>
	34	;;
	35	;; (@if X (@and Y...) #f)
	36	(define @and
	37	(match-lambda*
	38	(() #t)
	39	((x) x)
	40	((x . rest) `(@if ,x (@and ,@rest) #f))))
	41
	42	;; (@or X Y...) =>
	43	;;
	44	;; (@let ((@_ X)) (@if @_ @_ (@or Y...)))
	45	(define @or
	46	(match-lambda*
	47	(() #f)
	48	((x) x)
	49	((x . rest)
	50	(let ((sym (make-sym)))
	51	`(@let ((,sym ,x)) (@if ,sym ,sym (@or ,@rest)))))))
	52
	53	;; (@while TEST BODY...) =>
	54	;;
	55	;; (@goto L1)
	56	;; L0: BODY...
	57	;; L1: (@if TEST (@goto L0) (@void))
	58	;;; non-R5RS
	59	(define (@while test . body)
	60	(let ((L0 (make-label)) (L1 (make-label)))
	61	`(@begin
	62	(@goto ,L1)
	63	(@label ,L0) ,@body
	64	(@label ,L1) (@if ,test (@goto ,L0) (@void)))))
	65
	66	;; (@cond (TEST BODY...) ...) =>
	67	;;
	68	;; (@if TEST
	69	;; (@begin BODY...)
	70	;; (@cond ...))
	71	(define (@cond . clauses)
	72	(cond ((null? clauses) (error "missing clauses"))
	73	((pair? (car clauses))
	74	(let ((c (car clauses)) (l (cdr clauses)))
	75	(let ((rest (if (null? l) '(@void) `(@cond ,@l))))
	76	(cond ((eq? (car c) '@else) `(@begin (@void) ,@(cdr c)))
	77	((null? (cdr c)) `(@or ,(car c) ,rest))
	78	(else `(@if ,(car c) (@begin ,@(cdr c)) ,rest))))))
	79	(else (error "bad clause:" (car clauses)))))
	80
	81	(define (@let* binds . body)
	82	(if (null? binds)
	83	`(@begin ,@body)
	84	`(@let (,(car binds)) (@let* ,(cdr binds) ,@body))))
	85
	86	\f
	87	;;;
	88	;;; R5RS Procedures
	89	;;;
	90
	91	;; 6. Standard procedures
92
93	;;; 6.1 Equivalence predicates
94
95	(define (@eq? x y) `(@@ eq? ,x ,y))
96	(define (@eqv? x y) `(@@ eqv? ,x ,y))
97	(define (@equal? x y) `(@@ equal? ,x ,y))
98
99	;;; 6.2 Numbers
100
101	(define (@number? x) `(@@ number? ,x))
102	(define (@complex? x) `(@@ complex? ,x))
103	(define (@real? x) `(@@ real? ,x))
104	(define (@rational? x) `(@@ rational? ,x))
105	(define (@integer? x) `(@@ integer? ,x))
106
107	(define (@exact? x) `(@@ exact? ,x))
108	(define (@inexact? x) `(@@ inexact? ,x))
109
110	(define (@= x y) `(@@ ee? ,x ,y))
111	(define (@< x y) `(@@ lt? ,x ,y))
112	(define (@> x y) `(@@ gt? ,x ,y))
113	(define (@<= x y) `(@@ le? ,x ,y))
114	(define (@>= x y) `(@@ ge? ,x ,y))
115
116	(define (@zero? x) `(@= ,x 0))
117	(define (@positive? x) `(@> ,x 0))
118	(define (@negative? x) `(@< ,x 0))
119	(define (@odd? x) `(@= (@modulo ,x 2) 1))
120	(define (@even? x) `(@= (@modulo ,x 2) 0))
121
122	(define (@max . args) `(@@ max ,@args))
123	(define (@min . args) `(@@ min ,@args))
124
125	(define @+
126	(match-lambda*
127	(() 0)
128	((x) x)
129	((x y) `(@@ add ,x ,y))
130	((x y . rest) `(@@ add ,x (@+ ,y ,@rest)))))
131
132	(define @*
133	(match-lambda*
134	(() 1)
135	((x) x)
136	((x y) `(@@ mul ,x ,y))
137	((x y . rest) `(@@ mul ,x (@* ,y ,@rest)))))
138
139	(define @-
140	(match-lambda*
141	((x) `(@@ neg ,x))
142	((x y) `(@@ sub ,x ,y))
143	((x y . rest) `(@@ sub ,x (@+ ,y ,@rest)))))
144
145	(define @/
146	(match-lambda*
147	((x) `(@@ rec ,x))
148	((x y) `(@@ div ,x ,y))
149	((x y . rest) `(@@ div ,x (@* ,y ,@rest)))))
150
46cd9a34 KN	151	(define (@abs x) `(@if (@< x 0) (@- x) x))
	152
	153	(define (@quotient x y) `(@@ quotient ,x ,y))
17e90c5e	154	(define (@remainder x y) `(@@ remainder ,x ,y))
46cd9a34 KN	155	(define (@modulo x y) `(@@ modulo ,x ,y))
46cd9a34 KN	156
17e90c5e KN	157	;;; gcd
	158	;;; lcm
	159	;;;
	160	;;; numerator
	161	;;; denominator
	162	;;;
	163	;;; floor
	164	;;; ceiling
	165	;;; truncate
	166	;;; round
	167	;;;
	168	;;; rationalize
	169	;;;
	170	;;; exp
	171	;;; log
	172	;;; sin
	173	;;; cos
	174	;;; tan
	175	;;; asin
	176	;;; acos
	177	;;; atan
	178	;;;
	179	;;; sqrt
	180	;;; expt
	181	;;;
	182	;;; make-rectangular
	183	;;; make-polar
	184	;;; real-part
	185	;;; imag-part
	186	;;; magnitude
	187	;;; angle
	188	;;;
	189	;;; exact->inexact
	190	;;; inexact->exact
	191	;;;
	192	;;; number->string
	193	;;; string->number
	194
	195	;;; 6.3 Other data types
	196
	197	;;;; 6.3.1 Booleans
	198
	199	(define (@not x) `(@@ not ,x))
	200	(define (@boolean? x) `(@@ boolean? ,x))
	201
	202	;;;; 6.3.2 Pairs and lists
	203
	204	(define (@pair? x) `(@@ pair? ,x))
	205	(define (@cons x y) `(@@ cons ,x ,y))
	206
	207	(define (@car x) `(@@ car ,x))
	208	(define (@cdr x) `(@@ cdr ,x))
	209	(define (@set-car! x) `(@@ set-car! ,x))
	210	(define (@set-cdr! x) `(@@ set-cdr! ,x))
	211
	212	(define (@caar x) `(@@ car (@@ car ,x)))
	213	(define (@cadr x) `(@@ car (@@ cdr ,x)))
	214	(define (@cdar x) `(@@ cdr (@@ car ,x)))
	215	(define (@cddr x) `(@@ cdr (@@ cdr ,x)))
	216	(define (@caaar x) `(@@ car (@@ car (@@ car ,x))))
	217	(define (@caadr x) `(@@ car (@@ car (@@ cdr ,x))))
	218	(define (@cadar x) `(@@ car (@@ cdr (@@ car ,x))))
	219	(define (@caddr x) `(@@ car (@@ cdr (@@ cdr ,x))))
	220	(define (@cdaar x) `(@@ cdr (@@ car (@@ car ,x))))
221	(define (@cdadr x) `(@@ cdr (@@ car (@@ cdr ,x))))
222	(define (@cddar x) `(@@ cdr (@@ cdr (@@ car ,x))))
223	(define (@cdddr x) `(@@ cdr (@@ cdr (@@ cdr ,x))))
224	(define (@caaaar x) `(@@ car (@@ car (@@ car (@@ car ,x)))))
225	(define (@caaadr x) `(@@ car (@@ car (@@ car (@@ cdr ,x)))))
226	(define (@caadar x) `(@@ car (@@ car (@@ cdr (@@ car ,x)))))
227	(define (@caaddr x) `(@@ car (@@ car (@@ cdr (@@ cdr ,x)))))
228	(define (@cadaar x) `(@@ car (@@ cdr (@@ car (@@ car ,x)))))
229	(define (@cadadr x) `(@@ car (@@ cdr (@@ car (@@ cdr ,x)))))
230	(define (@caddar x) `(@@ car (@@ cdr (@@ cdr (@@ car ,x)))))
231	(define (@cadddr x) `(@@ car (@@ cdr (@@ cdr (@@ cdr ,x)))))
232	(define (@cdaaar x) `(@@ cdr (@@ car (@@ car (@@ car ,x)))))
233	(define (@cdaadr x) `(@@ cdr (@@ car (@@ car (@@ cdr ,x)))))
234	(define (@cdadar x) `(@@ cdr (@@ car (@@ cdr (@@ car ,x)))))
235	(define (@cdaddr x) `(@@ cdr (@@ car (@@ cdr (@@ cdr ,x)))))
236	(define (@cddaar x) `(@@ cdr (@@ cdr (@@ car (@@ car ,x)))))
237	(define (@cddadr x) `(@@ cdr (@@ cdr (@@ car (@@ cdr ,x)))))
238	(define (@cdddar x) `(@@ cdr (@@ cdr (@@ cdr (@@ car ,x)))))
239	(define (@cddddr x) `(@@ cdr (@@ cdr (@@ cdr (@@ cdr ,x)))))
240
241	(define (@null? x) `(@@ null? ,x))
242	(define (@list? x) `(@@ list? ,x))
243	(define (@list . args) `(@@ list ,@args))
244
245	;;; length
246	;;; append
247	;;; reverse
248	;;; list-tail
249	;;; list-ref
250	;;;
251	;;; memq
252	;;; memv
253	;;; member
254	;;;
255	;;; assq
256	;;; assv
257	;;; assoc
258
259	;;;; 6.3.3 Symbols
260
261	;;; symbol?
262	;;; symbol->string
263	;;; string->symbol
264
265	;;;; 6.3.4 Characters
266
267	;;; char?
268	;;; char=?
269	;;; char<?
270	;;; char>?
271	;;; char<=?
272	;;; char>=?
273	;;; char-ci=?
274	;;; char-ci<?
275	;;; char-ci>?
276	;;; char-ci<=?
277	;;; char-ci>=?
278	;;; char-alphabetic?
279	;;; char-numeric?
280	;;; char-whitespace?
281	;;; char-upper-case?
282	;;; char-lower-case?
283	;;; char->integer
284	;;; integer->char
285	;;; char-upcase
286	;;; char-downcase
287
288	;;;; 6.3.5 Strings
289
290	;;; string?
291	;;; make-string
292	;;; string
293	;;; string-length
294	;;; string-ref
295	;;; string-set!
296	;;;
297	;;; string=?
298	;;; string-ci=?
299	;;; string<?
300	;;; string>?
301	;;; string<=?
302	;;; string>=?
303	;;; string-ci<?
304	;;; string-ci>?
305	;;; string-ci<=?
306	;;; string-ci>=?
307	;;;
308	;;; substring
309	;;; string-append
310	;;; string->list
311	;;; list->string
312	;;; string-copy
313	;;; string-fill!
314
315	;;;; 6.3.6 Vectors
316
317	;;; vector?
318	;;; make-vector
319	;;; vector
320	;;; vector-length
321	;;; vector-ref
322	;;; vector-set!
323	;;; vector->list
324	;;; list->vector
325	;;; vector-fill!
326
327	;;;; 6.4 Control features
328
329	(define (@procedure? x) `(@@ procedure? x))
330
331	;; (define (@apply proc . args) ...)
332
46cd9a34 KN	333	;;; map
46cd9a34 KN	334	;;; for-each
17e90c5e	335
46cd9a34	336	;;; (define (@force promise) `(@@ force promise))
17e90c5e	337
46cd9a34	338	;;; (define (@call-with-current-continuation proc) `(@@ call/cc proc))
17e90c5e	339
46cd9a34	340	;;; (define @call/cc @call-with-current-continuation)
17e90c5e KN	341
	342	;;; values
	343	;;; call-with-values
	344	;;; dynamic-wind
	345
	346	;;; 6.5 Eval
	347
	348	;;; eval
	349	;;; scheme-report-environment
	350	;;; null-environment
	351	;;; interaction-environment
	352
	353	;;; 6.6 Input and output
	354
	355	;;;; 6.6.1 Ports
	356
	357	;;; call-with-input-file
	358	;;; call-with-output-file
	359	;;;
	360	;;; input-port?
	361	;;; output-port?
	362	;;; current-input-port
	363	;;; current-output-port
	364	;;;
	365	;;; with-input-from-file
	366	;;; with-output-to-file
	367	;;;
	368	;;; open-input-file
	369	;;; open-output-file
	370	;;; close-input-port
	371	;;; close-output-port
	372
	373	;;;; 6.6.2 Input
	374
	375	;;; read
	376	;;; read-char
	377	;;; peek-char
	378	;;; eof-object?
	379	;;; char-ready?
	380
	381	;;;; 6.6.3 Output
	382
	383	;;; write
	384	;;; display
	385	;;; newline
	386	;;; write-char
	387
	388	;;;; 6.6.4 System interface
	389
	390	;;; load
	391	;;; transcript-on
	392	;;; transcript-off
	393
	394	\f
	395	;;;
	396	;;; Non-R5RS Procedures
	397	;;;
	398
	399	(define @cons*
	400	(match-lambda*
	401	((x) x)
	402	((x y) `(@cons ,x ,y))
	403	((x y . rest) `(@cons ,x (@cons* ,y ,@rest)))))
	404
405	(define (@error . args) `(@@ display ,@args))
406
407	(define (@current-module)
408	`((@ System::Base::module::current-module)))