Newer
Older
;;;; -*- lisp -*-
; A thin emulation layer to run simple Scheme code within CL.
#+xcvb
(module
(:depends-on
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
#| "
This code aims to provide a very thin layer of Scheme compatibility in CL.
It is meant to leverage simple code written with Scheme syntax;
it does NOT try to actually implement deep Scheme semantics.
If you want a real Scheme-in-CL implementation, there are other places to look.
The goal is for me to more easily migrate my former Scribe documents,
and otherwise allow to reuse and share code between Scheme and CL
while minizing the amount of things to change on either side.
Here are some particular implementation choices and limitations:
* We don't do any extraneous error checking.
If the Scheme program wasn't debugged, we don't care to support it.
This allows for a very shallow implementation of Scheme primitives
with less strict Common Lisp primitives that behave well
in cases defined as erroneous or left undefined by the Scheme standard.
* We don't provide a unified namespace for functions and variables,
but reuse what the Common Lisp evaluator provides.
= Be sure to use (funcall ...) and (function ...) as appropriate;
The macros funcall*, apply* and map* are provided to wrap (function ...)
around their first argument. You can't use map, which means something
different in Scheme and CL; use mapcar or map* instead.
= be sure to not try to bind T or NIL or any other constant as a variable.
you may have to rename a few variables in your Scheme program.
* We don't support distinction of NIL () and #f or inexact numbers.
* We won't provide any kind of support for first-class continuations,
They could be added on top of Screamer, I suppose.
* I implement features on a need basis. I won't proactively implement
any features from RnRS or SRFIs. But it's easy enough to port those features
that you need, and I'll accept patches.
* We only support the symbols declared in package scheme-makeup,
plus the following from the CL package:
cons car cdr c([ad]+)r list
let let*
* We recommend that you use the following CL features that are in Scribe
if not in RnRS:
labels => together with let, a good replacement for letrec and named let.
* Anything that clashes with CL semantics is unsupported; sometimes we provide
some equivalent functionality under a different name:
call-with-current-continuation => unsupported
letrec => unsupported, because it doesn't distinguish namespaces. Use labels.
let => named let is unsupported. Use labels.
map => Use map* or mapcar.
for-each => use for-each* or for-each
Reference for Scheme and CL semantics:
http://swiss.csail.mit.edu/~jaffer/r5rs_toc.html
http://lisp.org/HyperSpec/
If we really wanted to implement lisp1 semantics for let, letrec, etc.,
we could example a lisp1 binding for x to value into
(macrolet ((,x (&rest ,args) `(funcall ,,x ,@,args)))
(let ((,x ,value))
,@body))
|#
(in-package :scheme-compat)
(defparameter *scheme-true* t)
(defparameter *scheme-false* nil)
(defparameter else t)
;;; define
(defun process-scheme-formals (formals)
(cond
((null formals) nil)
((symbolp formals) `(&rest ,formals))
((consp formals)
(cons (car formals) (process-scheme-formals (cdr formals))))
(t (error "bad scheme formals"))))
(defun make-function-definition (name formals body &optional (defun 'defun))
`(,defun ,name ,(process-scheme-formals formals) ,@body))
(defmacro define (name &rest rest)
(if (symbolp name)
`(defparameter ,name ,@rest)
(make-function-definition (first name) (rest name) rest)))
;;; forms implementable as simple aliases
(defmacro defalias (simpleargs sch cl)
`(defun ,sch ,simpleargs (,cl ,@simpleargs)))
(defmacro defaliases (args &rest r)
`(progn ,@(loop for (sch . cl) in (plist->alist r)
collect `(defalias ,args ,sch ,cl))))
(defmacro defxalias (sch cl)
`(defun ,sch (&rest r) (apply ',cl r)))
(defmacro defxaliases (&rest r)
`(progn ,@(loop for (sch . cl) in (plist->alist r)
collect `(defxalias ,sch ,cl))))
(defmacro defmalias (sch cl)
`(defmacro ,sch (&rest r) `(,',cl ,@r)))
(defmacro defmaliases (&rest r)
`(progn ,@(loop for (sch . cl) in (plist->alist r)
collect `(defmalias ,sch ,cl))))
(defmacro defvalias (sch cl)
`(define-symbol-macro ,sch ,cl))
(defmacro defvaliases (&rest r)
`(progn ,@(loop for (sch . cl) in (plist->alist r)
collect `(defvalias ,sch ,cl))))
(defaliases (x)
string? stringp
symbol? symbolp
number? numberp
integer? integerp
pair? consp
list? listp
null? null
zero? zerop
string-length length
symbol->string symbol-name
number->string princ-to-string)
(defaliases (x y)
eq? eq
eqv? eql
equal? equal
remainder rem
modulo mod)
(defxaliases
display princ
substring subseq
;map mapcar
for-each mapc)
(defvaliases
current-input-port *standard-input*
current-output-port *standard-output*)
(defmaliases
begin progn)
(defmacro set! (var val)
`(progn (setq ,var ,val) nil))
(defmacro define-macro (name &rest rest)
(make-function-definition (first name) (rest name) rest 'defmacro))
;;; slightly different forms
(defun string-append (&rest r)
(apply 'concatenate 'string r))
(defun string->symbol (x)
(intern x :exscribe-user))
;;; Scribe-only
(defun keyword->string (x)
(if (keywordp x) (conc-string #\: x) (error "~A isn't a keyword" x)))
(defaliases (x)
file-exists? probe-file
keyword? keywordp)
(defvaliases
*scribe-format* exscribe::*exscribe-mode*
*scribe-header* exscribe::*header*
*scribe-footer* exscribe::*footer*
*scribe-background* exscribe::*background*
*scribe-foreground* exscribe::*foreground*
*scribe-tbackground* exscribe::*title-background*
*scribe-sbackground* exscribe::*section-title-background*)
;;; Syntax
(defun set-scheme-macro-characters ()
(set-dispatch-macro-character #\# #\t
#'(lambda (stream subchar arg)
(declare (ignore stream subchar arg))
*scheme-true*))
(set-dispatch-macro-character #\# #\f
#'(lambda (stream subchar arg)
(declare (ignore stream subchar arg))
*scheme-false*))
(set-dispatch-macro-character #\# #\!
#'(lambda (stream subchar arg)
(declare (ignore subchar arg))
(let ((x (read stream)))
(case x
((key) '&key)
((rest) '&rest)
(t (error "unrecognized form #!~A" x))))))
t)