>From a6b321e51a19d3726620a68f8db4902877872460 Mon Sep 17 00:00:00 2001
From: Nala Ginrut <address@hidden>
Date: Fri, 25 Jan 2013 18:38:22 +0800
Subject: [PATCH] List all available languages.

* ice-9/command-line.scm: list available languages for 'guile' cmd.

* scripts/compile.scm: list all available languages for 'guild compile' cmd.

* NOTE: 'guile --list-languages' won't list inner languages, but 'guild compile -l'
        will do that.
---
 module/ice-9/command-line.scm |   23 +++++++++++++++++++++++
 module/scripts/compile.scm    |   13 +++++++++++++
 2 files changed, 36 insertions(+)

diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm
index 2aa50ec..60a1eee 100644
--- a/module/ice-9/command-line.scm
+++ b/module/ice-9/command-line.scm
@@ -122,6 +122,7 @@ If FILE begins with `-' the -s switch is mandatory.
   -e FUNCTION    after reading script, apply FUNCTION to
                  command line arguments
   --language=LANG  change language; default: scheme
+  --list-languages list all available languages
   -ds            do -s script at this point
   --debug        start with the \"debugging\" VM engine
   --no-debug     start with the normal VM engine (backtraces but
@@ -189,6 +190,22 @@ If FILE begins with `-' the -s switch is mandatory.
      ((module-ref (resolve-module '(system base compile)) 'compile-file)
       f #:to 'value))))
 
+(define (not-inner-lang? str)
+  (not ((@ (ice-9 regex) string-match) 
+        (string-append
+         "glil|glil\\.scm|assembly|assembly\\.scm|bytecode|objcode\\.scm"
+         "|objcode|tree-il|tree-il\\.scm|value|\\.\\.|\\.")
+	str)))
+
+(define (list-languages select)
+  (let lp((rest (map (lambda (x) (string-append x "/language")) %load-path))
+          (result '()))
+    (cond
+     ((null? rest) (apply (@ (srfi srfi-1) lset-union) string=? result))
+     (else 
+      (let ((ll ((@ (ice-9 ftw) scandir) (car rest) select)))
+        (lp (cdr rest) (if ll (cons ll result) result)))))))
+
 (define* (compile-shell-switches args #:optional (usage-name "guile"))
   (let ((arg0 "guile")
         (script-cell #f)
@@ -306,6 +323,12 @@ If FILE begins with `-' the -s switch is mandatory.
                    (cons `(current-language ',(string->symbol (car args)))
                          out)))
 
+           ((string=? "--list-languages" arg) ; list all languages
+            (for-each (lambda (l)
+                        (format #t "~a~%" l))
+                      (list-languages not-inner-lang?))
+            (exit 0))
+
            ((string=? arg "-ds")        ; do script here
             ;; We put a dummy "load" expression, and let the -s put the
             ;; filename in.
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index 20db944..2b94bf9 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -45,6 +45,11 @@
   (format (current-error-port) "error: ~{~a~}~%" messages)
   (exit 1))
 
+(define (valid-lang? str)
+  (not ((@ (ice-9 regex) string-match) 
+	"[A-Za-z0-9_ -]+\\.scm|\\.\\.|\\." 
+	str)))
+
 (define %options
   ;; Specifications of the command-line options.
   (list (option '(#\h "help") #f #f
@@ -80,6 +85,13 @@
 	(option '(#\O "optimize") #f #f
 		(lambda (opt name arg result)
 		  (alist-cons 'optimize? #t result)))
+        (option '("list-languages") #f #f
+                (lambda (opt name arg result)
+                  (for-each (lambda (l)
+                              (format #t "~a~%" l))
+                            ((@@ (ice-9 command-line) list-languages) 
+                             valid-lang?))
+                  (exit 0)))
 	(option '(#\f "from") #t #f
 		(lambda (opt name arg result)
                   (if (assoc-ref result 'from)
@@ -157,6 +169,7 @@ Compile each Guile source file FILE into a Guile object.
   -W, --warn=WARNING   emit warnings of type WARNING; use `--warn=help'
                        for a list of available warnings
 
+  --list-languages     list all available languages
   -f, --from=LANG      specify a source language other than `scheme'
   -t, --to=LANG        specify a target language other than `objcode'
   -T, --target=TRIPLET produce bytecode for host TRIPLET
-- 
1.7.10.4