From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Leo Prikler Newsgroups: gmane.lisp.guile.bugs Subject: bug#45131: [PATCH] Compile directly to target language if no joint is found. Date: Tue, 29 Dec 2020 19:09:07 +0100 Message-ID: <20201229180907.28922-1-leo.prikler@student.tugraz.at> References: <5d806c0f-4542-71de-f06a-844ea3d79240@gmail.com> Mime-Version: 1.0 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="4189"; mail-complaints-to="usenet@ciao.gmane.io" Cc: tommi.hoynalanmaa@gmail.com To: 45131@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Tue Dec 29 19:10:22 2020 Return-path: Envelope-to: guile-bugs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kuJRt-0000y2-O7 for guile-bugs@m.gmane-mx.org; Tue, 29 Dec 2020 19:10:21 +0100 Original-Received: from localhost ([::1]:48628 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kuJRq-0002Q1-5A for guile-bugs@m.gmane-mx.org; Tue, 29 Dec 2020 13:10:19 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:58864) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kuJRa-0002Pt-PJ for bug-guile@gnu.org; Tue, 29 Dec 2020 13:10:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:56798) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kuJRa-0007E9-Hs for bug-guile@gnu.org; Tue, 29 Dec 2020 13:10:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kuJRa-0004cD-8j for bug-guile@gnu.org; Tue, 29 Dec 2020 13:10:02 -0500 X-Loop: help-debbugs@gnu.org In-Reply-To: <5d806c0f-4542-71de-f06a-844ea3d79240@gmail.com> Resent-From: Leo Prikler Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Tue, 29 Dec 2020 18:10:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45131 X-GNU-PR-Package: guile Original-Received: via spool by 45131-submit@debbugs.gnu.org id=B45131.160926536317686 (code B ref 45131); Tue, 29 Dec 2020 18:10:02 +0000 Original-Received: (at 45131) by debbugs.gnu.org; 29 Dec 2020 18:09:23 +0000 Original-Received: from localhost ([127.0.0.1]:40111 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kuJQx-0004bC-9V for submit@debbugs.gnu.org; Tue, 29 Dec 2020 13:09:23 -0500 Original-Received: from mailrelay.tugraz.at ([129.27.2.202]:65053) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kuJQr-0004ay-FM for 45131@debbugs.gnu.org; Tue, 29 Dec 2020 13:09:21 -0500 Original-Received: from localhost.localdomain (217-149-174-13.nat.highway.telekom.at [217.149.174.13]) by mailrelay.tugraz.at (Postfix) with ESMTPSA id 4D52Vf4VHLz3wNT; Tue, 29 Dec 2020 19:09:14 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=tugraz.at; s=mailrelay; t=1609265354; bh=s2xiZUUsiSN/dS/lZW8v3JGsin000sKLna6srDQf5Ys=; h=From:To:Cc:Subject:Date; b=O7cAAR25yOpCxTXdoAH6rUpxroS3TUiJ2TM7QGTjbb8uur9TWKgx3lRghcq2O3fAc NQ1ZgTm17Vd0xAp8r4x9XYwlIXAYGRz+g2VTZy2gB7SiI6h2Wvv1IkXnoN7zCnGRlp f5i857u5xf9Mc3TP/z+ip3asdop6ef5Kre3qC2y8= X-Mailer: git-send-email 2.29.2 X-TUG-Backscatter-control: bt4lQm5Tva3SBgCuw0EnZw X-Scanned-By: MIMEDefang 2.74 on 129.27.10.116 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.io gmane.lisp.guile.bugs:9941 Archived-At: This enables the compilation from "manually" written Tree-IL to bytecode. See also . * system/base/compile.scm (read-and-compile)[(joint #f)]: Join exps using the default joiner for to. : 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