On a whim one night, I made up a very simple language called LISP-LITE which is really a subset of C in lisp syntax form. Then I wrote a Common Lisp translator for the sexp representation of it to C. None of this is new and the technique is as old as dirt, but it was fun and had high hack value. One day I might extend it into the inside of a Common Lisp compiler in order to author C in the middle of Lisp while sharing lexical scope and whatnot. Or maybe I'll just drink some more booze and listen to more Death Metal. You never know...

Edit: I fixed the code to actually produce compilable C and emit the semicolons where they should have been emitted in the translator.

;; A late night hack cause I was bored and curious.
;; This code is under the Apache v2.0 license.
;; Peter Keller (psilord@cs.wisc.edu)
;;
;; A brain dead translator from a lisp-like language (described below) to C.
;; See Structure and Interpretation of Computer Programs for a very full
;; explanation of this idea. Lisp in Small Pieces builds entire compilers
;; based upon this idea. Homoiconicity is what makes lisp so appealing to me,
;; far more than most other languages.

;; LISP-LITE is defined thusly:
;; cfunc defines a function which must include types in the param list.
;; All function names are translated to lower case.
;; (cfunc name ((type1 var1) (type2 var2) ...) ...)
;;
;; creturn does a c return on an expression
;; (creturn expr)
;;
;; cassign assigns the value of an expression to a symbol
;; (cassign symbol value)
;;
;; clet allows one to declare new variables for later use.
;; (clet ((type1 var1) (type2 var2) ..) ...)
;;
;; cif allows a choice to be made
;; (cif cond-expr true-expr false-expr)
;;
;; cliteral allows emitting of here-doc style lisp code.
;; (cliteral "#include <stdio.h>")
;;
;; Operators + - * / < > <= >= MUST take two arguments only
;;
;; No closures or anything cool like that, just a very simple translator

;; Simple emitter function.
(defmacro emit (fmt &rest args)
  `(format t ,fmt ,@args))

;; Translate a form, and all subforms, into C.
(defun xlate (form)
  (cond
    ;; In LISP-LITE, I'm loosly defining a number. The long and the
    ;; short of it is, don't use rationals, complex numbers, etc.
    ((numberp form)
     (emit "~A" form))

    ;; All variables are lower case. You should only use valid C tokens.
    ((symbolp form)
     (emit "~(~A~)" form))

    ((stringp form)
     (emit "\"~A\"" form))

    ((equal (car form) 'cfunc)
     (apply #'xlate-cfunc (cdr form)))

    ((equal (car form) 'creturn)
     (apply #'xlate-creturn (cdr form)))

    ((intersection '(+ - * / < > == <= >=) (list (car form)))
     (xlate-op form))

    ((equal (car form) 'cassign)
     (xlate-cassign (cdr form)))

    ((equal (car form) 'clet)
     (apply #'xlate-clet (cdr form)))

    ((equal (car form) 'cfuncall)
     (apply #'xlate-cfuncall (cdr form)))

    ((equal (car form) 'cif)
     (apply #'xlate-cif (cdr form)))

    ;; Dump a here-doc-like string out which is C code.
    ;; Used when I need boilerplate code.
    ((equal (car form) 'cliteral)
     (apply #'xlate-cliteral (cdr form)))

    (t
     (emit "PARSE ERROR: ~A~%" (car form)))))

(defun xlate-cfunc (return-type name args &rest body)

  ;; emit function header
  (emit "/* Translating function ~(~A~) */~%" name)
  (emit "~(~A~) ~(~A~)" return-type name)

  ;; emit arguments, slather love on format.
  (emit "(~{~{~(~A~) ~(~A~)~}~^, ~})~%" args)

  (emit "{~%")
  ;; emit all body expressions
  (dolist (form body)
    (xlate form)
    (emit ";~%"))
  (emit "}~%"))

(defun xlate-creturn (form)
  (emit "return ")
  (xlate form))

;; (+ 1 2) === 1 + 2
(defun xlate-op (form)
  (emit "(")
  (xlate (cadr form))
  (emit " ~A " (car form))
  (xlate (caddr form))
  (emit ")"))

;; (cassign x 10) === x = 10
(defun xlate-cassign (form)
  (emit "~(~A~) = " (car form))
  (xlate (cadr form)))

(defun xlate-clet (bindings &rest body)
  ;; in a new scope
  (emit "{ /* new scope for clet */~%")

  ;; emit declarations
  (dolist (b bindings)
    (emit "~(~A~) ~(~A~);~%" (car b) (cadr b)))

  ;; emit all body expressions
  (dolist (form body)
    (xlate form)
    (emit ";~%"))

  ;; close scope
  (emit "}~%"))

(defun xlate-cfuncall (name &rest params)
  (emit "~(~A~)(" name)

  ;; This is just to get the commas right cause my format-fu isn't up to
  ;; snuff...
  (dotimes (idx (length params))
    (xlate (nth idx params))
    (when (/= idx (1- (length params)))
      (emit ", ")))

  (emit ")"))

;; We only allow one expression, like lisp, need cprogn equivalent to have a
;; translation into C.
(defun xlate-cif (conditional true false)
  (emit "if (")
  (xlate conditional)
  (emit ") {~%")
  (xlate true)
  (emit ";~%")
  (emit "} else {~%")
  (xlate false)
  (emit ";~%")
  (emit "}~%"))

(defun xlate-cliteral (form)
  (emit "/* Boilerplate code */~%")
  (emit "~A~%" form))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This is a set of macros to test xlate.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Translate exactly one form.
(defmacro xlate-test (form)
  (let ((f (gensym)))
    `(let ((,f ,form))
       (terpri)
       (emit "--------------------------------------------------~%")
       (emit "TESTING LISP-LITE FORM~%")
       (emit "--------------------------------------------------~%")
       (emit "~S~%" ,f)
       (emit "--------------------------------------------------~%")
       (emit "TRANSLATION TO C~%")
       (emit "--------------------------------------------------~%")
       (xlate ,f))))

