Re: Absent Code attribute in r7rs library

[Seth Alves <alves at hungry dot com>]

Once more with attachment.

    -seth

On 11/26/2014 05:16 PM, Seth Alves wrote:
> srfi-42 is a rich source of horror.
>
> $ ./kawa-absent-code.scm
> Exception in thread "main" java.lang.ClassFormatError: Absent Code 
> attribute in method that is not native or abstract in class file foo
>     at java.lang.ClassLoader.defineClass1(Native Method)
>     at java.lang.ClassLoader.defineClass(ClassLoader.java:800)
>     at java.lang.ClassLoader.defineClass(ClassLoader.java:643)
>     at gnu.bytecode.ArrayClassLoader.loadClass(ArrayClassLoader.java:125)
>     at gnu.expr.ModuleExp.evalToClass(ModuleExp.java:135)
>     at gnu.expr.ModuleExp.evalToClass(ModuleExp.java:157)
>     at gnu.expr.ModuleExp.evalModule1(ModuleExp.java:259)
>     at kawa.Shell.compileSource(Shell.java:560)
>     at kawa.Shell.runFile(Shell.java:528)
>     at kawa.Shell.runFileOrClass(Shell.java:447)
>     at kawa.repl.main(repl.java:881)
>
> This time, it *does* need to be inside an r7rs library for there to be 
> a problem.  Again, let me know if more trimming would help.
>
>      -seth

#! /bin/sh
#| -*- scheme -*-
exec /usr/local/bin/kawa \
  -Dkawa.import.path='./*.sld' \
  -Dkawa.include.path='|:.' \
  $0 "$@"
|#


(define-library (foo)
  (export list-ec :vector)
  (import (scheme base))
  (begin

    (define-syntax :do
      (syntax-rules ()
        ((:do (cc ...) olet lbs ne1? ilet ne2? lss)
         (cc ... (:do olet lbs ne1? ilet ne2? lss)))))

    (define-syntax list-ec
      (syntax-rules ()
        ((list-ec etc1 etc ...)
         (reverse (fold-ec '() etc1 etc ... cons)) )))

    (define-syntax fold-ec
      (syntax-rules (nested)
        ((fold-ec x0 qualifier expression f2)
         (let ((result x0))
           (do-ec qualifier (set! result (f2 expression result)))
           result ))))

    (define-syntax do-ec
      (syntax-rules (nested if not and or begin :do let)
        ((do-ec (g arg1 arg ...) cmd)
         (g (do-ec:do cmd) arg1 arg ...) )))

    (define-syntax do-ec:do
      (syntax-rules (:do let)

        ((do-ec:do cmd 
                   (:do (let obs oc ...) 
                        lbs 
                        ne1? 
                        (let ibs ic ...) 
                        ne2? 
                        (ls ...) ))
         (let obs
             oc ...
             (let loop lbs
               (if ne1?
                   (let ibs
                       ic ...
                       cmd
                       (if ne2?
                           (loop ls ...) )))))) ))

    (define (ec-:vector-filter vecs)
      (if (null? vecs)
          '()
          (if (zero? (vector-length (car vecs)))
              (ec-:vector-filter (cdr vecs))
              (cons (car vecs) (ec-:vector-filter (cdr vecs))) )))

    (define-syntax :vector
      (syntax-rules (index)
        ((:vector cc var arg1 arg2 arg ...)
         (:do cc
              (let ((vec #f)
                    (len 0)
                    (vecs (ec-:vector-filter (list arg1 arg2 arg ...))) ))
              ((k 0))
              (if (< k len)
                  #t
                  (if (null? vecs)
                      #f
                      (begin (set! vec (car vecs))
                             (set! vecs (cdr vecs))
                             (set! len (vector-length vec))
                             (set! k 0)
                             #t )))
              (let ((var (vector-ref vec k))))
              #t
              ((+ k 1))))))))


(import (scheme base)
        (scheme write)
        (foo))

 (list-ec (:vector x (vector 1) (vector 2)) x)