Thanks for the patch; applied! Andy
On Tue 29 Dec 2020 19:09, Leo Prikler <leo.prik...@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))))
