Package: guile;
Reported by: Ricardo Wurmus <rekado <at> elephly.net>
Date: Fri, 12 Jan 2018 22:47:02 UTC
Severity: wishlist
View this message in rfc822 format
From: Matt Wette <matt.wette <at> gmail.com> To: 30094 <at> debbugs.gnu.org Cc: matt.wette <at> gmail.com Subject: bug#30094: proposed code for alt languages Date: Sun, 19 Aug 2018 14:24:40 -0700
[Message part 1 (text/plain, inline)]
Hey all,
The attached code implements alternative languages. It is roughly a patch to
(system base compile). It provides
1) extra procedures lang-from-port and lang-from-file
2) the global %file-extension-map
3) an altered version of compile-file
Behavior:
1) if the first line of the file is `#lang <lang>' then that is used as from
2) if the file-ending matches an entry in the a-list %file-extension-map the ref is used
Matt
In the following, compile.scm and ncompile.scm are trimmed to only contain
the procedure compile-file
mwette$ diff -c compile.scm ncompile.scm
*** compile.scm Sun Aug 19 14:19:44 2018
--- ncompile.scm Sun Aug 19 14:20:07 2018
***************
*** 1,10 ****
! (define* (compile-file file #:key
! (output-file #f)
! (from (current-language))
! (to 'bytecode)
! (env (default-environment from))
! (opts '())
! (canonicalization 'relative))
(with-fluids ((%file-port-name-canonicalization canonicalization))
(let* ((comp (or output-file (compiled-file-name file)
(error "failed to create path for auto-compiled file"
--- 1,10 ----
! (define* (ncompile-file file #:key
! (output-file #f)
! (from #f)
! (to 'bytecode)
! (env #f)
! (opts '())
! (canonicalization 'relative))
(with-fluids ((%file-port-name-canonicalization canonicalization))
(let* ((comp (or output-file (compiled-file-name file)
(error "failed to create path for auto-compiled file"
***************
*** 16,25 ****
(ensure-directory (dirname comp))
(call-with-output-file/atomic comp
! (lambda (port)
! ((language-printer (ensure-language to))
! (read-and-compile in #:env env #:from from #:to to #:opts
! (cons* #:to-file? #t opts))
! port))
! file)
! comp)))
--- 16,31 ----
(ensure-directory (dirname comp))
(call-with-output-file/atomic comp
! (lambda (port)
! (let* ((from (or from
! (lang-from-port in)
! (lang-from-file file)
! (current-language)))
! (env (or env (default-environment from))))
! (simple-format (current-error-port) "compiling from lang ~A\n" from)
! ((language-printer (ensure-language to))
! (read-and-compile in #:env env #:from from #:to to #:opts
! (cons* #:to-file? #t opts))
! port)))
! file)
! comp)))
Here is ncompile:;; ncompile v180819b
;; usage:
;; (ncompile-file "foo.m")
;; first checks for first line of the form
;; #lang <from-language>
;; then uses file ending ".m" => nx-matlab
(define-module (ncompile)
#:export (ncompile-file)
)
(define (lang-from-port port)
(define (release chl)
(let loop ((chl chl))
(unless (null? chl)
(unread-char (car chl) port)
(loop (cdr chl))))
#f)
(define (return chl)
(string->symbol (reverse-list->string chl)))
(let loop ((cl '()) (st 0) (kl '(#\# #\l #\a #\n #\g)) (ch (read-char port)))
(case st
((0) (cond ; read `#lang'
((eof-object? ch) (release cl))
((null? kl) (loop cl 1 kl ch))
((char=? ch (car kl))
(loop (cons ch cl) st (cdr kl) (read-char port)))
(else (release (cons ch cl)))))
((1) (cond ; skip spaces
((eof-object? ch) (release cl))
((char=? ch #\space) (loop (cons ch cl) st kl (read-char port)))
(else (loop cl 2 '() ch))))
((2) (cond ; collect lang name
((eof-object? ch) (return kl))
((char=? ch #\newline) (return kl))
((char-whitespace? ch) (loop cl 3 kl ch))
(else (loop cl st (cons ch kl) (read-char port)))))
((3) (cond
((eof-object? ch) (return kl))
((char=? ch #\newline) (return kl))
(else (loop cl st kl (read-char port))))))))
(define %file-extension-map
'(("scm" . scheme)
("el" . elisp)
("m" . nx-matlab)
("js" . ecmascript)))
(define* (lang-from-file file)
(let* ((ix (string-rindex file #\.))
(ext (and ix (substring file (1+ ix)))))
(and ext (assoc-ref %file-extension-map ext))))
(define call-with-output-file/atomic
(@@ (system base compile) call-with-output-file/atomic))
(define language-printer
(@ (system base language) language-printer))
(define ensure-language
(@@ (system base compile) ensure-language))
(define ensure-directory
(@@ (system base compile) ensure-directory))
(define read-and-compile
(@@ (system base compile) read-and-compile))
(define compiled-file-name
(@@ (system base compile) compiled-file-name))
(define default-environment
(@@ (system base compile) default-environment))
(define* (ncompile-file file #:key
(output-file #f)
(from #f)
(to 'bytecode)
(env #f)
(opts '())
(canonicalization 'relative))
(with-fluids ((%file-port-name-canonicalization canonicalization))
(let* ((comp (or output-file (compiled-file-name file)
(error "failed to create path for auto-compiled file"
file)))
(in (open-input-file file))
(enc (file-encoding in)))
;; Choose the input encoding deterministically.
(set-port-encoding! in (or enc "UTF-8"))
(ensure-directory (dirname comp))
(call-with-output-file/atomic comp
(lambda (port)
(let* ((from (or from
(lang-from-port in)
(lang-from-file file)
(current-language)))
(env (or env (default-environment from))))
(simple-format (current-error-port) "compiling from lang ~A\n" from)
((language-printer (ensure-language to))
(read-and-compile in #:env env #:from from #:to to #:opts
(cons* #:to-file? #t opts))
port)))
file)
comp)))
;; Local Variables:
;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
;; End:
;; --- last line ---
[ncompile.scm (text/x-scheme, attachment)]
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.