Next, I see t and nil floating around in an if -- so most of it could probably be done with and/or instead of if, which might make the code clearer. Let's check with some boolean simplification. The top-level if goes
Here's a truth table based on (atom lst1) and (atom lst2).
(atom lst1) | (atom lst2) || (and ...) | (or ...) | (if ...)
nil | nil || nil | nil | 'else
nil | t || nil | t | nil
t | nil || nil | t | nil
t | t || t | t | t
Notice that the if is equivalent to the and, except for the "else". So, whenever the and returns t, we want to return t; i.e., if should be replaced by or. But
(or (and (atom lst1) (atom lst2))
'else) ; wrong
isn't quite right. When the and is nil, we only want to do the "else" if both (atom lst1) and (atom lst2) are false. Note that in arc.arc we have
(def atom (x) (no (acons x)))
So, (acons x) is also the same as (no (atom x)). Therefore, we can guard the "else" by checking that both (acons lst1) and (acons lst2) are true. This communicates the intent more clearly for whatever we have in the "else".
So, the if decides whether to recurse on the cars of the lists. But notice that whenever
(and (atom (car lst1))
(atom (car lst2)))
we know that
(same-shape (car lst1) (car lst2))
by the definition of same-shape, because the first clause of the or is that very atom check!
So, we don't need this if. We can handle it all by recursion. This also means we can get rid of the with, because we don't need to use car/cdr expressions more than once.
I detailed the rewrite for learning's sake, but we could've saved a lot of time noticing that it's really similar to Arc's iso:
(def iso (x y)
(or (is x y)
(and (acons x)
(acons y)
(iso (car x) (car y))
(iso (cdr x) (cdr y)))))
Only instead of is, we're checking that both of the items are atoms. This also suggests a different name: iso comes from the word "isomorphism", so maybe a good name for same-shape is congruent. But I like same-shape, too. Either works.
We can apply a lot of these lessons to same-sig (or maybe congruent-sigs, since we're checking for shape, not equality, and same-sig-shape is awkward). However, we don't have quite the same nice recursive properties that same-shape does.
But with this rewrite, we can see some potential bugs.
First, the var-arg clause checks the cdrs if the cars both take either one of two forms. So,
arc> (same-sig '(x y) '((o x) (o y)))
t
This might be desired -- both parameter lists are "compatible" if we supply the optional arguments. But I reckon with a name like same-sig, it's a bug.
Second, you use same-shape to check if two destructuring parameters are congruent. But same-shape doesn't take into account optional parameters, which are perfectly valid in destructuring lists. E.g.,
arc> (let (x y (o z)) '(a b) (prs x y z) (prn))
a b nil
nil
arc> (let (x y (o z)) '(a b c) (prs x y z) (prn))
a b c
nil
So same-sig gives
arc> (same-sig '(a (b (o c))) '(a (b (c d))))
t
which is surely a bug.
To address the first (potential) bug, instead of using var-arg we can just check for optional parameters. For the second, just use same-sig instead of same-shape.
; Short for "if both or neither and," 'ibona checks 'x and 'y against
; 'test (which is sent through 'testify). If one is truthy and the
; other is falsy, this results in nil. If they're both falsy, this
; results in an 'and of the 'ifneither and 'eitherway expressions. If
; they're both truthy, this results in an 'and of the 'eitherway
; expressions if they exist, and it propagates the result of calling
; the test on 'y if they don't.
(mac ibona (test x y ifneither . eitherway)
`(fn-ibona ,test ,x ,y
(fn () ,ifneither)
,(when eitherway `(fn () (and ,@eitherway))))))
(def fn-ibona (test x y ifneither (o eitherway))
(zap testify test)
(if do.test.x (aand do.test.y
(if eitherway (do.eitherway) it))
do.test.y (aand (ifneither)
(if eitherway (do.eitherway) it))))
(def congruent (x y)
(ibona atom x y
(and (congruent car.x car.y)
(congruent cdr.x cdr.y))))
(def congruent-sigs (x y)
(ibona atom x y
(ibona optional car.x car.y
(congruent-sigs car.x car.y)
(congruent-sigs cdr.x cdr.y))))
I've found myself doing...
(if atom.x atom.y
atom.y nil
...)
...a couple of times myself, so I wouldn't be surprised if (some variation of) 'ibona were surprisingly useful. :-p
EDIT: Hmm, this doesn't abbreviate as much, but its implementation and description are much more concise.
; This is similar to 'whenlet, but for binary if-and-only-if (i.e.
; xnor).
(mac xnor2let (var x y . body)
`(fn-xnor2let ,x ,y (fn (,var) ,@body)))
(def fn-xnor2let (x y body)
(only.body:.y:if x idfn no))
(def congruent (x y)
(xnor2let it atom.x atom.y
(or it
(and (congruent car.x car.y)
(congruent cdr.x cdr.y)))))
(def congruent-sigs (x y)
(xnor2let it atom.x atom.y
(or it
(xnor2let it (optional car.x) (optional car.y)
(and (or it (congruent-sigs car.x car.y))
(congruent-sigs cdr.x cdr.y))))))
Hmm, interesting. If I were opting for another control structure (which I probably wouldn't in this case, but hypothetically), I think I'd make your ibona closer to this (not tested):
(mac unless-both (test x y neither)
(w/uniq (f fx fy)
`(withs (,f (testify ,test) ,fx (,f ,x) ,fy (,f ,y))
(or (and ,fx ,fy)
(and (no ,fx)
(no ,fy)
,neither)))))
(def congruent (x y)
(unless-both atom x y
(and (congruent (car x) (car y))
(congruent (cdr x) (cdr y)))))
(def congruent-sigs (x y)
(unless-both atom x y
(and (unless-both optional (car x) (car y)
(congruent-sigs (car x) (car y)))
(congruent-sigs (cdr x) (cdr y)))))
I'm not sure if there's a better name than unless-both. Also, you could conceivably make neither a rest arg and just splice it into the and so you don't have to do (unless-both atom x y (and ...)). I just think it reads better with the explicit and. (Of course, adding a macro here is probably overkill anyway. Fun, though!)
Hmm... my code originally looked a lot like that (except for naming and the implementation of 'unless-both). Then I edited my post quite a bit because I thought there was a problem with the (and (unless-both ...) (congruent-sigs ...)) expression. (I can't remember what it was now, and I think I was mistaken.)
So I added the 'either-way parameter, and then I moved the logic into a function to make the evaluation order more to my liking--no calling the test on 'x before 'y is evaluated--and it got to the complicated state it's in now. In fact, I see some bugs now; the place where it says "do.test.y (aand (ifneither)" should be "do.test.y nil (aand (do.ifneither)".
For whatever it's worth, here's 'ibona again, with your much better name, and without 'eitherway. The only thing that's really different from your version is the argument evaluation timing.
(mac unless-both (test x y ifneither)
`(fn-unless-both ,test ,x ,y (fn () ,ifneither)))
(def fn-unless-both (test x y ifneither)
(zap testify test)
(if do.test.x do.test.y
do.test.y nil
(do.ifneither)))
