This page shows the proposal for version 0.2 of sweet-expressions, and shows what they look like in many different code fractions in many Lisp-based languages: Scheme, Common Lisp, ACL2, PVS, BitC, AutoCAD Lisp, and Emacs Lisp.
Various people have had a chance to look over version 0.1 of sweet-expressions. Many people liked the idea, but had lots of useful feedback. In addition, I've learned things based on experimenting with a prototype implementation of version 0.1. So, here's a draft for version 0.2 of sweet-expressions.
I still call these “sweet-expressions”, because by adding syntactic sugar (which are essentially abbreviations), I hope to create a sweeter result. Sweet-expressions are still implemented as a change to the reader, thus, Lisp macros can work as-is.
I devised two variations of sweet-expressions, "infix default" and "infix not default", and then tried out many different code fragments to see which one seemed to work better. I expected "infix default" to be better, but after experimentation with real code, it appears that their additional complexity wasn't really worth it. I found that surprising, but that's why experiments are so valuable. The much simpler "infix non-default" alternative appears to be nearly as easy to read (in general), and its rules are much simpler.
Let's do two quick examples - we'll use sweet-expressions
to represent calculating factorials and Fibonacci numbers,
in both cases using Scheme:
| (Ugly) S-expression | Sweet-expression 0.2 |
|---|---|
(define (fibfast n)
(if (< n 2)
n
(fibup n 2 1 0)))
|
define fibfast(n) ; Typical function notation
if {n < 2} ; Indentation, infix {...}
n ; Single expr = no new list
fibup(n 2 1 0) ; Simple function calls
|
(define (fibup max count n-1 n-2)
(if (= max count)
(+ n-1 n-2)
(fibup max (+ count 1) (+ n-1 n-2) n-1)))
|
define fibup(max count n-1 n-2)
if {max = count}
{n-1 + n-2}
fibup(max {count + 1} {n-1 + n-2} n-1)
|
(define (factorial n)
(if (<= n 1)
1
(* n (factorial (- n 1)))))
|
define factorial(n)
if {n <= 1}
1
{n * factorial{n - 1}} ; f{...} => f({...})
|
Note that you can use traditional math notation for functions; fibfast(n) maps to (fibfast n). Infix processing is marked with {...}; {n <= 2} maps to (<= n 2). Indentation is significant, unless disabled by (...), [...], or {...}. This example uses variable names with embedded "-" characters; that's not a problem, because the infix operators must be surrounded by whitespace and are only used when {...} requests them.
It's actually quite common to have a function call pass one parameter, where the parameter is calculated using infix notation. Thus, there's a rule to simplify this common case (the prefix {} rule). So factorial{n - 1} maps to factorial({n - 1}) which maps to (factorial (- n 1)).
Credit where credit is due: The Fibonacci number code is loosely based on an example by Hanson Char.
Sweet-expressions are simply extensions to traditional s-expressions, and are implemented by adding capabilities to the reader (usually named "read"). A sweet-expression reader can read ordinary s-expressions as usual, but can also read other syntax that are handy abbreviations - just as 'a is a handy abbreviation of (quote a). Thus, macros and other complex Lisp capabilities work as-is, without change.
Here are the draft sweet-expressions version 0.2 rules:
Note that usual Lisp quoting rules still work, so 'a still maps to (quote a). But they work with the new capabilities, so 'f(x) maps to (quote (f x)). Same with quasiquoting and comma-lifting. A ";" still begins a comment that continues to the end of a line, and "#" still begins special processing.
Implementations are likely to call underlying implementations when they encounter "#", so don't expect that expressions beginning with "#" will continue to suport sweet-expressions. For example, in Scheme, use vector(...) instead of #(...). Many Scheme implementations have nonstandard extensions for "#", so a portable sweet-reader can't easily reimplement the functionality of a local "#". Nor can the sweet-reader easily call on the underlying implementation of "#"; because Scheme only supports a one-character peek with no unget character.
Typical implementations would have a function "sweet-read" that implements the above (with indentation meaningful), and a "sweet-read-noindent" that implements the above when indentation in not meaningful. Sweet-read-noindent has some advantages in some circumstances: (1) simple command line interaction (because you don't need to type "Enter" twice to execute), and (2) when compatibility with existing files is critical (because indentation is also ignored in traditional S-expressions).
There should probably be an optional parameter to change how unprefixed (...) is interpreted:
Other potential options could forbid allowing top-level statements to be indented (as Python does), and change prefixed [] to be interpreted the same way as prefixed (). These options could be useful in certain cases.
Here are a few comments about the rules, particularly about their implications.
Note that you have to disable indentation to use infix operators as infix operators. This doesn't seem to be a problem in practice.
With sweet-expressions, you can use the traditional Lisp read-eval-print loop as a calculator, as long as you remember to surround infix expressions with {...} and surround infix operators with whitespace. For example, "{3 + 4}" will be mapped to (+ 3 4), which when executed will produce "7". Use normal function notation for unary functions, e.g., "{-(x) / 2}" maps to "(/ (- x) 2)". Nest {...} when you need to, e.g., "{3 + {4 * 5}}" will map to "(+ 3 (* 4 5))". If you mix infix operators at the same level, you must have an "nfx" macro defined to handle precedence, and you must be careful about other macros you use.
Notice that since all the transforms happen in the reader, sweet-expressions are highly compatible with macros. Sweet-expressions simply define new abbreviations, just as 'x became (over time) a standard abbreviation for (quote x). As long as simple infix expressions are used (ones that don't create nfx), after reading the expressions all expressions are normal s-expressions, with the operator at the initial position. So macros defined by Common Lisp's macros, etc., will work as expected. Common Lisp has some hideously confusing terminology, though. Common Lisp has macros, but it also has a completely different capability: "macro characters", which introduce "reader macros" - i.e., hooks into the reader used during read time. The Common Lisp Hyperspec clearly states in its glossary on macro characters, "macro characters have nothing to do with macros", but I think they should have chosen a name that had nothing to do with macros as well. Obviously sweet-expressions can affect macro characters, since they implement a different reading syntax. This doesn't affect most real Common Lisp programs, which often avoid macro characters anyway. Common Lisp macro functions (e.g., defmacro and macrolet) work just fine with sweet-expressions.
A sweet-expression reader can read most Lisp files as-is. In the rare cases where this isn't true, use a pretty-printer on the original Lisp file - essentially any pretty-printer will fix the problems. There are two main reasons a Lisp file can't be read using a sweet-expression reader:
(define a(x)(b)cd e(f(g h)))But lines like this will be interpreted differently, because the line contains two top-level expressions (2>1):
(define x 10) (define y 20)You can fix this by moving them to separate lines with the same indentation level.
A sweet-expression pretty-printer would need to determine which functions should be used in infix expressions. I recommend that in Scheme, the sequence => should not be considered an infix operator. Otherwise, I recommend that the following default to being infix operators:
In circumstances where there is no previous code to be compatible with (and possibly no existing s-expression reader), a reader might choose to implement unprefixed (...) as unprefixed [...]. After all, [...] has nearly the same meaning. Implementing (...) as {...} is probably a bad idea; it would probably be surprising in many cases, and would interfere with the mental model that "you must use {} to use infix ordering".
This version of sweet-expressions uses unprefixed {} to mark infix expressions. This is highly compatible with other Lisps, and the "Unprefixed {}" rule would be a great backwards-compatible addition to the standard reader of Scheme and Common Lisp. Scheme specifically reserves {...} for future use (R5RS section 2.3, R6RS section 4.21). Common Lisp does not define {} (see section 2.4 of the Common Lisp Hyperspec, based on ANSI Common Lisp X3.226). BitC spec version 0.10 (June 17, 2006) section 2.4.3 also reserves {...}. Similarly, this use of [] is not a shocking incompatibility. Common Lisp and Scheme R5RS reserve [] for future use, and Scheme R6RS (section 4.3) uses [...] as an alternative symbol pair for (...), very similar to its meaning in sweet-expressions version 0.2. I'd love to see the "unprefixed {}" rule implemented as a common built-in extension in standard readers; in Common Lisp it'd be an especially trivial addition to the readtable.
In an earlier draft I generated a macro named "infix-fix" when precedence processing was required, but this requires an embedded "-". Some variants may want to "automatically" separate these, so that x*y is converted into (* x y), and typically infix macros are named "nfx" anyway (to simplify direct use). So I switched to what appears to be the most common convention, "nfx".
I'm well aware that there are some who don't like any change in Lisp notation. Some of these people seem to believe that the current Lisp notation was handed down from on high, never to be changed. Well, you don't have to use improvements like this, or even agree that they are improvements. But most developers have abandoned Lisp precisely because of Lisp's hideous, inadequate notation (and I say that as someone who has used Lisp for decades). Lisp notation was not handed down from on high, and it has changed over time. The "LISP 1.5 Programmer's Manual" (by John McCarthy, Paul W. Abrahams, Daniel J. Edwards, Timothy P. Hart and Michael I. Levin; The M.I.T. Press, 1962, second edition) describes the parent of all modern Lisp-based systems. (Note that even LISP's creator didn't think much of using S-expressions as a programming notation.) LISP 1.5 did not have a ' operator - you had to say (QUOTE X). It didn't have abbreviations for quasiquoting (`) or comma-lifting (,) either. Today, people would not accept a Lisp that didn't at least have the common abbreviation for QUOTE. Indeed, Tony Hasemar's book "A Beginner's Guide to Lisp" (1984) says in the second page of the Foreward, "do NOT buy a Lisp which does not allow the single-quote sign in place of the word QUOTE, unless you have absolutely no alternative". Lisp notation has been stagnant for a while; it's time to add modern conveniences as abbreviations.
Some objections don't seem to realize that this proposal is different. It's true that there have been many abandoned efforts of the past to improve on S-expressions, but I think all those efforts failed to realize that any replacement for S-expressions must be completely general, just as S-expressions are, and not tied to a particular semantic. Practically all past efforts, such as M-expressions and similar work, failed precisely because they weren't general enough. It's true that tooling support is necessary for any notation like this (e.g., in program editors), but that's why a standard format needs to be defined so tools can implement it (and not 1000 application-unique reader macros). There's no reason tools can't support sweet-expressions as well as they support s-expressions today.
I think most software developers will not agreeably use a Lisp-based language unless that language has better built-in support for an easy-to-read programming notation. Programs must be read by others, and if the programming notation is odious to read, then the language has a key flaw. Most developers think Lisp is odious to read, even after they've used it for a while. If the Lisps won't provide an easy-to-read notation, those developers will just use another language that's more user-friendly (even when it's less appropriate for their problem) - and that is precisely what they are doing. Here, we try to learn from the past, keep all of S-expression's benefits, but provide a better notation that others can read.
Here are the improvements of sweet-expressions over version 0.1:
I originally considered two alternatives: infix default, and infix non-default. I tried to create the best "infix default" rules that I could, did the same with "infix non-default" rules, and then tried them out on many program fragments to compare them.
There were arguments for both infix default, and infix non-default:
I had expected "infix default" to be the eventual winner; version 0.1 is "infix default", after all. But when I extracted a number of sample programs, and tried out both alternatives, the "infix non-default" versions were very similar to the "infix default" ones (both in readability and length). This suggests that all the extra rules for automatic detection of infix weren't worth it. So in this current draft, I show the "infix non-default" version of the rules as the draft rules.
There seem to be several reasons that "automatic infix" doesn't actually get USED very often in real code, now that I examine the code fragments:
I had to use "infix default" rules in version 0.1, because I only used parentheses for grouping and thus didn't have reasonable ways of marking distinctions. But once unprefixed "(...)" became "s-expressions, as-is", and I allowed the use of [...] and {...} for other purposes, other trade-offs changed.
The "infix default" rule alternative replaced the "Unprefixed {...}, aka infix" and "Prefixed {...}" rules with these rules:
Here are some rule ramifications and tweaks for the infix-default case:
In circumstances where there is no previous code to be compatible with (and possibly no existing s-expression reader), a reader might choose to implement (...) as {...}. That way, code can look very similar to "traditional" notations.
One advantage of "infix default" is that, on the command line, you can type 3 + 4 starting at the left edge and press "Enter" after entering the expression. This will be immediately transformed into (+ 3 4), and then immediately executed - producing 7, one hopes. That's a very nice side-effect, but as the programs got larger, this advantage became less obvious.
There are some hidden complications in supporting indentation with Lisp-like languages. This section talks about them in general, and then discusses "immediate completion".
Here's an example of an important issue. What should you do when you read in code that is indented at the top level like this?:
x y z
One interpretation is that there should be 3 different results: x, y, and z. But consider how this would be read. You'd read in the indentation before x, and note that as the "topmost" indentation. Then you'd read in the indentation before y, notice that it was the same as x's, and stop just before reading the "y" and return with just "x". But wait - if you did that, when you read "y" you would think that there was no indentation (the previous read consumed it), and thus z would be further indented... returning (y z). Ooops, that can't be right.
Since essentially the dawn of Lisp in the 1950s there has been a "read" function that reads an S-expression from the input and returns it. This is an extremely stable function interface, and one not easily changed in fundamental ways. In particular, no user of "read" expects it to also return some state - such as the indentation that was read the last time read was called - and certainly they aren't going to provide that information back to "read" anyway. Not only is this difficult to change for backwards-compatibility reasons, it's not clear you should - simple interfaces are a good idea, if you can get them, and adding such "indentation state" as a required parameter would certainly complicate the interface.
In theory, you could "unget" all the indentation characters, so that the next read would work correctly. But the support for this is rare; for example, Scheme doesn't even have a standard unget character function, and the Common Lisp standard only supports one character unget (not enough!).
You could store "hidden state" inside the read function. Problem is, character-reading is not the exclusive domain of the read function; many other functions read characters, and they are unlikely to look at this hidden state. These functions tend to be low-level functions and in some implementations are difficult to override. What's more, you would have to store hidden state for each possible input source, and this can become insane in the many implementations that support support ports of non-files (such as from strings). "Hidden state" could allow for all this, but the hideous complications of implementing hidden state suggests that it'd be better to spec something that does not require hidden state.
We could require that the top-level line begin at the left edge. This is not unknown; Python, a popular language using indentation, requires that the top level begin at the left edge (and raises an error if an attempt is made otherwise). This completely eliminates the need for hidden state - top level statements only start at the left edge, so there's nothing to remember.
For backwards-compatibility, we can make a slight concession: allow the top level to be indented, but completely ignore its indentation. It would be wise for new code to begin at the left edge, because otherwise the code could be misleading (this would be easy to check). But sometimes older files are indented and begin immediately with "("; in such cases, as long as there are blank lines between the top-level statements, they could be left as-is. The example above then becomes misleading; it will result in (x y z), because the indentation of "x" is ignored, making y and z indented under x. To be fair, most programs aren't formatted this way; as long as there are blank lines between top-level statements, the indentation of the top line is irrelevant (and even when they're not separated, they'll still often be interpreted correctly). Where backwards-compatibility is less important than countering the risk of misleading indentation, we could optionally forbid indented top-level statements (as Python does).
The demo implementation of I-expressions (as defined in SRFI-49) actually ignores indentation of a top-level statement. However, nowhere the does spec clearly document this, nor explain why this occurs. So, it's documented here.
Originally in sweet-expressions there was this additional rule:
However, it turns out that there are awkward interactions between this and the indentation rule. The basic problem is that, unless the reader maintains per-port state information, when it's called again it has no way to know what the "current" top-level indentation is. This is because the initial whitespace of a line may have already been consumed by a previous call to read. If the first line of a previous expression began 3 spaces in, you'll need to examine those 3 spaces and then the next character before you can determine if the current line is a child of the first expression, or the start of a new one. And once read, you can't easily return those characters in most Lisp systems. Scheme doesn't have an unget character function at all, and Common Lisp's is limited to only one character, and "peek" will only give one-character lookahead... so simple solutions to "undo" this reading don't work.
As a result, you often have no way to know if you're really at the "left edge" unless hidden per-port state information is hidden away by read. Maintaining per-port state information is a serious problem for many implementations (especially since the input may be from a calculated string!), and it's certain to interfere with other reading functions. As a result, it's better to not spec something that would inadvertantly require maintaining this hidden state.
Indeed, this has ramifications for any indentation processing. Basically, you should start topmost expressions at the leftmost edge, or include a blank line between expressions, because of this.
Here are a number of examples, which show the impact of the rules, and led me to believe that "infix non-default" was actually the better option. Thus, "infix non-default" examples use the rules for draft version 0.2, above; the "infix default" examples show the impact of that alternative. Since I am only using code snippets, as examples for research and commentary, I claim that these snippets are "fair use" under copyright law. I do try to acknowledge my sources (when I know them).
Here's the factorial example; this is the example I tended to use when describing sweet-expressions version 0.1.
(defun factorial (n)
(if (<= n 1)
1
(* n (factorial (- n 1)))))
defun factorial (n)
if (n <= 1)
1
n * factorial(n - 1)
defun factorial (n)
if {n <= 1}
1
n * factorial(n - 1)
defun factorial (n)
if {n <= 1}
1
{n * factorial{n - 1}}
This is nearly a worst-case for infix non-default, which is why initially I resisted it. But in fact, this is a worst case. And it really isn't that bad - the f{...} notation makes it tolerable. There isn't even a traditional function call here (something that dominates most examples), which is a tip-off that this example is extreme. Even in this extreme case, there's only one additional time where additional characters must be added to permit infix, and though some thinking is required to notate the passing of "n - 1", it's not too bad.
Here's the factorial example, but in Scheme instead. Scheme uses define, not defun, with a slightly different semantic.
(define (factorial n)
(if (<= n 1)
1
(* n (factorial (- n 1)))))
define factorial(n)
if (n <= 1)
1
n * factorial(n - 1)
define factorial(n)
if {n <= 1}
1
n * factorial(n - 1)
define factorial(n)
if {n <= 1}
1
{n * factorial{n - 1}}
Same comments as with the Common Lisp version.
Here's a Scheme example from Wikipedia - specifically the article "Scheme (programming language)". This example adds an arbitrary list of numbers, and if a non-numeric value is found in the list the procedure is aborted immediately and the constant value #f (false) is returned. This is achieved by capturing the current continuation in the variable exit and using it as an "escape procedure".
(define (add-if-all-numbers lst)
(call/cc
(lambda (exit)
(let loop ((lst lst) (sum 0))
(if (null? lst) sum
(if (not (number? (car lst))) (exit #f)
(+ (car lst) (loop (cdr lst)))))))))
define add-if-all-numbers(lst)
call/cc
lambda (exit)
let loop ((lst lst) (sum 0))
if null?(lst)
sum
if not(number?(car(lst)))
exit(#f)
car(lst) + loop(cdr(lst))
define add-if-all-numbers(lst)
call/cc
lambda (exit)
let loop ((lst lst) (sum 0))
if null?(lst)
sum
if not(number?(car(lst)))
exit(#f)
car(lst) + loop(cdr(lst))
Infix non-default only differs from the previous example in the last line, where we have to explicitly say "use + as infix".
define add-if-all-numbers(lst)
call/cc
lambda (exit)
let loop ((lst lst) (sum 0))
if null?(lst)
sum
if not(number?(car(lst)))
exit(#f)
{car(lst) + loop(cdr(lst))}
Matrix multiply example from http://www.scheme.com/tspl2d/examples.html mat-mat-mul multiplies one matrix by another, after verifying that the first matrix has as many columns as the second matrix has rows. I thought a matrix multiply function would show off infix capabilities.
(define mat-mat-mul
(lambda (m1 m2)
(let* ((nr1 (matrix-rows m1))
(nr2 (matrix-rows m2))
(nc2 (matrix-columns m2))
(r (make-matrix nr1 nc2)))
(if (not (= (matrix-columns m1) nr2))
(match-error m1 m2))
(do ((i 0 (+ i 1)))
((= i nr1) r)
(do ((j 0 (+ j 1)))
((= j nc2))
(do ((k 0 (+ k 1))
(a 0
(+ a
(* (matrix-ref m1 i k)
(matrix-ref m2 k j)))))
((= k nr2)
(matrix-set! r i j a))))))))
define mat-mat-mul
lambda (m1 m2)
let* ( (nr1 matrix-rows(m1))
(nr2 matrix-rows(m2))
(nc2 matrix-columns(m2))
(r make-matrix(nr1 nc2)))
if not(matrix-columns(m1) = nr2) ; f(infix) handled automatically.
match-error(m1 m2)
do ((i 0 (i + 1)))
((i = nr1) r)
do ((j 0 (j + 1)))
((j = nc2))
do ((k 0 (k + 1))
(a 0 (a + (matrix-ref(m1 i k) * matrix-ref(m2 k j)))))
((k = nr2) matrix-set!(r i j a))
Or, if you use groups:
define mat-mat-mul
lambda (m1 m2)
let*
group
nr1 matrix-rows(m1)
nr2 matrix-rows(m2)
nc2 matrix-columns(m2)
r make-matrix(nr1 nc2)
if not(matrix-columns(m1) = nr2) ; f(infix) handled automatically.
match-error(m1 m2)
do
group
i 0 (i + 1)
group
(i = nr1) r
do
group
j 0 (j + 1)
group
j = nc2
do
group
k 0 (k + 1)
a 0 (a + (matrix-ref(m1 i k) * matrix-ref(m2 k j)))
group
k = nr2
matrix-set!(r i j a)
define mat-mat-mul
lambda [m1 m2]
let* { {nr1 matrix-rows(m1)}
{nr2 matrix-rows(m2)}
{nc2 matrix-columns(m2)}
{r make-matrix(nr1 nc2)}}
if not(matrix-columns(m1) = nr2)
match-error(m1 m2)
do {{i 0 {i + 1}}}
{{i = nr1} r}
do {{j 0 {j + 1}}}
{{j = nc2}}
do {{k 0 {k + 1}}
{a 0 {a + {matrix-ref(m1 i k) * matrix-ref(m2 k j)}}}}
{{k = nr2} matrix-set!(r i j a)}
Or, if you use groups:
define mat-mat-mul
lambda [m1 m2]
let*
group
nr1 matrix-rows(m1)
nr2 matrix-rows(m2)
nc2 matrix-columns(m2)
r make-matrix(nr1 nc2)
if not(matrix-columns(m1) = nr2) ; f(infix) handled automatically.
match-error(m1 m2)
do
group
i 0 {i + 1}
group
{i = nr1} r
do
group
j 0 {j + 1}
group
j = nc2
do
group
k 0 {k + 1}
a 0 {a + {matrix-ref(m1 i k) * matrix-ref(m2 k j)}}
group
k = nr2
matrix-set!(r i j a)
define mat-mat-mul
lambda [m1 m2]
let* [ [nr1 matrix-rows(m1)]
[nr2 matrix-rows(m2)]
[nc2 matrix-columns(m2)]
[r make-matrix(nr1 nc2)]]
if not{matrix-columns(m1) = nr2} ; f{infix}
match-error(m1 m2)
do [[i 0 {i + 1}]]
[{i = nr1} r]
do [[j 0 {j + 1}]]
[{j = nc2}]
do [[k 0 {k + 1}]
[a 0 {a + {matrix-ref(m1 i k) * matrix-ref(m2 k j)}}]]
[{k = nr2} matrix-set!(r i j a)]
Or, if you use groups:
define mat-mat-mul
lambda [m1 m2]
let*
group
nr1 matrix-rows(m1)
nr2 matrix-rows(m2)
nc2 matrix-columns(m2)
r make-matrix(nr1 nc2)
if not{matrix-columns(m1) = nr2} ; f{infix} = f({infix}).
match-error(m1 m2)
do
group
i 0 {i + 1}
group
{i = nr1} r
do
group
j 0 {j + 1}
group
{j = nc2}
do
group
k 0 {k + 1}
a 0 {a + {matrix-ref(m1 i k) * matrix-ref(m2 k j)}}
group
{k = nr2}
matrix-set!(r i j a)
Note that in this "infix non-default" example using groups, we have a few cases where we must explicitly state that some operations use infix notation (e.g., {j = nc2} and {k = nr2}), while that was automatically determined by "infix default". On the other hand, in many cases it turns out that it's convenient to group infix operators on a line with {...} anyway, so the automatic detection is used less than you might expect. This is a particularly useful example for discussing the pluses and minuses of making infix default - basically, the automatic rules give fewer benefits than I expected.
(in-package "USER")
;; Define a default size for the queue.
(defconstant default-queue-size 100 "Default size of a queue")
;;; The following structure encapsulates a queue. It contains a
;;; simple vector to hold the elements and a pair of pointers to
;;; index into the vector. One is a "put pointer" that indicates
;;; where the next element is stored into the queue. The other is
;;; a "get pointer" that indicates the place from which the next
;;; element is retrieved.
;;; When put-ptr = get-ptr, the queue is empty.
;;; When put-ptr + 1 = get-ptr, the queue is full.
(defstruct (queue (:constructor create-queue)
(:print-function queue-print-function))
(elements #() :type simple-vector) ; simple vector of elements
(put-ptr 0 :type fixnum) ; next place to put an element
(get-ptr 0 :type fixnum) ; next place to take an element
)
(defun queue-next (queue ptr)
"Increment a queue pointer by 1 and wrap around if needed."
(let ((length (length (queue-elements queue)))
(try (the fixnum (1+ ptr))))
(if (= try length) 0 try)))
(defun queue-get (queue &optional (default nil))
(check-type queue queue)
(let ((get (queue-get-ptr queue)) (put (queue-put-ptr queue)))
(if (= get put) ;; Queue is empty.
default
(prog1 (svref (queue-elements queue) get)
(setf (queue-get-ptr queue) (queue-next queue get))))))
;; Define a function to put an element into the queue. If the
;; queue is already full, QUEUE-PUT returns NIL. If the queue
;; isn't full, QUEUE-PUT stores the element and returns T.
(defun queue-put (queue element)
"Store ELEMENT in the QUEUE and return T on success or NIL on failure."
(check-type queue queue)
(let* ((get (queue-get-ptr queue))
(put (queue-put-ptr queue))
(next (queue-next queue put)))
(unless (= get next) ;; store element
(setf (svref (queue-elements queue) put) element)
(setf (queue-put-ptr queue) next) ; update put-ptr
t))) ; indicate success
in-package("USER")
;; Define a default size for the queue.
defconstant(default-queue-size 100 "Default size of a queue")
;;; The following structure encapsulates a queue. It contains a
;;; simple vector to hold the elements and a pair of pointers to
;;; index into the vector. One is a "put pointer" that indicates
;;; where the next element is stored into the queue. The other is
;;; a "get pointer" that indicates the place from which the next
;;; element is retrieved.
;;; When put-ptr = get-ptr, the queue is empty.
;;; When put-ptr + 1 = get-ptr, the queue is full.
defstruct queue(:constructor(create-queue)
:print-function(queue-print-function))
elements(#() :type simple-vector) ; simple vector of elements
put-ptr(0 :type fixnum) ; next place to put an element
get-ptr(0 :type fixnum) ; next place to take an element
defun queue-next [queue ptr]
"Increment a queue pointer by 1 and wrap around if needed."
let
group
length length(queue-elements(queue))
try the(fixnum (1+ ptr))
if {try = length} 0 try
defun queue-get [queue &optional [default nil]]
check-type(queue queue)
let
group
get queue-get-ptr(queue)
put queue-put-ptr(queue)
if {get = put} ;; Queue is empty.
default
prog1
svref queue-elements(queue) get
setf queue-get-ptr(queue) queue-next(queue get)
;; Define a function to put an element into the queue. If the
;; queue is already full, QUEUE-PUT returns NIL. If the queue
;; isn't full, QUEUE-PUT stores the element and returns T.
defun queue-put [queue element]
"Store ELEMENT in the QUEUE and return T on success or NIL on failure."
check-type(queue queue)
let*
group
get queue-get-ptr(queue)
put queue-put-ptr(queue)
next queue-next(queue put)
unless {get = next} ;; store element
setf svref(queue-elements(queue) put) element
setf queue-put-ptr(queue) next ; update put-ptr
t ; indicate success
This turns out to be identical to the previous case!
in-package("USER")
;; Define a default size for the queue.
defconstant(default-queue-size 100 "Default size of a queue")
;;; The following structure encapsulates a queue. It contains a
;;; simple vector to hold the elements and a pair of pointers to
;;; index into the vector. One is a "put pointer" that indicates
;;; where the next element is stored into the queue. The other is
;;; a "get pointer" that indicates the place from which the next
;;; element is retrieved.
;;; When put-ptr = get-ptr, the queue is empty.
;;; When put-ptr + 1 = get-ptr, the queue is full.
defstruct queue(:constructor(create-queue)
:print-function(queue-print-function))
elements(#() :type simple-vector) ; simple vector of elements
put-ptr(0 :type fixnum) ; next place to put an element
get-ptr(0 :type fixnum) ; next place to take an element
defun queue-next [queue ptr]
"Increment a queue pointer by 1 and wrap around if needed."
let
group
length length(queue-elements(queue))
try the(fixnum (1+ ptr))
if {try = length} 0 try
defun queue-get [queue &optional [default nil]]
check-type(queue queue)
let
group
get queue-get-ptr(queue)
put queue-put-ptr(queue)
if {get = put} ;; Queue is empty.
default
prog1
svref queue-elements(queue) get
setf queue-get-ptr(queue) queue-next(queue get)
;; Define a function to put an element into the queue. If the
;; queue is already full, QUEUE-PUT returns NIL. If the queue
;; isn't full, QUEUE-PUT stores the element and returns T.
defun queue-put [queue element]
"Store ELEMENT in the QUEUE and return T on success or NIL on failure."
check-type(queue queue)
let*
group
get queue-get-ptr(queue)
put queue-put-ptr(queue)
next queue-next(queue put)
unless {get = next} ;; store element
setf svref(queue-elements(queue) put) element
setf queue-put-ptr(queue) next ; update put-ptr
t ; indicate success
This is an interesting result - here's a whole sequence of code, including some use of infix "=", where the "infix default" and the "infix non-default" case is exactly the same. The reason is that infix is only used in this code as a condition for "if", but it's pretty common to format the condition on the same line as the word "if". As a result, {...} ends up being used in either case.
(defmacro Square-Sum2 (X Y)
(let ((First (gensym "FIRST-"))
(Second (gensym "SECOND-"))
(Sum (gensym "SUM-")))
'(let* ((,First ,X)
(,Second ,Y)
(,Sum (+ ,First ,Second)))
(* ,Sum ,Sum))
))
defmacro Square-Sum2 (X Y)
let
group
First gensym("FIRST-")
Second gensym("SECOND-")
Sum gensym("SUM-")
'let*
group
,First ,X
,Second ,Y
,Sum {,First + ,Second}
,Sum * ,Sum
defmacro Square-Sum2 (X Y)
let
group
First gensym("FIRST-")
Second gensym("SECOND-")
Sum gensym("SUM-")
'let*
group
,First ,X
,Second ,Y
,Sum {,First + ,Second}
{,Sum * ,Sum}
Again, the last line is different from the infix default case.. but only the last line.
I'll just show the version using "group"; it takes more lines, but I like the look of it.
(defun fact (n)
(labels ((f (n acc)
(if (<= n 1) acc (f (- n 1) (* n acc)))))
(f n 1)))
defun fact [n]
labels
group
f [n acc]
if {n <= 1} acc f({n - 1} {n * acc})
f n 1
defun fact [n]
labels
group
f [n acc]
if {n <= 1} acc f({n - 1} {n * acc})
f n 1
Again, having infix as a non-default doesn't really matter, the code ends up the same.
Here's a tiny extract of some Decision tree learning code that accompanies the textbook "Machine Learning," Tom M. Mitchell, McGraw Hill, 1997. "Copyright 1998 Tom M. Mitchell. This code may be freely distributed and used for any non-commericial purpose, as long as this copyright notice is retained. The author assumes absolutely no responsibility for any harm caused by bugs in the code."
(defun print.tree (tree &optional (depth 0))
(tab depth)
(format t "~A~%" (first tree))
(loop for subtree in (cdr tree) do
(tab (+ depth 1))
(format t "= ~A" (first subtree))
(if (atom (second subtree))
(format t " => ~A~%" (second subtree))
(progn (terpri)(print.tree (second subtree) (+ depth 5))))))
(defun tab (n)
(loop for i from 1 to n do (format t " ")))
(defun classify (instance tree)
(let (val branch)
(if (atom tree) (return-from classify tree))
(setq val (get.value (first tree) instance))
(setq branch (second (assoc val (cdr tree))))
(classify instance branch)))
(defun entropy (p)
(+ (* -1.0 p (log p 2))
(* -1.0 (- 1 p) (log (- 1 p) 2))))
defun print.tree [tree &optional [depth 0]]
tab depth
format t "~A~%" first(tree)
loop for subtree in cdr(tree) do
tab {depth + 1}
format t "= ~A" [first subtree]
if atom(second(subtree))
format t " => ~A~%" second(subtree)
progn
terpri()
print.tree(second(subtree) {depth + 5})
defun tab [n]
loop for i from 1 to n do format(t " ")
defun classify [instance tree]
let
val branch
if atom(tree) return-from(classify tree)
setq val get.value(first(tree) instance)
setq branch second(assoc(val cdr(tree)))
classify instance branch
defun entropy [p]
{-1.0 * p * log(p 2)} + {-1.0 * {1 - p} * log({1 - p} 2)}
defun print.tree [tree &optional [depth 0]]
tab depth
format t "~A~%" first(tree)
loop for subtree in cdr(tree) do
tab {depth + 1}
format t "= ~A" [first subtree]
if atom(second(subtree))
format t " => ~A~%" second(subtree)
progn
terpri()
print.tree(second(subtree) {depth + 5})
defun tab [n]
loop for i from 1 to n do format(t " ")
defun classify [instance tree]
let
val branch
if atom(tree) return-from(classify tree)
setq val get.value(first(tree) instance)
setq branch second(assoc(val cdr(tree)))
classify instance branch
defun entropy [p]
{{-1.0 * p * log(p 2)} +
{-1.0 * {1 - p} * log({1 - p} 2)}}
Here, infix default does produce fewer {...} than infix non-default inside the "entropy" function (which has lots of infix operators). But it is less than you might expect, because as the expression gets long, you tend to want to group things anyway.
We can get fewer {...} in the default infix version by using prefix "+", like this:
defun entropy [p]
+
-1.0 * p * log(p 2)
-1.0 * {1 - p} * log({1 - p} 2)
Question is, is that enough of an improvement compared to the
infix non-default version using this format?:
defun entropy [p]
+
{-1.0 * p * log(p 2)}
{-1.0 * {1 - p} * log({1 - p} 2)}
; Original, using "cond"
(define (fibfast n)
(cond ((< n 2) n)
(else (fibup n 2 1 0))))
(define (fibup max count n-1 n-2)
(cond ((= max count) (+ n-1 n-2))
(else (fibup max (+ count 1) (+ n-1 n-2) n-1))))
; Using "if"
(define (fibfast n)
(if (< n 2) n
(fibup n 2 1 0)))
(define (fibup max count n-1 n-2)
(if (= max count) (+ n-1 n-2)
(fibup max (+ count 1) (+ n-1 n-2) n-1)))
; Original, using "cond"
define fibfast(n)
cond
{n < 2} n
else fibup(n 2 1 0)
define fibup(max count n-1 n-2)
cond
{max = count} {n-1 + n-2}
else fibup(max {count + 1} {n-1 + n-2} n-1)
; Using "if"
define fibfast(n)
if {n < 2}
n
fibup(n 2 1 0)
define fibup(max count n-1 n-2)
if {max = count}
n-1 + n-2
fibup(max {count + 1} {n-1 + n-2} n-1)
; Original, using "cond"
define fibfast(n)
cond
{n < 2} n
else fibup(n 2 1 0)
define fibup(max count n-1 n-2)
cond
{max = count} {n-1 + n-2}
else fibup(max {count + 1} {n-1 + n-2} n-1)
; Using "if"
define fibfast(n)
if {n < 2}
n
fibup(n 2 1 0)
define fibup(max count n-1 n-2)
if {max = count}
{n-1 + n-2}
fibup(max {count + 1} {n-1 + n-2} n-1)
Again, the infix and non-infix are nearly identical; only one line (the second from the last) is different (to make "+" work as infix).
ACL2 is powerful, but it's often avoided specifically because many people find its Lisp notation to be user-hostile. For example, David Duffy's book "Principles of Automated Theorem Proving" (1991) devotes a whole chapter to the Boyer-Moore Theorem Prover (ACL2 is the latest version of this series). The chapter specifically states that one of ACL2's key problems is the "difficulty of reading the LISP-like prefix notation" and that "To improve readability here, this notation will often be abused to include the use of prefix and infix symbols" (page 176-177). For the rest of the chapter, the author modifies ACL2 input and output, instead of showing actual input, so that readers could understand what is going on. In contrast, in a different chapter the author did not modify Prolog's notation, because Prolog's notation is much easier to read for those trained in traditional mathematics or other programming languages.
(thm (implies (and (not (endp x))
(endp (cdr x))
(integerp n)
(<= 0 n)
(rationalp u))
(< (* (len x) u) (+ u n 3))))
There are different ways to format this. One way emphasizes indentation:
thm
implies
and not(endp(x))
endp(cdr(x))
integerp(n)
0 <= n
rationalp(u)
{len(x) * u} < {u + n + 3}
You can exploit the fact that infix is by default, and use the /.../ special rule for infix operators that are not punctuation. Here's one way:
thm {
{not(endp(x)) and endp(cdr(x)) and
integerp(n) and {0 <= n} and rationalp(u)}
/implies/
{ {len(x) * u} < {u + n + 3} } }
Here's another way (note that here, we don't have to disable indentation just to use "implies" as an infix operator):
thm
not(endp(x)) and endp(cdr(x)) and integerp(n) and {0 <= n} and rationalp(u)
/implies/
{len(x) * u} < {u + n + 3}
There are different ways to format this. One way emphasizes indentation:
thm
implies
and not(endp(x))
endp(cdr(x))
integerp(n)
{0 <= n}
rationalp(u)
{ {len(x) * u} < {u + n + 3} }
Another way emphasizes infix:
thm {
{not(endp(x)) and endp(cdr(x)) and integerp(n) and {0 <= n}
and rationalp(u)}
implies
{ {len(x) * u} < {u + n + 3} } }
The indented version shows a little more difference with the infix default vs. non-default. In addition, here there is a way to use "infix default" that the infix non-default can't really do (infix default can have an infix operator marked with /.../ without disabling indentation). On the other hand, it's odd enough that it's not an expecially convincing argument.
This is a case where if the "immediate completion" rules were in force, you would need to beware of a single-term starting on the left-hand-side.
BitC is, according to its creators, "a systems programming language that combines the ``low level'' nature of C with the semantic rigor of Scheme or ML. BitC was designed by careful selection and exclusion of language features in order to support proving properties (up to and including total correctness) of critical systems programs." See the BitC specification for more information. BitC is in development, the following example is from the version 0.10+ (June 17, 2006) specification. The BitC reader is actually not quite a standard s-expression reader; in particular, it treats ":" specially. Hopefully, a sweet-expression reader will be even better.
Here's the original BitC. I've cheated slightly with the definition of ">", pulling it out of context. One complication: BitC's reader is not a "pure" s-expression reader; it handles ":" specially.
(deftypeclass
(forall ((Eql 'a)) (Ord 'a))
< : (fn ('a 'a) 'a))
(define (> x y)
(not (or (< x y) (== x y))))
(define (fact x:int32)
(cond ((< x 0) (- (fact (- x))))
((= x 0) 1)
(otherwise
(* x (fact (- x 1))))))
deftypeclass
forall (Eql('a)) Ord('a)
< : fn(('a 'a) 'a)
define >(x y)
not({x < y} or {x == y})
I've given up on infix default, so I haven't tried to handle "fact". This is just as well; ":" appears to sometimes require infix processing, and sometimes it doesn't.
deftypeclass
forall (Eql('a)) Ord('a)
< : fn(('a 'a) 'a)
define >(x y)
not{ {x < y} or {x == y} }
define fact{x : int32}
cond
{x < 0} -(fact(-(x)))
{x = 0} 1
otherwise {x * fact{x - 1}}
The infix and non-infix default are slightly different if you follow typical (though that isn't necessary; the non-infix default one would also work). Basically, "not" can be an ordinary function call, since the "or" inside the "not" is automatically detected as being an infix operator. It could be argued that the infix version is slightly nicer to read here. However, since f{...} is an accepted abbreviation for f({...}), the non-infix default version is not all that bad.
Since "deftypeclass" is on a line by itself, if the "immediate completion" rules were in force it needs to not begin the line (press at least one space). Otherwise, it would be executed immediately. But the "immediate completion" rules have been removed, so this is not an issue.
The ":" in many BitC contexts as a "type assertion" operator. The BitC reader handles ":" very specially. Instead of handling ":" specially, we can treat ":" as just another infix operator taking two parameters: the object and its type. Which means that instead of a special-case reader, we can use a general-case reader.
Here's a definition for non-default strategy called "stew". I can't remember where I got this; I think I got this definition from elsewhere and then tweaked it.
Oh, one warning: both "if" and "then" are commands in this notation; an "if" does not have a "then" keyword. I mention this, because in this example it can look confusing.
(defstep stew (&optional lazy-match (if-match t) (defs !) rewrites theories
exclude (updates? t) &rest lemmas)
(then
(if lemmas
(let ((lemmata (if (listp lemmas) lemmas (list lemmas)))
(x `(then ,@(loop for lemma in lemmata append `((skosimp*)(use ,le
mma))))))
x)
(skip))
(if lazy-match
(then (grind$ :if-match nil :defs defs :rewrites rewrites
:theories theories :exclude exclude :updates? updates?)
(reduce$ :if-match if-match :updates? updates?))
(grind$ :if-match if-match :defs defs :rewrites rewrites
:theories theories :exclude exclude :updates? updates?))
)
"Does a combination of (lemma) and (grind)."
"~%Grinding away with the supplied lemmas,")
defstep stew (&optional lazy-match (if-match t) (defs !) rewrites theories
exclude (updates? t) &rest lemmas)
then
if lemmas
let
group
lemmata
if listp(lemmas) lemmas list(lemmas)
x `[then ,@[loop for lemma in lemmata append
`[skosimp*() use(,lemma)]]]
x
skip()
if lazy-match
then
grind$(:if-match nil :defs defs :rewrites rewrites
:theories theories :exclude exclude :updates? updates?)
reduce$ :if-match if-match :updates? updates?
grind$(:if-match if-match :defs defs :rewrites rewrites
:theories theories :exclude exclude :updates? updates?)
"Does a combination of (lemma) and (grind)."
"~%Grinding away with the supplied lemmas,"
defstep stew (&optional lazy-match (if-match t) (defs !) rewrites theories
exclude (updates? t) &rest lemmas)
then
if lemmas
let
group
lemmata
if listp(lemmas) lemmas list(lemmas)
x `[then ,@[loop for lemma in lemmata append
`[skosimp*() use(,lemma)]]]
x
skip()
if lazy-match
then
grind$(:if-match nil :defs defs :rewrites rewrites
:theories theories :exclude exclude :updates? updates?)
reduce$ :if-match if-match :updates? updates?
grind$(:if-match if-match :defs defs :rewrites rewrites
:theories theories :exclude exclude :updates? updates?)
"Does a combination of (lemma) and (grind)."
"~%Grinding away with the supplied lemmas,"
No difference between the infix default and non-default.
Here's an example of emacs Lisp, this time from a page on emacs Lisp by Xah Lee. (Note: Emacs Lisp's variable scoping is dynamic, a fossil from very old versions of Lisp. Scheme and Common Lisp's variable scope is not.)
(defun replace-html-chars (start end)
"Replace '<' to '<' and other chars in HTML.
This works on the current selection."
(interactive "r")
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
(while (search-forward "&" nil t) (replace-match "&" nil t))
(goto-char (point-min))
(while (search-forward "<" nil t) (replace-match "<" nil t))
(goto-char (point-min))
(while (search-forward ">" nil t) (replace-match ">" nil t))
)
)
defun replace-html-chars (start end)
"Replace '<' to '<' and other chars in HTML.
This works on the current selection."
interactive("r")
save-restriction
narrow-to-region start end
goto-char point-min()
while search-forward("&" nil t) replace-match("&" nil t)
goto-char point-min()
while search-forward("<" nil t) replace-match("<" nil t)
goto-char point-min()
while search-forward(">" nil t) replace-match(">" nil t)
defun replace-html-chars (start end)
"Replace '<' to '<' and other chars in HTML.
This works on the current selection."
interactive("r")
save-restriction
narrow-to-region start end
goto-char point-min()
while search-forward("&" nil t) replace-match("&" nil t)
goto-char point-min()
while search-forward("<" nil t) replace-match("<" nil t)
goto-char point-min()
while search-forward(">" nil t) replace-match(">" nil t)
The infix default and non-infix default versions are identical in this case.
AutoCAD includes its own Lisp languages, Autolisp. From the Free Autolisp routines I arbitrarily chose the "Find" program, whose purpose is to "Find text in [a] drawing field".
Here's the original code, as provided:
(DEFUN C:FIND ( )
(SETQ SA(GETSTRING T "\nEnter string for search parameter: "))
(SETQ AR(SSGET "X" (LIST(CONS 1 SA))))
(IF(= AR NIL)(ALERT "This string does not exist"))
(SETQ SB(SSLENGTH AR))
(C:CONT)
)
(DEFUN C:CONT ()
(SETQ SB(- SB 1))
(SETQ SC(SSNAME AR SB))
(SETQ SE(ENTGET SC))
(SETQ SJ(CDR(ASSOC 1 SE)))
(IF(= SJ SA)(PROGN
(SETQ H(CDR(ASSOC 10 SE)))
(SETQ X1(LIST(- (CAR H) 50)(- (CADR H)50)))
(SETQ X2(LIST(+ 50(CAR H))(+ 50 (CADR H))))
(COMMAND "ZOOM" "W" X1 X2 ))(C:CONT)
)
(IF(= SB 0)(ALERT "END OF SELECTIONS"))
(SETQ A(+ SB 1))
(SETQ A(RTOS A 2 0))
(SETQ A(STRCAT "\nThere are <" A "> selections Enter CONT to advance to next"))
(IF(= SB 0)(EXIT))
(PRINC A)
(PRINC)
)
That's so hideously formatted that we can create a much more readable version without needing a new reader. We'll stick to uppercase, so that we can see that the improvement is unrelated to using uppercase or lowercase:
(DEFUN C:FIND ()
(SETQ SA (GETSTRING T "\nEnter string for search parameter: "))
(SETQ AR (SSGET "X" (LIST (CONS 1 SA))))
(IF (= AR NIL) (ALERT "This string does not exist"))
(SETQ SB (SSLENGTH AR))
(C:CONT))
(DEFUN C:CONT ()
(SETQ SB (- SB 1))
(SETQ SC (SSNAME AR SB))
(SETQ SE (ENTGET SC))
(SETQ SJ (CDR (ASSOC 1 SE)))
(IF (= SJ SA)
(PROGN
(SETQ H (CDR (ASSOC 10 SE)))
(SETQ X1 (LIST (- (CAR H) 50) (- (CADR H) 50)))
(SETQ X2 (LIST (+ 50 (CAR H)) (+ 50 (CADR H))))
(COMMAND "ZOOM" "W" X1 X2))
(C:CONT))
(IF (= SB 0) (ALERT "END OF SELECTIONS"))
(SETQ A (+ SB 1))
(SETQ A (RTOS A 2 0))
(SETQ A
(STRCAT "\nThere are <" A "> selections Enter CONT to advance to next"))
(IF (= SB 0) (EXIT))
(PRINC A)
(PRINC))
Okay, now we'll use sweet-expressions 0.2, with infix non-default. Again, we'll keep it in all uppercase, so that you won't be misled by a difference in case. Notice that even with all-upper-case, it still is easier to follow than the original:
DEFUN C:FIND ()
SETQ SA GETSTRING(T "\nEnter string for search parameter: ")
SETQ AR SSGET("X" LIST(CONS(1 SA)))
IF {AR = NIL} ALERT("This string does not exist")
SETQ SB SSLENGTH(AR)
C:CONT()
DEFUN C:CONT ()
SETQ SB {SB - 1}
SETQ SC SSNAME(AR SB)
SETQ SE ENTGET(SC)
SETQ SJ CDR(ASSOC(1 SE))
IF {SJ = SA}
PROGN
SETQ H CDR(ASSOC(10 SE))
SETQ X1 LIST({CAR(H) - 50} {CADR(H) - 50})
SETQ X2 LIST({50 + CAR(H)} {50 + CADR(H)})
COMMAND("ZOOM" "W" X1 X2)
C:CONT()
IF {SB = 0} ALERT("END OF SELECTIONS")
SETQ A {SB + 1}
SETQ A RTOS(A 2 0)
SETQ A
STRCAT "\nThere are <" A "> selections Enter CONT to advance to next"
IF {SB = 0} EXIT()
PRINC A
PRINC()
Today most people use lowercase, so let's see how this looks with that one change:
defun c:find ()
setq sa getstring(t "\nEnter string for search parameter: ")
setq ar ssget("x" list(cons(1 sa)))
if {ar = nil} alert("This string does not exist")
setq sb sslength(ar)
c:cont()
defun c:cont ()
setq sb {sb - 1}
setq sc ssname(ar sb)
setq se entget(sc)
setq sj cdr(assoc(1 se))
if {sj = sa}
progn
setq h cdr(assoc(10 se))
setq x1 list({car(h) - 50} {cadr(h) - 50})
setq x2 list({50 + car(h)} {50 + cadr(h)})
command("ZOOM" "W" x1 x2)
c:cont()
if {sb = 0} alert("END OF SELECTIONS")
setq a {sb + 1}
setq a rtos(a 2 0)
setq a
strcat "\nThere are <" a "> selections Enter CONT to advance to next"
if {sb = 0} exit()
princ a
princ()
"Teach Yourself Scheme in Fixnum days" includes a way to solve the Kalotan puzzle solution using Scheme. It depends on the "amb" function, described further in the book. It has a large number of "ands" and "xors" which can be expressed using infix, which is interesting and useful for trying out variations.
Here's the original Lisp:
(define solve-kalotan-puzzle
(lambda ()
(let ((parent1 (amb 'm 'f))
(parent2 (amb 'm 'f))
(kibi (amb 'm 'f))
(kibi-self-desc (amb 'm 'f))
(kibi-lied? (amb #t #f)))
(assert
(distinct? (list parent1 parent2)))
(assert
(if (eqv? kibi 'm)
(not kibi-lied?)))
(assert
(if kibi-lied?
(xor
(and (eqv? kibi-self-desc 'm)
(eqv? kibi 'f))
(and (eqv? kibi-self-desc 'f)
(eqv? kibi 'm)))))
(assert
(if (not kibi-lied?)
(xor
(and (eqv? kibi-self-desc 'm)
(eqv? kibi 'm))
(and (eqv? kibi-self-desc 'f)
(eqv? kibi 'f)))))
(assert
(if (eqv? parent1 'm)
(and
(eqv? kibi-self-desc 'm)
(xor
(and (eqv? kibi 'f)
(eqv? kibi-lied? #f))
(and (eqv? kibi 'm)
(eqv? kibi-lied? #t))))))
(assert
(if (eqv? parent1 'f)
(and
(eqv? kibi 'f)
(eqv? kibi-lied? #t))))
(list parent1 parent2 kibi))))
(solve-kalotan-puzzle)
Here's one way to convert this to infix non-default, emphasizing the use of indentation and function calls using prefixed():
define solve-kalotan-puzzle
lambda []
let [[parent1 amb('m 'f)]
[parent2 amb('m 'f)]
[kibi amb('m 'f)]
[kibi-self-desc amb('m 'f)]
[kibi-lied? amb(#t #f)]]
assert
distinct?(list(parent1 parent2))
assert
if eqv?(kibi 'm)
not(kibi-lied?)
assert
if kibi-lied?
xor
and eqv?(kibi-self-desc 'm)
eqv?(kibi 'f)
and eqv?(kibi-self-desc 'f)
eqv?(kibi 'm)
assert
if not(kibi-lied?)
xor
and eqv?(kibi-self-desc 'm)
eqv?(kibi 'm)
and eqv?(kibi-self-desc 'f)
eqv?(kibi 'f)
assert
if eqv?(parent1 'm)
and
eqv?(kibi-self-desc 'm)
xor
and eqv?(kibi 'f)
eqv?(kibi-lied? #f)
and eqv?(kibi 'm)
eqv?(kibi-lied? #t)
assert
if eqv?(parent1 'f)
and
eqv?(kibi 'f)
eqv?(kibi-lied? #t)
list(parent1 parent2 kibi)
solve-kalotan-puzzle()
Let's use more infix operations; note that there's no requirement that we use infix everywhere:
define solve-kalotan-puzzle
lambda []
let [[parent1 amb('m 'f)]
[parent2 amb('m 'f)]
[kibi amb('m 'f)]
[kibi-self-desc amb('m 'f)]
[kibi-lied? amb(#t #f)]]
assert
distinct?(list(parent1 parent2))
assert
if eqv?(kibi 'm)
not(kibi-lied?)
assert
if kibi-lied?
xor
{eqv?(kibi-self-desc 'm) and eqv?(kibi 'f)}
{eqv?(kibi-self-desc 'f) and eqv?(kibi 'm)}
assert
if not(kibi-lied?)
xor
{eqv?(kibi-self-desc 'm) and eqv?(kibi 'm)}
{eqv?(kibi-self-desc 'f) and eqv?(kibi 'f)}
assert
if eqv?(parent1 'm)
and
eqv?(kibi-self-desc 'm)
xor
{eqv?(kibi 'f) and eqv?(kibi-lied? #f)}
{eqv?(kibi 'm) and eqv?(kibi-lied? #t)}
assert
if eqv?(parent1 'f)
{eqv?(kibi 'f) and eqv?(kibi-lied? #t)}
list(parent1 parent2 kibi)
solve-kalotan-puzzle()
Now let's add use the "group" command to get rid of some more brackets:
define solve-kalotan-puzzle
lambda []
let
group
parent1 amb('m 'f)
parent2 amb('m 'f)
kibi amb('m 'f)
kibi-self-desc amb('m 'f)
kibi-lied? amb(#t #f)
assert
distinct?(list(parent1 parent2))
assert
if eqv?(kibi 'm)
not(kibi-lied?)
assert
if kibi-lied?
xor
{eqv?(kibi-self-desc 'm) and eqv?(kibi 'f)}
{eqv?(kibi-self-desc 'f) and eqv?(kibi 'm)}
assert
if not(kibi-lied?)
xor
{eqv?(kibi-self-desc 'm) and eqv?(kibi 'm)}
{eqv?(kibi-self-desc 'f) and eqv?(kibi 'f)}
assert
if eqv?(parent1 'm)
and
eqv?(kibi-self-desc 'm)
xor
{eqv?(kibi 'f) and eqv?(kibi-lied? #f)}
{eqv?(kibi 'm) and eqv?(kibi-lied? #t)}
assert
if eqv?(parent1 'f)
{eqv?(kibi 'f) and eqv?(kibi-lied? #t)}
list(parent1 parent2 kibi)
solve-kalotan-puzzle()
And as a test, let's use even more of the infix operators. Frankly, I think the previous version is easier to follow, though this version is more similar to how it'd be done in many other languages:
define solve-kalotan-puzzle
lambda []
let
group
parent1 amb('m 'f)
parent2 amb('m 'f)
kibi amb('m 'f)
kibi-self-desc amb('m 'f)
kibi-lied? amb(#t #f)
assert
distinct?(list(parent1 parent2))
assert
if eqv?(kibi 'm)
not(kibi-lied?)
assert
if kibi-lied?
{{eqv?(kibi-self-desc 'm) and eqv?(kibi 'f)} xor
{eqv?(kibi-self-desc 'f) and eqv?(kibi 'm)}}
assert
if not(kibi-lied?)
{{eqv?(kibi-self-desc 'm) and eqv?(kibi 'm)} xor
{eqv?(kibi-self-desc 'f) and eqv?(kibi 'f)}}
assert
if eqv?(parent1 'm)
{eqv?(kibi-self-desc 'm) and
{{eqv?(kibi 'f) and eqv?(kibi-lied? #f)} xor
{eqv?(kibi 'm) and eqv?(kibi-lied? #t)}}}
assert
if eqv?(parent1 'f)
{eqv?(kibi 'f) and eqv?(kibi-lied? #t)}
list(parent1 parent2 kibi)
solve-kalotan-puzzle()
| Sweet-expression 0.1 | (Ugly) S-expression |
|---|---|
define factorial(n)
if (n <= 1)
1
n * factorial(n - 1)
substring("Hello" (1 + 1)
string-length("Hello"))
define move-n-turn(angle)
tortoise-move(100)
tortoise-turn(angle)
if (0 <= 5 <= 10)
display("True\n")
display("Uh oh\n")
define int-products(x y)
if (x = y)
x
x * int-products((x + 1) y)
int-products(3 5)
3 + 4
(2 + 3 + (4 * 5) + 7.1)
*(2 3 4 5)
|
(define (factorial n)
(if (<= n 1)
1
(* n (factorial (- n 1)))))
(substring "Hello" (+ 1 1)
(string-length "Hello"))
(define (move-n-turn angle)
(tortoise-move 100)
(tortoise-turn angle))
(if (<= 0 5 10)
(display "True\n")
(display "Uh oh\n"))
(define (int-products x y)
(if (= x y)
x
(* x (int-products (+ x 1) y))))
(int-products 3 5)
(+ 3 4)
(+ 2 3 (* 4 5) 7.1)
(* 2 3 4 5)
|
| Sweet-expression 0.2 | (Ugly) S-expression |
|---|---|
define factorial(n)
if {n <= 1}
1
{n * factorial{n - 1}}
substring("Hello" {1 + 1}
string-length("Hello"))
define move-n-turn(angle)
tortoise-move(100)
tortoise-turn(angle)
if {0 <= 5 <= 10}
display("True\n")
display("Uh oh\n")
define int-products(x y)
if {x = y}
x
{x * int-products( {x + 1} y )}
int-products(3 5)
{3 + 4}
{2 + 3 + {4 * 5} + 7.1}
*(2 3 4 5) or {2 * 3 * 4 * 5}
|
(define (factorial n)
(if (<= n 1)
1
(* n (factorial (- n 1)))))
(substring "Hello" (+ 1 1)
(string-length "Hello"))
(define (move-n-turn angle)
(tortoise-move 100)
(tortoise-turn angle))
(if (<= 0 5 10)
(display "True\n")
(display "Uh oh\n"))
(define (int-products x y)
(if (= x y)
x
(* x (int-products (+ x 1) y))))
(int-products 3 5)
(+ 3 4)
(+ 2 3 (* 4 5) 7.1)
(* 2 3 4 5)
|
See the readable Lisp page for more. The older paper Readable s-expressions and sweet-expressions describes the rationale and background for sweet-expressions version 0.1, and gives useful information on related approaches.