Fri Apr 26 17:05:49 JST 2013

計算モデル論を聞きながら, S式からC++への翻訳機を書いてました 面倒になってやめました

実装したトコだけを最大限見せつける実行例

$ gosh test.scm << EOS
(progn
    (include stdio.h)
    '(using name space std)
    (define (int int) (f x)
        (* (+ 1 2 3 4) (/ (- 10)))
        (* x (f (- x 1)))))
EOS

#include <stdio.h>

using name space std;
int f (int x) {
    ((1+2+3+4)*(1/-10));
    return (x*f((x-1)));
}

関数の型指定、なんかコレ気持ち悪いなあとか思ったり cout << ... でも実装しようかなあとか思ってたら 授業が終ったのでお遊びもやめにしました

(define (translate exp)
    (if (symbol? exp) (symbol->string exp)
    (if (number? exp) (number->string exp)
    (if (null? exp) ""

    (case (car exp)
        ((progn)       (string-join (map translate (cdr exp)) "\n"))
        ((include)     (format "#include <~a>\n" (cadr exp)))
        ((quote)
            (string-append
                (string-join (map symbol->string (cadr exp)) " ")
                ";"))
        ((define)
            (let ((funt (caadr exp))
                  (argt (cdadr exp))
                  (fun  (caaddr exp))
                  (args (cdaddr exp)))
            (define (append-return ls)
                (if (= (length ls) 1)
                    (list (string-append "return " (car ls)))
                    (cons (car ls) (append-return (cdr ls)))))
            (format
                "~a ~a (~a) {\n\t~a;\n}"
                funt fun
                (string-join
                    (map (cut format "~a ~a" <> <>) argt args) ", ")
                (string-join
                    (append-return (map translate (cdddr exp))) ";\n\t"))))

        ((+ - * /)
            (cond ((and (eq? (car exp) '-) (= (length exp) 2))
                   (format "-~a" (cadr exp)))
                  ((and (eq? (car exp) '/) (= (length exp) 2))
                   (format "(1/~a)" (translate (cadr exp))))
                  (else
                        (string-append
                            "("
                            (string-join
                                (map translate (cdr exp))
                                (symbol->string (car exp)))
                            ")"))))

        (else
            (format "~a(~a)" (car exp)
                    (string-join (map translate (cdr exp)) ", "))))))))

(display
    (translate (read)))