From: Matt Wette <matt.wette@gmail.com>
To: 30094@debbugs.gnu.org
Cc: matt.wette@gmail.com
Subject: bug#30094: proposed code for alt languages
Date: Sun, 19 Aug 2018 14:24:40 -0700 [thread overview]
Message-ID: <acbfb695-70ac-9699-2e35-8b17389d6ae8@gmail.com> (raw)
In-Reply-To: <876086wvan.fsf@elephly.net>
[-- Attachment #1: Type: text/plain, Size: 5935 bytes --]
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 ---
[-- Attachment #2: ncompile.scm --]
[-- Type: text/x-scheme, Size: 3338 bytes --]
;; 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 ---
next prev parent reply other threads:[~2018-08-19 21:24 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-01-12 22:45 bug#30094: [wishlist] better support for alternative languages Ricardo Wurmus
2018-08-19 21:24 ` Matt Wette [this message]
2018-09-04 13:43 ` bug#30094: patch for adding external lang support Matt Wette
2018-09-04 14:00 ` Matt Wette
2018-09-05 1:35 ` bug#30094: test script Matt Wette
2018-09-23 17:29 ` bug#30094: load-lang patch Matt Wette
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=acbfb695-70ac-9699-2e35-8b17389d6ae8@gmail.com \
--to=matt.wette@gmail.com \
--cc=30094@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).