Arc Forum | Check if two functions have the same signature.

Arc Forum

Check if two functions have the same signature.

1 point by ylando 5219 days ago | 4 comments

I was thinking of ways to use the sig function.

First check if two function can be called with the same arguments. It is useful if we want to declare a dependency: We want to check that the user of our library create a specific function (for example an error handling function).

This is a code that check if two functions signature are the same:

  ;Check if two list have the same structure
  (def same-shape (lst1 lst2)
    (if (and (atom lst1) (atom lst2)) t 
        (or (atom lst1) (atom lst2)) nil
        (if (and (empty lst1) (empty lst2)) t
        (or (empty lst1) (empty lst2)) nil
        (with (l1 (car lst1) l2 (car lst2) r1 (cdr lst1) r2 (cdr lst2))
           (if (and (atom l1) (atom l2)) 
                  (same-shape r1 r2)
               (and (acons l1) (acons l2)) 
                  (and (same-shape l1 l2) (same-shape r1 r2))
             nil )))))

  ;Argument that are not a destructor list
  (def var-arg (v)
   (or (atom v) (caris v 'o)))

  ;Check if two function signature are the same
  (def same-sig (lst1 lst2)
    (if (and (atom lst1) (atom lst2)) t 
        (or (atom lst1) (atom lst2)) nil
        (if (and (empty lst1) (empty lst2)) t
            (or (empty lst1) (empty lst2)) nil
        (with (l1 (car lst1) l2 (car lst2) r1 (cdr lst1) r2 (cdr lst2))
          (if (and (var-arg l1) (var-arg l2)) 
                 (same-sig r1 r2)
              (and (acons l1) (acons l2)) 
                 (and (same-shape l1 l2) (same-sig r1 r2))
               nil )))))

The next code is for checking if a function can be called with a list of arguments:

  ;Check if the list lst can be destruct to binds
  (def can-ds (binds lst)
    (if (empty binds) 
      (if  (atom lst) t nil)
      (atom binds) 
      (if (empty lst) nil t)
      ; a cons binds
      (if (acons lst)
          (and (can-ds (car binds) (car lst))
               (can-ds (cdr binds) (cdr lst)))
          nil)))

  ;Check if a function with args can be called with
  ;the arguments call-args
  (def can-call (call-args args)
   (if (empty call-args)
       (if (acons args)
           (if (caris (car args) 'o) ;optional arg
               (can-call nil (cdr args)) 
                nil)
           t)
       (empty args) nil
       (atom args) t
       (if (or (atom (car args)) (caris (car args) 'o))
           (can-call (cdr call-args) (cdr args))
           (and (can-ds (car args) (car call-args))
                (can-call (cdr call-args) (cdr args))))))

Examples of how we use those functions:

  (def add (a b) (+ a b))
  (def mul (a b) (* a b))
  (same-sig (sig 'add) (sig 'mul)) => t
  (can-call '(1 2) (sig 'add)) => t

7 points by fallintothis 5218 days ago | link

That code could be a lot simpler. Here's my step-by-step rewrite of same-shape.

I space things out so I can read them.

  (def same-shape (lst1 lst2)
    (if (and (atom lst1) (atom lst2))
         t
        (or (atom lst1) (atom lst2))
         nil
         (if (and (empty lst1) (empty lst2))
              t
             (or (empty lst1) (empty lst2))
              nil
              (with (l1 (car lst1) l2 (car lst2) r1 (cdr lst1) r2 (cdr lst2))
                (if (and (atom l1) (atom l2))
                     (same-shape r1 r2)
                    (and (acons l1) (acons l2))
                     (and (same-shape l1 l2) (same-shape r1 r2))
                     nil)))))

With this spacing, the first thing that sticks out to me is that you have an if in the top-level if's "else" branch, when one flat if will do.

  (def same-shape (lst1 lst2)
    (if (and (atom lst1) (atom lst2))
         t
        (or (atom lst1) (atom lst2))
         nil
        (and (empty lst1) (empty lst2))
         t
        (or (empty lst1) (empty lst2))
         nil
         (with (l1 (car lst1) l2 (car lst2) r1 (cdr lst1) r2 (cdr lst2))
           (if (and (atom l1) (atom l2))
                (same-shape r1 r2)
               (and (acons l1) (acons l2))
                (and (same-shape l1 l2) (same-shape r1 r2))
                nil))))

Next, I see empty, which is defined in arc.arc as

  (def empty (seq)
    (or (no seq)
        (and (or (is (type seq) 'string) (is (type seq) 'table))
             (is (len seq) 0))))

Since we're talking about lists, you're really checking the no condition. In arc.arc, no is defined as

  (def no (x) (is x nil))

But

  arc> (atom nil)
  t
  arc> (acons nil)
  nil

So, the empty checks are already covered by atom.

  (def same-shape (lst1 lst2)
    (if (and (atom lst1) (atom lst2))
         t
        (or (atom lst1) (atom lst2))
         nil
         (with (l1 (car lst1) l2 (car lst2) r1 (cdr lst1) r2 (cdr lst2))
           (if (and (atom l1) (atom l2))
                (same-shape r1 r2)
               (and (acons l1) (acons l2))
                (and (same-shape l1 l2) (same-shape r1 r2))
                nil))))

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

  (if (and (atom lst1) (atom lst2))
       t
      (or (atom lst1) (atom lst2))
       nil
       'else)

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".

  (or (and (atom lst1) (atom lst2))
      (and (acons lst1)
           (acons lst2)
           'else))

So far, that's

  (def same-shape (lst1 lst2)
    (or (and (atom lst1) (atom lst2))
        (and (acons lst1)
             (acons lst2)
             (with (l1 (car lst1) l2 (car lst2) r1 (cdr lst1) r2 (cdr lst2))
               (if (and (atom l1) (atom l2)) 
                    (same-shape r1 r2)
                   (and (acons l1) (acons l2)) 
                    (and (same-shape l1 l2) (same-shape r1 r2))
                    nil)))))

That leaves the inner if to clean up. The nil at the end is redundant; removing gives us

  (def same-shape (lst1 lst2)
    (or (and (atom lst1) (atom lst2))
        (and (acons lst1)
             (acons lst2)
             (with (l1 (car lst1) l2 (car lst2) r1 (cdr lst1) r2 (cdr lst2))
               (if (and (atom l1) (atom l2)) 
                    (same-shape r1 r2)
                   (and (acons l1) (acons l2)) 
                    (and (same-shape l1 l2) (same-shape r1 r2)))))))

To simplify, we can expand the with variables and see what's happening.

  (if (and (atom (car lst1))
           (atom (car lst2)))
       (same-shape (cdr lst1) (cdr lst2))
      (and (acons (car lst1))
           (acons (car lst2)))
       (and (same-shape (car lst1) (car lst2))
            (same-shape (cdr lst1) (cdr lst2))))

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.

The final version is thus

  (def same-shape (lst1 lst2)
    (or (and (atom lst1) (atom lst2))
        (and (acons lst1)
             (acons lst2)
             (same-shape (car lst1) (car lst2))
             (same-shape (cdr lst1) (cdr lst2)))))

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.

  (def congruent (x y)
    (or (and (atom x) (atom y))
        (and (acons x)
             (acons y)
             (congruent (car x) (car y))
             (congruent (cdr x) (cdr y)))))

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.

  (def same-sig (x y)
    (or (and (atom x) (atom y))
        (and (acons x)
             (acons y)
             (if (and (var-arg (car x)) (var-arg (car y)))
                  (same-sig (cdr x) (cdr y))
                 (and (acons (car x)) (acons (car y)))
                  (and (same-shape (car x) (car y))
                       (same-sig (cdr x) (cdr y)))))))

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.

  (def optional (parm)
    (caris parm 'o))

  (def same-sig (x y)
    (or (and (atom x) (atom y))
        (and (acons x)
             (acons y)
             (if (and (optional (car x)) (optional (car y)))
                  (same-sig (cdr x) (cdr y))
                 (and (~optional (car x)) (~optional (car y)))
                  (and (same-sig (car x) (car y))
                       (same-sig (cdr x) (cdr y)))))))

The common pattern here annoys me, so I refactor a bit more. My final version is

  (def both (f x y) (and (f x) (f y)))

  (def optional (parm)
    (caris parm 'o))

  (def congruent-sigs (x y)
    (or (both atom x y)
        (and (both acons x y)
             (if (both optional (car x) (car y))
                  (congruent-sigs (cdr x) (cdr y))
                 (both ~optional (car x) (car y))
                  (and (congruent-sigs (car x) (car y))
                       (congruent-sigs (cdr x) (cdr y)))))))

Though you might consider defining it like

  (def congruent-sigs (f g)
    ((afn (x y)
       ...)
     (sig f) (sig g)))

to avoid calling sig manually.

-----

2 points by rocketnia 5218 days ago | link

I'm not sure if this makes the code any more readable, but, you know... http://en.wikipedia.org/wiki/Rule_of_three_(programming)

  ; 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))))))

-----

3 points by fallintothis 5218 days ago | link

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!)

-----

2 points by rocketnia 5218 days ago | link

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)))

Thanks for your insight. ^_^

-----