;; Translate a list of forms.
(defmacro xlate-forms (forms)
  (let ((fs (gensym)))
    `(let ((,fs ,forms))
       (terpri)
       (emit "--------------------------------------------------~%")
       (emit "TESTING LISP-LITE FORM~%")
       (emit "--------------------------------------------------~%")
       (emit "~S~%" ,fs)
       (emit "--------------------------------------------------~%")
       (emit "TRANSLATION TO C~%")
       (emit "--------------------------------------------------~%")
       (mapc #'xlate ,fs))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Try it out
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Simple function translation
(xlate-test
 '(cfunc int thingy ((int x) (float c))
   (creturn (+ x c))))

;; Does it do operator precedence correctly?
(xlate-test
 '(cfunc int thingy ((int x) (float c))
   (creturn (+ (- 1 3) (* x c)))))

;; assign the value (+ c 10) to x
(xlate-test
 '(cfunc int thingy ((int x) (float c))
   (cassign x (+ c 10))
   (creturn (+ (- 1 3) (* x c)))))

;; Open a new scope and use the variables.
(xlate-test
 '(cfunc int thingy ((int x) (float c))
   (clet ((int a) (float b))
    (cassign a 10)
    (cassign b 20)
    (creturn (+ x (+ c (* a b)))))))

;; And now for something completely different:
;; A real piece of lisp-lite code translated into real C!
;; Convert all blocks of lisp-lite into C
;; Fibonacci Function
(xlate-forms
 '(
   ;; Form 1 is a chunk of boiler plate C
   (cliteral
    "#include <stdio.h>
#include <stdlib.h>")

   ;; Form 2 is the Fibonacci function.
   (cfunc int fib ((int n))
    (cif (< n 2)
     (creturn n)
     (creturn
      (+ (cfuncall fib (- n 1))
         (cfuncall fib (- n 2))))))

   ;; Form 3 is the main function.
   ;; Play loosely with lisp-identifiers versus C identifiers for the type
   ;; of argv.
   (cfunc int main ((int argc) (char** argv))
    ;; Would need to handle string output a little better to handle
    ;; escaped characters.
    (cfuncall printf "output: %d\\n" (cfuncall fib 10))
    (creturn 0))))

And here is the output.

--------------------------------------------------
TESTING LISP-LITE FORM
--------------------------------------------------
(CFUNC INT THINGY ((INT X) (FLOAT C)) (CRETURN (+ X C)))
--------------------------------------------------
TRANSLATION TO C
--------------------------------------------------
/* Translating function thingy */
int thingy(int x, float c)
{
return (x + c);
}

--------------------------------------------------
TESTING LISP-LITE FORM
--------------------------------------------------
(CFUNC INT THINGY ((INT X) (FLOAT C)) (CRETURN (+ (- 1 3) (* X C))))
--------------------------------------------------
TRANSLATION TO C
--------------------------------------------------
/* Translating function thingy */
int thingy(int x, float c)
{
return ((1 - 3) + (x * c));
}

--------------------------------------------------
TESTING LISP-LITE FORM
--------------------------------------------------
(CFUNC INT THINGY ((INT X) (FLOAT C)) (CASSIGN X (+ C 10))
 (CRETURN (+ (- 1 3) (* X C))))
--------------------------------------------------
TRANSLATION TO C
--------------------------------------------------
/* Translating function thingy */
int thingy(int x, float c)
{
x = (c + 10);
return ((1 - 3) + (x * c));
}

--------------------------------------------------
TESTING LISP-LITE FORM
--------------------------------------------------
(CFUNC INT THINGY ((INT X) (FLOAT C))
 (CLET ((INT A) (FLOAT B)) (CASSIGN A 10) (CASSIGN B 20)
  (CRETURN (+ X (+ C (* A B))))))
--------------------------------------------------
TRANSLATION TO C
--------------------------------------------------
/* Translating function thingy */
int thingy(int x, float c)
{
{ /* new scope for clet */
int a;
float b;
a = 10;
b = 20;
return (x + (c + (a * b)));
}
;
}

--------------------------------------------------
TESTING LISP-LITE FORM
--------------------------------------------------
((CLITERAL "#include <stdio.h>
#include <stdlib.h>")
 (CFUNC INT FIB ((INT N))
  (CIF (< N 2) (CRETURN N)
   (CRETURN (+ (CFUNCALL FIB (- N 1)) (CFUNCALL FIB (- N 2))))))
 (CFUNC INT MAIN ((INT ARGC) (CHAR** ARGV))
  (CFUNCALL PRINTF "output: %d\\n" (CFUNCALL FIB 10)) (CRETURN 0)))
--------------------------------------------------
TRANSLATION TO C
--------------------------------------------------
/* Boilerplate code */
#include <stdio.h>
#include <stdlib.h>
/* Translating function fib */
int fib(int n)
{
if ((n < 2)) {
return n;
} else {
return (fib((n - 1)) + fib((n - 2)));
}
;
}
/* Translating function main */
int main(int argc, char** argv)
{
printf("output: %d\n", fib(10));
return 0;
}

I could have made the LISP-LITE language even closer to a subset of lisp (so close, that they could be indistinguishable), but I didn't because I was curious about the LISP-LITE syntax itself and translating it into C. I wasn't concerned about preserving the semantics of Common Lisp for this example.

Ack! I spilled my Vodka! Oh, no... never mind... it was just my dreams.

End of Line.