Subject: proposed code for alt languages

From: Matt Wette <[email-masked]>
Date: Sun, 19 Aug 2018 14:24:40 -0700

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