Compilador ingênuo de Scheme para Javascript

Por curiosidade, há algum tempo tentei ver como seria fazer um compilador simples de Scheme para Javascript. Obviamente, um compilador "de verdade" não é uma tarefa fácil, embora haja esforços nesta direção.

De qualquer forma, é impressionante o que dá para fazer com algumas poucas linhas de código. :-)

Várias formas básicas de Scheme não estão implementadas: cond, begin, call/cc e muitas outras.

#!/usr/bin/csi -script

(use (srfi 1))

(define (infix-op op args)
  (string-intersperse
   (map ->string (map scm->js args)) (->string op)))

(define (mapconcat elts #!optional sep)
  (string-intersperse (map ->string elts) (or sep "")))

(define (scm-body->js body)
  (let ((body-butlast (butlast body))
        (last-expr (last body)))
    (conc (mapconcat (map scm->js body-butlast) ";") ";"
          "return " (scm->js last-expr) ";")))
  
(define (scm->js expr)
  (if (atom? expr)
      (cond ((string? expr)
             (conc "'" expr "'"))
            ((boolean? expr)
             (if (eq? expr '#t) "true" "false"))
            (else expr))
      (case (car expr)
        ((if) (let ((condition (cadr expr))
                    (branch1 (caddr expr))
                    (branch2 (and (= 4 (length expr))
                                  (cadddr expr))))
                (conc "(function(){if(" (scm->js condition)
                      "){return(" (scm->js branch1) ");}"
                      (if branch2
                          (conc "else{return("
                                (scm->js branch2) ");}")
                          "")
                      "})();")))
        ((return) (conc "return(" (scm->js (cadr expr))
                        ");"))
        ((lambda)
         (conc "function"
               (if (null? (cadr expr))
                   "()"
                   (conc "(" (mapconcat (cadr expr) ",")
                         ")")) "{"
                         (scm-body->js (cddr expr)) "}"))
        ((define) (conc ";var " (cadr expr) "="
                        (scm->js (caddr expr)) ";"))
        ((+ - * / < >)  (infix-op (car expr) (cdr expr)))
        ((=)  (infix-op '== (cdr expr)))
        ((or) (infix-op "||" (cdr expr)))
        ((and) (infix-op "&&" (cdr expr)))
        ((let) (conc "(function(){"
                     (string-intersperse
                      (map (lambda (binding)
                             (conc "var " (car binding) "="
                                   (scm->js (cadr binding))
                                   ";"))
                           (cadr expr)))
                     (scm-body->js (cddr expr))
                     "})()"))
        ((let*) (scm->js (macroexpand expr)))
        (else (conc (car expr) "("
                    (string-intersperse
                     (map ->string
                          (map scm->js (cdr expr)))
                     ",") ")")))))

(define (js exprs)
  (string-intersperse (map scm->js exprs) ""))

(print (js (read-file (car (command-line-arguments)))))

Alguns exemplos "práticos" estão a seguir. scm2js.scm é o compilador, implementado em Chicken Scheme; js é um interpretador de Javascript que pode ser executado na linha de comando.

Obs.: o código Javascript gerado é bastante indigesto:

$ ./scm2js.scm ex1.scm

;var fatorial=function(n){;return (function(){if(n<1){return(1);}else{return(n*fatorial(n-1));}})();;};print(fatorial(4))

$ cat ex1.scm

(define fatorial
  (lambda (n)
    (if (< n 1)
        1
        (* n (fatorial (- n 1))))))

(print (fatorial 4))

$ ./scm2js.scm ex1.scm | js
24

$ cat ex2.scm

(define a (lambda (n)
            (print "aqui")
            n))
(print (a 6))

$ ./scm2js.scm ex2.scm | js
aqui
6

$ cat ex3.scm

(define x (if #t "ok" "false"))
(print x)

 $ ./scm2js.scm ex3.scm | js
ok

$ cat ex4.scm

(define func
  (lambda (a b c d)
    (let* ((a (+ b c d))
           (dif (- a b c d)))
      (+ a dif))))

(print (func 1 2 3 4))

$ ./scm2js.scm ex4.scm | js
9