GNU bug report logs - #30094
[wishlist] better support for alternative languages

Previous Next

To reply to this bug, email your comments to 30094 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: bug-guile <at> gnu.org
Subject: [wishlist] better support for alternative languages
Date: Fri, 12 Jan 2018 23:45:36 +0100

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

Message #8 received at 30094 <at> debbugs.gnu.org (full text, mbox):

From: Matt Wette <matt.wette <at> gmail.com>
To: 30094 <at> debbugs.gnu.org
Cc: matt.wette <at> gmail.com
Subject: 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)]

Message #11 received at 30094 <at> debbugs.gnu.org (full text, mbox):

From: Matt Wette <matt.wette <at> gmail.com>
To: 30094 <at> debbugs.gnu.org
Subject: patch for adding external lang support
Date: Tue, 4 Sep 2018 06:43:39 -0700

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)

Message #14 received at 30094 <at> debbugs.gnu.org (full text, mbox):

From: Matt Wette <matt.wette <at> gmail.com>
To: 30094 <at> debbugs.gnu.org
Subject: Re: patch for adding external lang support
Date: Tue, 4 Sep 2018 07:00:46 -0700

There is a left-over simple-format statement which should be removed.

Message #17 received at 30094 <at> debbugs.gnu.org (full text, mbox):

From: Matt Wette <matt.wette <at> gmail.com>
To: 30094 <at> debbugs.gnu.org
Subject: test script
Date: Tue, 4 Sep 2018 18:35:21 -0700

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 ---

Message #20 received at 30094 <at> debbugs.gnu.org (full text, mbox):

From: Matt Wette <matt.wette <at> gmail.com>
To: 30094 <at> debbugs.gnu.org
Subject: load-lang patch
Date: Sun, 23 Sep 2018 10:29:01 -0700

I am now posting patch for this to github.com mwette guile-contrib 
patch-2.2.4 load.patch .

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.