arities can have noncontiguous starts and ends

* module/language/glil/compile-assembly.scm (open-arity, close-arity)
  (begin-arity, glil->assembly): Refactor so that arities can have
  noncontiguous starts and ends. So within a prelude there is no arity
  -- only before (the previous arity) or after (the new arity).

* module/system/vm/program.scm (arity:end): Add this private accessor.
  Arities are expected to be in the new format. While not a change in
  objcode format, it is an incompatible change, so I'll bump the objcode
  cookie.
  (program-arity): Check that the ip is within both bounds of the arity.

* libguile/_scm.h (SCM_OBJCODE_MINOR_VERSION): Bump.

* libguile/programs.c (scm_i_program_arity): Update for new arity format.

* module/system/vm/frame.scm (vm-frame-arguments): Avoid throwing an
  error in this function, which is called from the backtrace code.

1 files changed, 18 insertions, 14 deletions

diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index 823b2a053..68ebb84ef 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -97,13 +97,30 @@
                      (cons (car binds) out))
                     (else (inner (cdr binds)))))))))
 
+(define (arity:start a)
+  (pmatch a ((,start ,end . _) start) (else (error "bad arity" a))))
+(define (arity:end a)
+  (pmatch a ((,start ,end . _) end) (else (error "bad arity" a))))
+(define (arity:nreq a)
+  (pmatch a ((_ _ ,nreq . _) nreq) (else 0)))
+(define (arity:nopt a)
+  (pmatch a ((_ _ ,nreq ,nopt . _) nopt) (else 0)))
+(define (arity:rest? a)
+  (pmatch a ((_ _ ,nreq ,nopt ,rest? . _) rest?) (else #f)))
+(define (arity:kw a)
+  (pmatch a ((_ _ ,nreq ,nopt ,rest? (_ . ,kw)) kw) (else '())))
+(define (arity:allow-other-keys? a)
+  (pmatch a ((_ _ ,nreq ,nopt ,rest? (,aok . ,kw)) aok) (else #f)))
+
 ;; not exported; should it be?
 (define (program-arity prog ip)
   (let ((arities (program-arities prog)))
     (and arities
          (let lp ((arities arities))
            (cond ((null? arities) #f)
-                 ((<= (caar arities) ip) (car arities))
+                 ((and (< (arity:start (car arities)) ip)
+                       (<= ip (arity:end (car arities))))
+                  (car arities))
                  (else (lp (cdr arities))))))))
 
 (define (arglist->arguments arglist)
@@ -117,19 +134,6 @@
        (extents . ,extents)))
     (else #f)))
 
-(define (arity:start a)
-  (pmatch a ((,ip . _) ip) (else (error "bad arity" a))))
-(define (arity:nreq a)
-  (pmatch a ((_ ,nreq . _) nreq) (else 0)))
-(define (arity:nopt a)
-  (pmatch a ((_ ,nreq ,nopt . _) nopt) (else 0)))
-(define (arity:rest? a)
-  (pmatch a ((_ ,nreq ,nopt ,rest? . _) rest?) (else #f)))
-(define (arity:kw a)
-  (pmatch a ((_ ,nreq ,nopt ,rest? (_ . ,kw)) kw) (else '())))
-(define (arity:allow-other-keys? a)
-  (pmatch a ((_ ,nreq ,nopt ,rest? (,aok . ,kw)) aok) (else #f)))
-
 (define (arity->arguments prog arity)
   (define var-by-index
     (let ((rbinds (map (lambda (x)