GNU bug report logs - #45131
guild fails to compile a Tree-IL file

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 45131 in the body.
You can then email your comments to 45131 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Tommi Höynälänmaa <tommi.hoynalanmaa <at> gmail.com>
To: bug-guile <at> gnu.org
Subject: guild fails to compile a Tree-IL file
Date: Wed, 9 Dec 2020 14:05:33 +0200

[Message part 1 (text/plain, inline)]

This bug occurs in both guile version 3.0.4.38-64c894 and 
3.0.4-1.2ubuntu3. I use Ubuntu 20.10.

*** Steps to reproduce ***

1. Create file hello1.scm with the following contents:

---cut here---

(display "Hello world")
(newline)

---cut here---

2. Give command

guild compile --to=tree-il -o hello1.tree-il hello1.scm

3. Give command

guild compile --from=tree-il -o hello1.go hello1.tree-il

*** Expected output ***

File hello1.tree-il should be compiled to hello1.go

*** Actual output ***

---cut here---

Backtrace:
In /home/tohoyn/git/other/guile/meta/guild:
    72:17 19 (main _)
In srfi/srfi-1.scm:
    634:9 18 (for-each #<procedure 7fa5b08eb6e0 at scripts/compile.…> …)
In scripts/compile.scm:
   279:26 17 (_ _)
In system/base/target.scm:
     65:6 16 (with-target _ _)
In system/base/compile.scm:
    187:6 15 (compile-file "hello1.tree-il" #:output-file _ #:from _ …)
     53:4 14 (call-with-output-file/atomic _ _ _)
In ice-9/boot-9.scm:
  1736:10 13 (with-exception-handler _ _ #:unwind? _ # _)
In system/base/compile.scm:
    69:11 12 (_)
   190:11 11 (_ #<closed: file 7fa5af3990e0>)
   335:18 10 (read-and-compile #<input: hello1.tree-il 13> #:from _ # …)
     84:6  9 (compute-compiler _ #f 2 1 (#:to-file? #t #:warnings #))
In system/base/language.scm:
    63:11  8 (lookup-language #f)
In ice-9/threads.scm:
    390:8  7 (_ _)
In ice-9/boot-9.scm:
  3223:13  6 (_)
  3493:26  5 (try-module-autoload _ _)
   222:29  4 (map1 (language #f))
   222:17  3 (map1 (#f))
  3494:48  2 (_ _)
In unknown file:
           1 (symbol->string #f)
In ice-9/boot-9.scm:
  1669:16  0 (raise-exception _ #:continuable? _)

ice-9/boot-9.scm:1669:16: In procedure raise-exception:
In procedure symbol->string: Wrong type argument in position 1 
(expecting symbol): #f
---cut here---

     - Tommi Höynälänmaa

[OpenPGP_0xBB861FDE40460F83.asc (application/pgp-keys, attachment)]

[OpenPGP_signature (application/pgp-signature, attachment)]

Message #8 received at 45131 <at> debbugs.gnu.org (full text, mbox):

From: Leo Prikler <leo.prikler <at> student.tugraz.at>
To: 45131 <at> debbugs.gnu.org
Cc: tommi.hoynalanmaa <at> gmail.com
Subject: [PATCH] Compile directly to target language if no joint is found.
Date: Tue, 29 Dec 2020 19:09:07 +0100

This enables the compilation from "manually" written Tree-IL to
bytecode.  See also <https://bugs.gnu.org/45131>.

* system/base/compile.scm (read-and-compile)[(joint #f)]<? eof-object?>:
Join exps using the default joiner for to.
<exp>: Compute compiler for to.
* test-suite/test/compiler.test ("read-and-compile tree-il"): New test.
---
 module/system/base/compile.scm | 26 +++++++++++++++-----------
 test-suite/tests/compiler.test | 22 ++++++++++++++++++++++
 2 files changed, 37 insertions(+), 11 deletions(-)

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 567765dc0..41ad0158a 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -310,16 +310,20 @@
         (match (read-and-parse (current-language) port cenv)
           ((? eof-object?)
            (close-port port)
-           (compile ((or (language-joiner joint)
-                         (default-language-joiner joint))
-                     (reverse exps)
-                     env)
-                    #:from joint #:to to
-                    ;; env can be false if no expressions were read.
-                    #:env (or env (default-environment joint))
-                    #:optimization-level optimization-level
-                    #:warning-level warning-level
-                    #:opts opts))
+           (if joint
+               (compile ((or (language-joiner joint)
+                             (default-language-joiner joint))
+                         (reverse exps)
+                         env)
+                        #:from joint #:to to
+                        ;; env can be false if no expressions were read.
+                        #:env (or env (default-environment joint))
+                        #:optimization-level optimization-level
+                        #:warning-level warning-level
+                        #:opts opts)
+               ((default-language-joiner to)
+                (reverse exps)
+                env)))
           (exp
            (let with-compiler ((from from) (compile1 compile1))
              (cond
@@ -332,7 +336,7 @@
                (let ((from (current-language)))
                  (with-compiler
                   from
-                  (compute-compiler from joint optimization-level
+                  (compute-compiler from (or joint to) optimization-level
                                     warning-level opts))))))))))))
 
 (define* (compile x #:key
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index dc75d0ac7..cdc26c751 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -337,3 +337,25 @@
   (pass-if-equal "test terminates without error" 42
     (test-proc)))
 
+(with-test-prefix "read-and-compile tree-il"
+  (let ((code
+         "\
+(seq
+  (define forty-two
+    (lambda ((name . forty-two))
+            (lambda-case ((() #f #f #f () ()) (const 42)))))
+  (toplevel forty-two))")
+        (bytecode #f)
+        (proc #f))
+    (pass-if "compiling tree-il works"
+      (begin
+        (set! bytecode
+          (call-with-input-string code
+            (lambda (port)
+              (read-and-compile port #:from 'tree-il))))
+        #t))
+    (pass-if "bytecode can be read"
+      (begin
+        (set! proc ((load-thunk-from-memory bytecode)))
+        (procedure? proc)))
+    (pass-if-equal "proc executes" 42 (proc))))
-- 
2.29.2

Message #13 received at 45131-done <at> debbugs.gnu.org (full text, mbox):

From: Andy Wingo <wingo <at> igalia.com>
To: Leo Prikler <leo.prikler <at> student.tugraz.at>
Cc: 45131-done <at> debbugs.gnu.org, tommi.hoynalanmaa <at> gmail.com
Subject: Re: bug#45131: guild fails to compile a Tree-IL file
Date: Mon, 10 May 2021 10:17:28 +0200

Thanks for the patch; applied!

Andy

On Tue 29 Dec 2020 19:09, Leo Prikler <leo.prikler <at> student.tugraz.at> writes:

> This enables the compilation from "manually" written Tree-IL to
> bytecode.  See also <https://bugs.gnu.org/45131>.
>
> * system/base/compile.scm (read-and-compile)[(joint #f)]<? eof-object?>:
> Join exps using the default joiner for to.
> <exp>: Compute compiler for to.
> * test-suite/test/compiler.test ("read-and-compile tree-il"): New test.
> ---
>  module/system/base/compile.scm | 26 +++++++++++++++-----------
>  test-suite/tests/compiler.test | 22 ++++++++++++++++++++++
>  2 files changed, 37 insertions(+), 11 deletions(-)
>
> diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
> index 567765dc0..41ad0158a 100644
> --- a/module/system/base/compile.scm
> +++ b/module/system/base/compile.scm
> @@ -310,16 +310,20 @@
>          (match (read-and-parse (current-language) port cenv)
>            ((? eof-object?)
>             (close-port port)
> -           (compile ((or (language-joiner joint)
> -                         (default-language-joiner joint))
> -                     (reverse exps)
> -                     env)
> -                    #:from joint #:to to
> -                    ;; env can be false if no expressions were read.
> -                    #:env (or env (default-environment joint))
> -                    #:optimization-level optimization-level
> -                    #:warning-level warning-level
> -                    #:opts opts))
> +           (if joint
> +               (compile ((or (language-joiner joint)
> +                             (default-language-joiner joint))
> +                         (reverse exps)
> +                         env)
> +                        #:from joint #:to to
> +                        ;; env can be false if no expressions were read.
> +                        #:env (or env (default-environment joint))
> +                        #:optimization-level optimization-level
> +                        #:warning-level warning-level
> +                        #:opts opts)
> +               ((default-language-joiner to)
> +                (reverse exps)
> +                env)))
>            (exp
>             (let with-compiler ((from from) (compile1 compile1))
>               (cond
> @@ -332,7 +336,7 @@
>                 (let ((from (current-language)))
>                   (with-compiler
>                    from
> -                  (compute-compiler from joint optimization-level
> +                  (compute-compiler from (or joint to) optimization-level
>                                      warning-level opts))))))))))))
>  
>  (define* (compile x #:key
> diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
> index dc75d0ac7..cdc26c751 100644
> --- a/test-suite/tests/compiler.test
> +++ b/test-suite/tests/compiler.test
> @@ -337,3 +337,25 @@
>    (pass-if-equal "test terminates without error" 42
>      (test-proc)))
>  
> +(with-test-prefix "read-and-compile tree-il"
> +  (let ((code
> +         "\
> +(seq
> +  (define forty-two
> +    (lambda ((name . forty-two))
> +            (lambda-case ((() #f #f #f () ()) (const 42)))))
> +  (toplevel forty-two))")
> +        (bytecode #f)
> +        (proc #f))
> +    (pass-if "compiling tree-il works"
> +      (begin
> +        (set! bytecode
> +          (call-with-input-string code
> +            (lambda (port)
> +              (read-and-compile port #:from 'tree-il))))
> +        #t))
> +    (pass-if "bytecode can be read"
> +      (begin
> +        (set! proc ((load-thunk-from-memory bytecode)))
> +        (procedure? proc)))
> +    (pass-if-equal "proc executes" 42 (proc))))

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.