* bug#30094: [wishlist] better support for alternative languages
@ 2018-01-12 22:45 Ricardo Wurmus
2018-08-19 21:24 ` bug#30094: proposed code for alt languages Matt Wette
` (3 more replies)
0 siblings, 4 replies; 6+ messages in thread
From: Ricardo Wurmus @ 2018-01-12 22:45 UTC (permalink / raw)
To: 30094
Hi Guilers,
since Guile supports alternative language implementations like Wisp it
would be nice if it could interpret files that contain code written in
other languages, without having to specially cater to them.
If GUILE_LOAD_PATH contains a file “foo.wisp” written in Wisp it would
be nice if Guile would automatically read it with the Wisp language.
The same applies to “load”, which only supports Scheme code.
Another idea might be to adopt the “#lang” macro from Racket to inform
Guile about the language that is used in the current file.
--
Ricardo
GPG: BCA6 89B6 3655 3801 C3C6 2150 197A 5888 235F ACAC
https://elephly.net
^ permalink raw reply [flat|nested] 6+ messages in thread* bug#30094: proposed code for alt languages
2018-01-12 22:45 bug#30094: [wishlist] better support for alternative languages Ricardo Wurmus
@ 2018-08-19 21:24 ` Matt Wette
2018-09-04 13:43 ` bug#30094: patch for adding external lang support Matt Wette
` (2 subsequent siblings)
3 siblings, 0 replies; 6+ messages in thread
From: Matt Wette @ 2018-08-19 21:24 UTC (permalink / raw)
To: 30094; +Cc: matt.wette
[-- 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 ---
^ permalink raw reply [flat|nested] 6+ messages in thread* bug#30094: patch for adding external lang support
2018-01-12 22:45 bug#30094: [wishlist] better support for alternative languages Ricardo Wurmus
2018-08-19 21:24 ` bug#30094: proposed code for alt languages Matt Wette
@ 2018-09-04 13:43 ` 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
3 siblings, 1 reply; 6+ messages in thread
From: Matt Wette @ 2018-09-04 13:43 UTC (permalink / raw)
To: 30094
Here is a patch against 2.2.4. It compiled and passed "make check".
Still to go: some test-suite scripts.
--- module/system/base/compile.scm-orig 2016-08-01 04:32:31.000000000 -0700
+++ module/system/base/compile.scm 2018-09-04 06:27:53.056330281 -0700
@@ -28,6 +28,7 @@
#:use-module (ice-9 receive)
#:export (compiled-file-name
compile-file
+ add-extension
compile-and-load
read-and-compile
compile
@@ -132,11 +133,65 @@
(and (false-if-exception (ensure-directory (dirname f)))
f))))
+;; --- new ---------------------------
+
+(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)
+ ("js" . ecmascript)))
+
+(define (add-extension tag lang)
+ (unless (and (string? tag) (symbol? lang))
+ (error "expecting string symbol"))
+ (set! %file-extension-map (acons tag lang %file-extension-map)))
+
+(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* (compile-file file #:key
(output-file #f)
- (from (current-language))
+ (from #f)
(to 'bytecode)
- (env (default-environment from))
+ (env #f)
(opts '())
(canonicalization 'relative))
(with-fluids ((%file-port-name-canonicalization canonicalization))
@@ -151,11 +206,17 @@
(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)
+ (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)))
(define* (compile-and-load file #:key (from (current-language)) (to 'value)
^ permalink raw reply [flat|nested] 6+ messages in thread* bug#30094: test script
2018-01-12 22:45 bug#30094: [wishlist] better support for alternative languages Ricardo Wurmus
2018-08-19 21:24 ` bug#30094: proposed code for alt languages Matt Wette
2018-09-04 13:43 ` bug#30094: patch for adding external lang support Matt Wette
@ 2018-09-05 1:35 ` Matt Wette
2018-09-23 17:29 ` bug#30094: load-lang patch Matt Wette
3 siblings, 0 replies; 6+ messages in thread
From: Matt Wette @ 2018-09-05 1:35 UTC (permalink / raw)
To: 30094
The following test script works with the 2.2.4 patch provided.
elisp tests don't work well but I think that is elisp issue.
This stuff works with my own developed.
;;; load-lang.test - -*- scheme -*-
(define-module (test-suite test-load-lang)
#:use-module (test-suite lib))
(define tmp-dir (getcwd))
(define (data-file-name filename)
(in-vicinity tmp-dir filename))
(with-test-prefix "load/lang"
(pass-if "using #lang"
(let ((src-file (data-file-name "load1js")))
(with-output-to-file src-file
(lambda ()
(display "#lang ecmascript\n")
(display "function js_1pl(b) { return 1 + b; }\n")))
(load src-file)
(delete-file src-file)
(= (js_1pl 2) 3)))
(pass-if "using dot-js"
(let ((src-file (data-file-name "load2.js")))
(with-output-to-file src-file
(lambda ()
(display "function js_2pl(b) { return 2 + b; }\n")))
(load src-file)
(delete-file src-file)
(= (js_2pl 2) 4)))
)
;; --- last line ---
^ permalink raw reply [flat|nested] 6+ messages in thread* bug#30094: load-lang patch
2018-01-12 22:45 bug#30094: [wishlist] better support for alternative languages Ricardo Wurmus
` (2 preceding siblings ...)
2018-09-05 1:35 ` bug#30094: test script Matt Wette
@ 2018-09-23 17:29 ` Matt Wette
3 siblings, 0 replies; 6+ messages in thread
From: Matt Wette @ 2018-09-23 17:29 UTC (permalink / raw)
To: 30094
I am now posting patch for this to github.com mwette guile-contrib
patch-2.2.4 load.patch .
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2018-09-23 17:29 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-01-12 22:45 bug#30094: [wishlist] better support for alternative languages Ricardo Wurmus
2018-08-19 21:24 ` bug#30094: proposed code for alt languages Matt Wette
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
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).