Home

Awesome

LISP/c (Lispsy)

UPDATE

I am working on version 2 again. Sorry it took so long – life happened.

Stay Tuned!

Version 2.0 is coming out very soon. It'll have support for at least SBCL if not a few other versions, and preliminary tests show that it's generating much more readable code (with "proper" indentations and everything).

Installing

To install, simply go into the directory that you downloaded everything into, run clisp, and type (load "c.lisp"). To compile a cl file into a c file, type (c-cl-file source.cl dest.c). To compile and run a cl file, type in (compile-and-run-cl-file file.cl). More documentation on this part to come. <sup><sub>TODO</sub></sup>

NOTE: The way it is currently written, it may have to be loaded more than once. I'm looking into this and refactoring the code to run the first time at the moment. <sup><sub> TODO </sub></sup>

Resources

To learn C, I recommend The C Programming Language by Brian W. Kernighan (ISBN-10 0131103628, ISBN-13 978-0131103627). TO learn LISP, I recommend Practical Common Lisp by Peter Seibel. This can be found either here or as a hard copy (ISBN-10 1590592395, ISBN-13 978-1590592397). Also, it is currently required that you use CLISP to run the code here.. This will change <sup><sub>TODO</sub></sup>.

To learn CUDA, I recommend the resources found here, and to learn MPI, I recommend the resources found here.

Introduction

LISP/c is a powerful macrolanguage for C. It basically turns this:

(header stdio)
(main
  (@printf (str "Hello, world!"))
  (return 0))

into (after it being cleaned up (more on this later)) this:

#include <stdio.h>

int main(int argc,char **argv)
{
   printf("Hello, world!");
   return 0;
}

But why?

Why

First, you might check out this video. Because LISP is expressive and C is fast and I wanted the best of both worlds is the short answer. The longer answer has something to do with macros. But instead of immediately boring you with that, I'll answer what you really want to know:

Why Should I Care?

First let's discuss if you can use it. Not to be elitist (I wish everyone would use this tool), but you must know both C and LISP fairly well to be able to use LISP/c.

Suppose, however, that you do already know both LISP and C pretty well. You might want to use LISP/c because it features access to LISP to write C code both implicitly and explicitly. You might also want to use it if you like writing CUDA code, because it has built-in support for CUDA as well.

But really, to see why you might like to use LISP/c, check out a few examples, and feel free to skip around a little.

An Example

Suppose that you're writing a function that you'd like to write for several different types of variable types that use similar notation. You can do this easily with the templates built into LISP/c:

int foo_int(int x, int y) {
  return x + y * 2;
}
float foo_float(float x, float y) {
  return x + y * 2;
}
// etc.

It's true that you can just use a long macro in C to get rid of the annoying task, but it's a bit awkward. You can do the same in LISP/c using the following notation (with template):

(template make-foo (typ)
  (func (add/sym foo- typ) typ ((x typ) (y typ))
    (return (+ x (* y 2)))))
(make-foo int) (make-foo long) (make-foo float) (make-foo etc)

Or even like this (with templates):

(templates make-foo (typ)
  (func (add/sym foo- typ) typ ((x typ) (y typ))
    (return (+ x (* y 2)))))
(make-foos int long float etc)

And just like that, you have a bunch of functions written. Now to get you sort of grounded, let's go through this element by element.

Beyond Templates

If you know what you're doing, you can use lispmacros. One useful example is the following:

(lispmacro class (nym vars)
  (c `(progn
        (typedef (struct ,nym) ,nym)
        (struct ,nym ,vars))))

Then you can write code like

(class cell
  (((pt car) cell)
   ((pt cdr) cell)
   ((pt etc) void)))

And have it compile to (after cleaning it up a bit):

typedef struct cell cell;  
struct cell{
    cell *car;
    cell *cdr;
    void *etc;
};

The lisp/c-macro

This is a form of the template which allows you to write macros directly, more or less. To give you a taste of how this works, we'll start with an example:

(lisp/c-macro for-m (vars nums &rest body)
	(if (or (null vs) (null nums))
		`(block ,body nil)  ;; "NIL" to get rid of extra {}s
		`(for (var ,(car vars) int 0)
			  (< ,(car vars) ,(car ns))
			  (++ ,(car vars))
			  ,(apply for-m (cdr vs) (cdr ns) body)))))

We can now use this in the following manner:

(for-m (i j k l m) (3 3 3 4 5) (@printf (s. "%d %d %d %d %d") i j k l m))

This will compile to:

for(int i=0;((i)<(3));++(i))
{
	for(int j=0;((j)<(3));++(j))
	{
		for(int k=0;((k)<(3));++(k))
		{
			for(int l=0;((l)<(4));++(l))
			{
				for(int m=0;((m)<(5));++(m))
				{
					   printf("%d %d %d %d %d",i,j,k,l,m);
				};
			};
		};
	};
}

Arithmetic

In the above example, you'll notice that we use prefix arithmetic. This is a feature of LISP and not of C. The benefit of using prefix arithmetic is that it allows you to express sums of many terms somewhat more succinctly. That is to say, instead of 2 + 3 + 4 + 5 * 6 + 7 + 8 you can just write (+ 2 3 4 (* 5 6) 7 8).

Functions

Functions have the general form:

(func function-name return-type (variables...) body...)

and convert to

return_type function_name(variables...) {
  body...
}

If you need a function which returns a pointer to something, you can use:

(func (pt function-name 2) return-type ...)

Which turns into

return_type **function_name(...) {...}

Do note that the 2 is required because there are two *s, but if there were only one, you could just use (pt function-name). That's the flexibility that makes LISP/c nice to work with.

There are two ways that functions can be called. Suppose we want to know the value of foo(2,3,4). We can either use:

(call foo 2 3 4)

or

Simplifying Notation

The following are offered in order to simplify common tasks.

The @ Notation

(@foo 2 3 4)

This is the same thing as (call foo 2 3 4) and evaluates to foo(2,3,4). This is used to greatly simplify function calls. Use this whenever possible, since nobody wants to wade through a bunch of call statements. call is mainly useful for template statements. Note that if you put a space between the foo and @, this becomes foo::2::3::4.

The [] Notation

([]foo 2 3 4)

This is the same thing as (nth 2 3 4) and evaluates to (foo)[2][3][4]. It uses the same rationale as above, as do the next few Notations.

The & Notation

(&foo) is the same thing as (addr foo) and evaluates to &(foo).

The ^ Notation

(^foo bar baz) is the same thing as (cast foo bar baz) and evaluates to (after cleanup) (baz)(bar)(foo).

The * Notation

(*foo) is the same thing as (ptr foo) which evaluates to *foo.

The = Notation

This is in case you want camelcase. (=this is a test) compiles to ThisIsATest (as do (=this is a test), (=this "is-a" test), and (=this-is a-test)). This is one of two cases where "..." are not literal.

The % notation

Exactly the same as above, but the first letter is not capitalized. Viz., (%this is a test) turns out to be thisIsATest.

CamelCase

If you really want camelcase and don't want to type parentheses in every time, you can use =this-is-camelcase and -this-is-camelcase almost anywhere to compile to ThisIsCamelcase and thisIsCamelcase respectively. So you can do something like (-desert-oasis =camel-train -camel-same) and expect it to compile to CamelTrain desertOasis = camel_same.

Thing Names

Variable, type, function, etc. (identifier) names are converted using some simple rules. First of all, the -s are turned into _s. Secondly, everything is lower case. If you need to make something upper case entirely, you can prefix it with a ! (so if you need the variable name CONST_FOO you can use !const-foo, !cOnST-FoO, !const_FOO or "CONST_FOO"). The last one may be used because strings are preserved. The others work because LISP is not case-sensitive, so when the variables are rendered, all case is the same. So if you were to use cOnST-FoO instead of !cOnST-FoO, you'd wind up with const_foo instead of CONST_FOO.

Continuing Forward

We need some sort of framework for showing each of the features of LISP/c. So before I go through every function and explain what it does, I'm going to explain a little of what goes on behind the scenes.

C++ Example

LISP/c can write C++ code as well, and has a few functions which are specifically designed for C++.

Here is the "Hello world!" program written in C++ through LISP/c:

(headers++ iostream)
(using std)
(<<+ cout "Hello world!" endl)

You'll notice that we used <<+ instead of <<. This is because <<+, unlike <<, is meant for streams and does not parenthesize.

Variadic Example

This is a simple function to add up a bunch of arguments that end in zero and are all integers.

(f{} add-em-up int (
(first int)
 ---)
(var va-list args)
(@va-start args first)
(var sum first)
(var cur first)
(while (!= cur 0)
	(= cur (@va-arg args int))
	(+= sum cur))
(return sum))

You'll notice that instead of func we used f{}. This is shorthand. A table of shorthand is available nearer the bottom of the page.

Complex C++ Code

Let's say we wanted to enter the following code into LISP/c:

template<typename T>
class Array {
public:
  Array(int len=10)                : len_(len), data_(new T[len]) { }
 ~Array()                          { delete[] data_; }
  int len() const                  { return len_;     }
  const T& operator[](int i) const { return data_[check(i)]; }
  T&       operator[](int i)       { return data_[check(i)]; }
  Array(const Array<T>&);
  Array(Array<T>&&);
  Array<T>& operator= (const Array<T>&);
  Array<T>& operator= (Array<T>&&);
private:
  int len_;
  T*  data_;
  int check(int i) const {
    assert(i >= 0 && i < len_);
    return i;
  }
};

One way of doing so is like this:

(t<> !t typename
	(class (=array)
		(public
			(cx
				((len int 10))
				((len- len) (data- (new (arr !t len)))))
			(destroy nil
				(@delete[] data-))
			(f{} len int ()
				const
				(return len-))
			(op [] (const (t& !t))
				((i int))
				const
				(return ([]data- (@check i))))
			(op [] (t& !t)
				((i int))
				(return ([]data- (@check i))))
			(cx (((t& (const (<> (=array) !t))))))
			(cx (((t& (<> (=array) !t) 2))))
			(op = (t& (<> (=array) !t))
				(((t& (const (<> (=array) !t))))))
			(op = (t& (<> (=array) !t))
				(((t& (<> (=array) !t) 2)))))
		(private
			(var len- int)
			(var data- (t* !t))
			(f{} check int
				((i int))
				const
				(@assert (&& (>= i 0) (< i len-)))
				(return i)))))

Engine

The main file for interacting with LISP/c right now is just using CLISP (for the time being; it will be ported to more versions soon) and typing in (load "c.lisp").

You can test out the engine by either loading in a file using the cwf command and typing (cwf "example.cl"). What you'll see is either an error (because of syntax) or the resultant C code. If you don't have a file that you can experiment with yet, try typing the following:

 (c '(typedef (struct foo (
         bar
         ((pt baz) float) )) qux))

It will result in the following (or similar): I typedef struct foo{ int bar; float *baz;} qux;

This, cleaned up, is:

typedef struct foo {
    int bar;
    float *baz;
} qux;

Future versions of LISP/c will have nicer-looking output C code.

The way that LISP/c works is sort of tricky. It utilizes a lot of string manipulation and interpretation. It doesn't need to be insanely fast, though, because it's just dealing with code; the compiled result will not suffer from any slowness.

Top-Level Functions

These are the functions that are to be run directly from your LISP REPL environment.

(cwf filename)

Prints the compiled C file from the filename containing your LISP/c code.

(compile-cl-file file-in ...arguments... )

This uses gcc to compile your file (at file-in). It takes a number of keyword arguments (expressed as :keyword argument):

KeywordArgument
fileoutexecutable output
tagstags for compilation
libslibraries for compilation
c-fileoutput C file
cccompiler to use

(compile-and-run-cl-file ... )

Uses the same syntax as compile-cl-file.

(c-cl-file file-in c-file )

Compiles LISP/c code into C code from file-in to c-file.

Other conventions

When a LISP/c function such as while is called, it's actually calling a lisp function called while-c. This may change in the future, but is done presently for convenience. <sup><sub>TODO</sub></sup>

An Example: Multithreading

Suppose you want to do some threading using pthreads. You'd start with the headers obviously:

(headers stdio stdlib string pthread)

Not all of these are required, but I included all of them to show that you can. It compiles to the following:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <pthread.h>

Next, we know that we're going to want to create and then join a bunch of threads using a for structure that is almost the same in both cases. Rather than have code duplication on our consciousnesses, we can write a template to take care of this for us:

(TEMPLATE Loop-N (n v maxv body) ... )

We'll finish this in a moment. I changed up the capitalization again just to make it crystal clear that that is a thing you can do and must be aware of. Here, n will be the number of iterations, v will be the variable that we're keeping track with, maxv will be a temporary variable that we store n in (so that if we need to calculate n we're not doing it every time), and body is the body of the for loop.

Finishing up the function, we yield:

(TEMPLATE Loop-N (n v maxv body)
    (block (
        (var v    Integer 0) ;; Integer is a synonym for "int"
        (var maxv Integer n)
        (for () (< v maxv) (++ v)
            body))))
            

You'll notice that Integer is being used in lieu of "int". Next we're going to use templates instead of macros to convert integers to voids and vice versa:

(template void<-int (x) (cast x size-t (typ* void))))
(template int<-void (x) (cast x size-t int))

Here (typ* void) expands to void*. Basically this converts between int and void*. The reason why I chose to use a template instead of a C macro is because of freedom of notation; I wanted to use the arrows.

Next we write the thread function:

(func (pt threadfunc) void               ; void *threadfunc
    ( ((pt x) void) )                    ; (void *x) {
    (var i int (int<-void x))            ; int i = (int)(size_t)x;
    (@printf                             ; printf(
        (str "Hello from thread %d\\n")  ; "Hello from thread %d",
        (+ 1 i))                         ; i+1);
    (return null))                       ; return NULL;}

Hopefully this is fairly self-explanatory. Finally, we write the main function:

(define !nthreads 12) ;; #define NTHREADS 12
(main
    (var (arr threads !nthreads) pthread-t)
    ;; pthread-t threads[NTHREADS];
    (loop-n !nthreads i maxi    ;; loop for i from 1 to NTHREADS...
        (@pthread-create ;; pthread_create(
            (addr ([]threads i)) ;; &threads[i],
            null                 ;; NULL,
            (addr threadfunc)    ;; &threadfunc,
            (void<-int i)))      ;; (void*)(size_t)i);
    (loop-n !nthreads i maxi    ;; loop for i from 1 to NTHREADS
        (@pthread-join (nth threads i) null))
        ;; pthread_join(threads[i], NULL);
    (return 0)) ;; return 0;}

CUDA Example

Here is an adapted version of NVIDIA's code for the Julia set:

(headers
    ("../common/book" :local t)
    ("../common/cpu_bitmap" :local t))

(template sq (x) (* x x))
(define !dim 1000)

(struct cu-complex (
    (r real)
    (i real)))

(template cu-complex-decl (rv iv)
    (cast (arr-decl rv iv) (struct cu-complex)))

(func cu-complex-magnitude float ((x cu-complex))
    (return (+ (sq (.> x i)) (sq (.> x r)))))

(func cu-complex-mul cu-complex ((x cu-complex) (y cu-complex))
    (var z cu-complex)
    (= (.> z r) (-
                    (* (.> x r) (.> y r))
                    (* (.> x i) (.> y i))))
    (= (.> z i) (+
                    (* (.> x i) (.> y r))
                    (* (.> x r) (.> y i))))
    (return z))

(func cu-complex-add cu-complex ((x cu-complex) (y cu-complex))
    (var z cu-complex)
    (= (.> z r) (+ (.> x r) (.> y r)))
    (= (.> z i) (+ (.> x i) (.> y i)))
    (return z))

(cuda/device julia int (x y)
    (const scale float 1.5)
    (template jvar (v)
        (var (sym/add j v) float
            (* scale (cast (/ (- (/ !dim 2) x) (/ !dim 2))))))
    (jvar x) (jvar y)
    (var c (struct cu-complex) (cu-complex-decl -0.8 0.156))
    (var a (struct cu-complex) (cu-complex-decl jx jy))
    (var i int 0)
    (for (= i 0) (< i 200) (++ i)
        (= a (@cu-complex-add (@cu-complex-mul a a) c))
        (if (> (@cu-complex-magnitude a) 1000) (return 0)))
    (return 1)
)

(cuda/global kernel void (((pt ptr) char nil unsigned))
    (var x int block/idx/x)
    (var y int block/idx/y)
    (var offset int (+ x (* y grid/dim/x)))
    (var julia-value int (@julia x y))
    (= ([]ptr (+ 0 (* offset 4))) (* 255 julia-value))
    (= ([]ptr (+ 1 (* offset 4))) 0)
    (= ([]ptr (+ 2 (* offset 4))) 0)
    (= ([]ptr (+ 3 (* offset 4))) 255))

(syn cpubitmap "CPUbitmap")

(main
    (var (@bitmap !dim !dim) cpubitmap)
    (var (pt dev-bitmap) char nil unsigned)
    (@!handle-error
        (@cuda/malloc
            (cast (addr dev-bitmap) (typ* void 2))
            (.> bitmap (@image-size))))
    (var (@grid !dim !dim) dim3)
    (cuda/call kernel (grid 1) dev-bitmap)
    (@!handle-error
        (@cuda/memcpy
            (.> bitmap (@get-ptr))
            dev-bitmap
            (.> bitmap (@image-size))
            cuda/dev->host))
    (.> bitmap (@display-and-exit))
    (@!handle-error
        (@cuda/free dev-bitmap)))

This generates the following C code (after being cleaned up):

#include "../common/book.h"
#include "../common/cpu_bitmap.h"

#define DIM 1000

struct cu_complex{
float r;
float i;
};

float cu_complex_magnitude(cu_complex x)
{
   return (((((x).i)*((x).i)))+((((x).r)*((x).r))));
};

cu_complex cu_complex_mul(cu_complex x,cu_complex y)
{
   cu_complex z;
   (((z).r)=((((((x).r)*((y).r)))-((((x).i)*((y).i))))));
   (((z).i)=((((((x).i)*((y).r)))+((((x).r)*((y).i))))));
   return z;
};

cu_complex cu_complex_add(cu_complex x,cu_complex y)
{
   cu_complex z;
   (((z).r)=((((x).r)+((y).r))));
   (((z).i)=((((x).i)+((y).i))));
   return z;
};

__device__ 
int julia(int x,int y)
{
   const float scale=1.5;
   ;
   float jx=((scale)*(((int)(((((((DIM)/(2)))-(x)))/(((DIM)/(2))))))));
   float jy=((scale)*(((int)(((((((DIM)/(2)))-(x)))/(((DIM)/(2))))))));
   ;
   struct cu_complex c=((struct cu_complex)({-9.8, 0.156}));
   struct cu_complex a=((struct cu_complex)({jx, jy}));
   int i=0;
   
for(((i)=(0));((i)<(200));++(i))
{
   ((a)=(cu_complex_add(cu_complex_mul(a,a),c)));
   
if(((cu_complex_magnitude(a))>(1000))) {
   return 0;
};
};
   return 1;
};

__global__ 
void kernel(unsigned char *ptr)
{
   int x=blockIdx.x;
   int y=blockIdx.y;
   int offset=((x)+(((y)*(gridDim.x))));
   int julia_value=julia(x,y);
   (((ptr)[((0)+(((offset)*(4))))])=(((255)*(julia_value))));
   (((ptr)[((1)+(((offset)*(4))))])=(0));
   (((ptr)[((2)+(((offset)*(4))))])=(0));
   (((ptr)[((3)+(((offset)*(4))))])=(255));
};

;

int main(int argc,char **argv)
{
   CPUbitmap bitmap(DIM,DIM);
   unsigned char *dev_bitmap;
   HANDLE_ERROR(cudaMalloc(((void**)(&(dev_bitmap))),(bitmap).image_size()));
   dim3 grid(DIM,DIM);
   kernel<<<grid,1>>>(dev_bitmap);
   HANDLE_ERROR(cudaMemcpy((bitmap).get_ptr(),dev_bitmap
                (bitmap).image_size(),cudaMemcpyDeviceToHost));
   (bitmap).display_and_exit();
   HANDLE_ERROR(cudaFree(dev_bitmap));
};

MPI Example

LISP/c has support for MPI as well. For example, the following program:

(headers
    (mpi :local t)
    stdio)

(main
    (vars (numtasks rank len rc))
    (var (arr hostname mpi/max/processor/name) char)
    (set rc (@mpi/init (addr argc) (addr argv)))
    (if (neq rc mpi/success)
        (progn
            (@printf
                (str "Error starting MPI program. Terminating.\\n"))
            (@mpi/abort mpi/comm/world rc)))
    (@mpi/comm/size mpi/comm/world (addr numtasks))
    (@mpi/comm/rank mpi/comm/world (addr rank))
    (@mpi/get/processor/name hostname (addr len))
    (@printf
        (str "Number of tasks= %d My rank = %d Running on %s\\n")
        numtasks rank hostname)
    (@mpi/finalize)
)

Compiles to the example program:

#include "mpi.h"
#include <stdio.h>
;

int main(int argc,char** argv)
{
   
int numtasks,
int rank,
int len,
int rc;
   char hostname[MPI_MAX_PROCESSOR_NAME];
   ((rc)=(MPI_Init(&(argc),&(argv))));
   
if(((rc)!=(MPI_SUCCESS))){
   
  printf("Error starting MPI program. Terminating.\n");
  MPI_Abort(MPI_COMM_WORLD,rc);;
};
   MPI_Comm_size(MPI_COMM_WORLD,&(numtasks));
   MPI_Comm_rank(MPI_COMM_WORLD,&(rank));
   MPI_Get_processor_name(hostname,&(len));
   printf("Number of tasks= %d My rank = %d Running on %s\n",numtasks,rank,hostname);
   MPI_Finalize();
};

Synonyms

There are a lot of synonyms present in LISP/c. For example, you may type integer instead of int or integer+ instead of long int. A full list of synonyms can be found in the source code for LISP/c.

A List of Functions

For your convenience, the full list (so far) of functions defined (and documented) in LISP/c are ?, arr, arr-decl, block, call, cast, char, comment, cond, const, cuda/call, cuda/device, cuda/global, cuda/shared, define, do-while, enum, for, func, funcarg, h-file, header, headers, if, import, include, lisp, lispmacro, macro, main, nth, paren, pragma, progn, pt, ptr, return, str, struct, switch, sym/add, syn, template, templates, typ*, typedef, unsyn, var, varlist, vars, and while.

These are functions which exist within LISP/c:

(arr-decl val<sub>1</sub> ... val<sub>n</sub> )

This function declares a literal array of values. It compiles to the C code {val<sub>1</sub>,...,val<sub>n</sub>).

(sym/add val<sub>1</sub> ... val<sub>n</sub> )

This creates a new identifier that is an aggregate of the individual identifiers, as they have been compiled. This works well in template statements.

(typ* type {n (default = 1)}? `)

This creates a pointer type. For example, (typ* integer) compiles to int*, and (typ* char 4) compiles to char****.

(var var {type}? {init}? {modifiers}* )

Declares a variable. If init is specified, it compiles to a declaration of that variable with that type.

(const ... )

Uses the same arguments as var, but puts a const at the beginning automatically. Equivalent to (var ... const).

(syn term synonym )

Looks at both term and synonym and declares that any instance of term by itself will compile to synonym.

(unsyn term )

Declares that term, if it is supposed to compile to any synonym, will no longer do so.

(progn lines )

This just puts a bunch of lines in the slot where one thing should go. Useful in if-else statements.

(? test if-true if-false )

This compiles to a ?: statement. It compiles directly to (test)?:(if-true):(if-false),

(if test if-true if-false )

Like the above, but compiles to an if statement.

(cond {(condition if-true)}* )

Works like the cond statement in LISP, but for C. Does this with a series of if-else statements. The if-true above is a series of statements, not just one.

(main {statements}* )

Creates the main function.

(for start continue-test step {statements}* )

This compiles to a for statement in C.

(while test {statements}* )

Creates a while statement.

(do-while test {statements}* )

Creates a do...while statement, but puts the test at the end where it belongs.

(switch variable {value if-equal {break}?}* )

This creates a switch statement. There is no special treatment of the default clause. If any of the tuples containing the value and the if-equal statement has a third argument (which it does not have to), and that value is anything other than nil, it puts a break; statement into the compiled C.

(ptr x {n (default = 1)}? )

This dereferences x n times. For example (ptr a 2) compiles to **(a).

(pt ... )

This uses the same syntax as ptr does, but it does not put parentheses around the x in question.

(nth value index {indices}* )

This gets the index<sup>th</sup> reference of value. For example, (nth a b) compiles to (a)[b], and (nth a b c) compiles to (a)[b][c].

(arr ... )

This uses the same syntax as nth, but does not put parenthesis around the *value& in question.

(call function-name {arguments}* )

This simply calls function-name with arguments.

(cuda/call function-name spec-list {arguments}* )

This calls the CUDA function with the name function-name with the specifications spec-list. For example, (cuda/call foo (16 32) a b c) compiles to foo<<<16,32>>>(a,b,c).

(str {values}* )

This strings together all the values with spaces between them and formats them as a cstring. Like (str a b "cDe") compiles to "a b cDe".

(char value )

Formats value as a char For example (char x) compiles to 'x', (char \\n) compiles to '\n', and (char "X") compiles to X.

(cast value type {types}* )

This casts value as type, and if types are specified, then if casts them as those too, but in "reverse" order. For example, (cast x abc) compiles to (after code is cleaned up) (abc)x, and (cast x abc def) compiles to (def)(abc)x,

(vars specs-ilsts )

A bunch of variables, comma-separated, with the arguments to each one supplied by an entry in specs-lists.

(varlist ... )

Uses the same syntax as vars, but puts semicolons between the variable declarations.

(struct struct-name ({variables}*) )

Creates a structure named struct-name with variables variables. For example:

(struct foo (
    bar
    (baz qux)
    ((pt xyzzy) foobar)))

Compiles to

struct foo {
    int bar;
    qux baz;
    foobar *xyzzy;
};

(union ... )

Uses the same syntax as above, but is for unions.

(block linelist {bracket? (default = t)}? )

This creates a C block structure. If bracket is set to nil, then it has no brackets around it. This serves mainly as a way to consolidate elements generated for template recipes. I

(func name type {variables}? {body}* )

This creates a function with name *name, type type, variables variables (as processed through the vars facility), and with code inside body. If body is not specified, then there is no code inside the function and it is treated as a function prototype. If variables is set to () or nil, then the variable list will be compiled in C as ().<sub><sup>TODO</sup></sub>

(cuda/global ... )

Uses the same syntax as func, but appends __global__ to the beginning.

(cuda/device ... )

Uses the same syntax as func, but appends __device__ to the beginning.

(funcarg name type variables )

This creates a function argument with name name, type type, and variables variables. For example, funcarg foo bar (int (arg* float))) compiles to bar(*foo)(int,float*).

(return value )

Creates a return statement that returns value.

(typedef old-type new-type )

Creates a simple typedef statement. For example, (typedef (arg* int) intptr) compiles to typedef int* intptr;

(enum enum-name {specs}* )

This creates an enum with the name enum-name and specifications specs. For example, (enum a (b c d)) compiles to enum a{b, c, d}.

(h-file name )

Outputs name.h.

(include name {local: local (default = nil)}? )

Includes a .c or .h file with the name name. If local is specified, then " are used instead of <>.

(import filename )

Imports a .cl file with name filename (if filename is not a string, then .cl is appended). This is the LISP/c version of #include. So far, it does not keep track of directories, so all files included, including files included in files included must be in the same directory. <sup><sub>TODO</sub></sup>

(macro macro-name {macro-args}* )

This creates a simple funcall-type structure, but is meant to be used with define. It was defined early on in development and may be phased out.

(define definer definee )

Makes a #define statement in C with definer being the first argument and definee being the second argument.

(ifdef/ifndef expr )

Creates an #ifdef/#ifndef statement.

(if# expr )

Creates an #if statement.

(else#)

Creates an #else statement.

(endif)

Creates an #endif statement.

(pragma {statements}* )

Makes a #pragma statement in C with each statement separated by a space.

(paren term )

Puts parentheses around term.

(comment {comments}* )

Comments, separated by spaces, are put into a comment form like the following:

The following:

(comment this is "A Comment")
(comment s this is "A Comment")

compile to (respectively):

/*********************/
/* this is A Comment */
/*********************/

/* this is A Comment */

The reason why the second comment was shorter was because it began with an s.

(header name {local: local (default = nil)}? )

Same as include, but automatically adds a .h to the end of name.

(headers argument-lists )

Each argument in the argument list can be an atom, which will be assumed to be a list in the final phase of processing. For example,

(headers foo (bar :local t))

compiles to the C code

#include <foo.h>
#include "bar.h"

This is useful if you have a whole slew of things to include. It's also worth noting that something like (headers arpa/inet) will compile to #include <arpa/inet.h>.

(lisp lisp-code )

Runs LISP code directly. For very low-level maintenance. DO NOT USE UNLESS YOU KNOW WHAT YOU ARE DOING.

(lispmacro name arglist {body}* )

This creates a function in LISP directly with a name callable by LISP/c code as name. Again, THIS IS ONLY TO BE TOUCHED BY PEOPLE WHO KNOW WHAT THEY'RE DOING. YOU CAN SCREW UP THE WHOLE ENGINE.

(template name arguments form )

Creates a new function with the name name with arguments arguments and form form. Examples of template code have been given. It's really quite a simple function.

(templates name arguments form )

This does not quite work as well as it should yet <sup><sub>TODO</sub></sup> It's meant to work on lists of arguments.

(cuda/shared variable )

Creates a cuda __shared__ variable.

(funcall func {arguments}* )

Calls the function func on the arguments

(apply func arguments )

Calls the function func on the arguments

A List of C++ Functions

This list will be completed <sub><sup>TODO</sup></sub>

(headers++ {headers}* )

Puts #include statements, but without appending .h.

(namespace {terms}* )

Puts a :: between the terms with no parentheses.

(typ& nym {n (default=1)}? )

(typ& foo 2) will evaluate to foo&&, and (typ& foo) will evaluate to foo&.

(ptr& ... )

Uses same syntax as above, but (ptr& foo 3) will evaluate to &&&foo.

(class class-name {terms}*)

This will define a class named class-name with the code inside defined by terms.

(protected {terms}* )

Declares a section of code to be protected. Should only be used inside defclass statements.

(private ... )

As above, but with private.

(public ... )

As above, but with public.

(construct args (){(arg var-set)}) {code})

Will create an constructor.

(operator oper type args {code}* )

(decltemp var typ {code}* )

Can be also called with the synonym t<>. Creates a template statement with code after it. For example, (var pi !t (@!t 3.14) (t<> typename !t) constexpr) evaluates to template <T typename> constexpr T pi=T(3.14).

(temp identifier type )

Creates a template variable statement. Can also be accessed with the synonym <>. For example, (<> foo bar) evaluates to foo<bar>, and

(t<> nil nil
    (func bool (<> max bool) (
        (a bool) (b bool))
        (return (or a b))))

returns

template <>
bool max<bool>(bool a,bool b)
{
   return ((a)||(b));
}

(using namespace-name )

This simply returns using namespace followed by the name of the namespace. For example, (using foo) returns using namespace foo;.

(new {terms}* )

Simply appends new to the terms.

(<<+ {terms}* )

This has a bunch of terms separated by <<s. Meant for stream operators. It does not insert any new parentheses.

(>>+ ... )

As above, but with >>s. No parentheses either.

Binomial Operators

These include +, -, and the like. Each of these has a number of synonyms: These can take more than two arguments. For example,(- a b c) will come out to (after cleaning up the code) (a-b)-c or a-b-c. These are left or right reductive depending on whether they are in C or not.

=

This can be accessed through = set let <- and :=.

!=

This can be accessed through != neq diff and different.

==

This can be accessed through == eq and same.

<

This can be accessed through < and lt.

>

This can be accessed through > and gt.

<=

This can be accessed through <= leq and le.

>=

This can be accessed through >= geq and ge.

&&

This can be accessed through && and et und and y.

&

This can be accessed through & bit-and band .and bit-et bet .et bit-und bund .und bit-y through .y and ``.

&=

This can be accessed through &= &-eq bit-and-eq band-eq .and-eq bit-et-eq bet-eq .et-eq bit-und-eq bund-eq .und-eq bit-y-eq through-eq .y-eq &= bit-and= band= .and= bit-et= bet= .et= bit-und= bund= .und= bit-y= through= .y= and ``.

||

This can be accessed through or uel oder and o.

|

This can be accessed through bit-or .or bor bit-uel .uel buel bit-oder .oder boder bit-o .o and bo.

|=

This can be accessed through bit-or-eq .or-eq bor-eq bit-uel-eq .uel-eq buel-eq bit-oder-eq .oder-eq boder-eq bit-o-eq .o-eq bo-eq bit-or= .or= bor= bit-uel= .uel= buel= bit-oder= .oder= boder= bit-o= .o= and bo=.

+

This can be accessed through + plus add and sum.

+=

This can be accessed through += plus-eq add-eq sum-eq plus= add= and sum=.

-

This can be accessed through - minus subtract and sub.

-=

This can be accessed through -= minus-eq subtract-eq sub-eq minus= subtract= and sub=.

*

This can be accessed through * times product mul and multiply.

*=

This can be accessed through *= times-eq product-eq mul-eq multiply-eq times= product= mul= and multiply=.

/

This can be accessed through / quotient ratio div and divide.

/=

This can be accessed through /= quotient-eq ratio-eq div-eq divide-eq quotient= ratio= div= and divide=.

%

This can be accessed through modulo mod and remainder.

%=

This can be accessed through modulo-eq mod-eq remainder-eq modulo= mod= and remainder=.

<<

This can be accessed through << l-shift shift-left and shl.

<<=

This can be accessed through <<= l-shift-eq shift-left-eq shl-eq l-shift= shift-left= and shl=.

>>

This can be accessed through >> r-shift shift-right and shr.

>>=

This can be accessed through >>= r-shift-eq shift-right-eq shr-eq >>= r-shift= shift-right= and shr=.

->

This can be accessed through -> and slot.

.

This can be accessed through mem and .>.

Monomial Operators

These are operators that take in exactly one argument.

++ (pre)

This is the pre-increment (++x) operator. It can be accessed through ++ inc +inc incr pre++ +1 and ++n.

++ (post)

This is the post-increment (x++) operator. It can be accessed through +++ pinc inc+ pincr post++ 1+ and n++.

-- (pre)

This is the pre-decrement (--x) operator. It can be accessed through -- dec -dec decr pre-- -1 and --n.

-- (post)

This is the post-decrement (x--) operator. It can be accessed through --- pdec dec- pdecr post-- 1- and n--.

-

This is the negation (-x) operator. It can be accessed through neg.

&

This is the address-of (&x) operator. It can be accessed through addr memloc and loc.

!

This is the not (!x) operator. It can be accessed through ! not un a and flip.

~

This is the bit-not (~x) operator. It can be accessed through ~ bit-not bit-un bit-a and bit-flip.

So along with synonyms, the code (adapted from the website linked to here):

#include <iostream>
#include <initializer_list>

template<class T> void print_list (std::initializer_list<T> il) {
  for (const T* it=begin(il); it!=end(il); ++it) std::cout << ' ' << *it;
  std::cout << '\n';
}

int main ()
{
  print_list ({10,20,30});
  return 0;
}

Can be written in LISP/c as (with the Synonyms below):

(h+ iostream initializer-list) 
(t<> !t class
    (f{} print-list void (
        (il (ns std (<> initializer-list !t))))
        
        (for
            (v it (t* !t) (@begin il) const)
            (!= it (@end il))
            (++ it)
            
            (<<+ (ns std cout) (ch " ") (p* it))
            (<<+ (ns std cout) (ch \\n)))))
(m
    (@print-list ({}s 10 20 30))
    (return 0))

Here's another C++ example (adapted from here):

(h+ iostream)
(using std)
(t<> !T class nil
	(c. vec
		(pu.
			(cx ((f1 !T) (f2 !T)) ((x f1) (y f2)))
			(cx)
			(v x !T) (v y !T)
			(op + vec ((v (t& vec) () const))
				(v result vec)
				(!! abc(z) (= (.> result z) (+ (-> this z) (.> v1 z))))
				(abc x) (abc y)
				(return result)))))
(t<> !T class nil
	(op << (t& ostream) ((stream (t& ostream))(v (<> vec !T)))
	(<<+ cout (s. "(") (.> v x) (s. ",") (.> v y) (s. ")"))
	(return stream)))
(main
	(v (@v1 3 6) (<> vec int))
	(v (@v2 2 -2) (<> vec int))
	(v v3 (<> vec int) (+ v1 v2))
	(<<+ cout (s. "v3 = ") v3 endl)
	
	(v (@v4 1.2 3.4) (<> vec float))
	(v (@v5 2.6 7.13) (<> vec float))
	(v v6 (<> vec float) (+ v4 v5))
	(<<+ cout (s. "v6 = ") v6 endl)
	(return 0))
	

After some cleanup, this compiles to:

#include<iostream>
using namespace std;
template <class T>
class vec
{
public:
  vec(T f1,T f2) : x(f1), y(f2)
  {
  };
  vec()
  {
  };
  T x;
  T y;
  vec operator+(const vec& v)
  {
    vec result;
    (((result).x)=((((this)->x)+((v).x))));
    (((result).y)=((((this)->y)+((v).y))));
    return result;
  };
};
template <class T>
ostream& operator<<(ostream& stream, vec<T> v)
{
  cout << "(" << (v).x << "," << (v).y << ")";
  return stream;
};
int main(int argc,char **argv)
{
  vec<int> v1(3,6);
  vec<int> v2(2,-2);
  vec<int> v3=((v1)+(v2));
  cout << "v3 = " << v3 << endl;
  vec<float> v4(1.2,3.4);
  vec<float> v5(2.6,7.13);
  vec<float> v6=((v4)+(v5));
  cout << "v6 = " << v6 << endl;
  return 0;
};

What's With the Slashes?

You'll notice that mpi/comm/size compiles to MPI_Comm_size and that cuda/dev->host compiles to cudaMemcpyDeviceToHost. This is because external libraries are given support in this manner (with slashes).

Synonyms

General

TermReplacement
nullNULL
arg/cargc
arg/countargc
arg/vargv
arg/valuesargv
size/tsize_t
integerint
integer+long
naturalunsigned int
natural+unsigned long
realfloat
real+double
booleanchar
stringcchar*
---...
-##
-####
-va-args-<sup><sub> _ _ </sub></sup> VA_ARGS <sup><sub> _ _ </sub></sup>
-empty-" "

For Convenience

TermReplacement
--" "
$nil/()
@" "
namespacen/s
namespacens
typ*t*
typ&t&
ptrp*
ptr&p&
ptr&var&
varv
classc.
defclassd/c
operatorop
operatoropr
constructcx
returnr
headershh
headers++h+
headerh
typedeft/d
nthn.
nthno.
nthnn
arrar
arr-decl{}s
mainm
whilew
do-whiled/w
forf
arra.
charch
strs.
varlistv/l
switchsx
callc
structs{}
structsx
blockb
defined#
pragmap#
publicpu.
privatepr.
protectedpx.
friendfr.
templatetmplt
template!!
templates!!!
templatet.
templatest..
camelcasecamel
lcamelcaselcamel
capitalizecap
uncapitalize!cap
lowercaselcase
uppercaseucase
dashify-ify
commentcmt
commentz
comment/*
comment++cmt+
comment++cmt++
comment++z+
comment++//
temp<>
decltemp<t>
decltempt<>
<<+<stream
<<+<<stream
<<+<stream<
<<+stream<
<<+stream<<
<<+<<<
>>+stream>
>>+stream>>
>>+>stream
>>+>>stream
>>+>>>
try-catcht/c

CUDA

TermReplacement
cuda/malloccudaMalloc
cuda/memcpycudaMemcpy
cuda/freecudaFree
cuda/host->devcudaMemcpyHostToDevice
cuda/dev->hostcudaMemcpyDeviceToHost
cuda/dev/countcudaDeviceCount
cuda/dev/setcudaSetDevice
cuda/dev/getcudaGetDevice
cuda/dev/propscudaDeviceProperties
cuda/sync__syncthreads
block/idxblockIdx
block/idx/xblockIdx.x
block/idx/yblockIdx.y
block/idx/zblockIdx.z
thread/idxthreadIdx
thread/idx/xthreadIdx.x
thread/idx/ythreadIdx.y
thread/idx/zthreadIdx.z
block/dimblockDim
block/dim/xblockDim.x
block/dim/yblockDim.y
block/dim/zblockDim.z
grid/dimgridDim
grid/dim/xgridDim.x
grid/dim/ygridDim.y
grid/dim/zgridDim.z
dim/blockdimBlock
dim/griddimGrid

Pthreads

TermReplacement
pthread/createpthread_create
pthread/equalpthread_equal
pthread/exitpthread_exit
pthread/joinpthread_join
pthread/selfpthread_self
pthread/mutex/initpthread_mutex_init
pthread/mutex/destroypthread_mutex_destroy
pthread/mutex/lockpthread_mutex_lock
pthread/mutex/trylockpthread_mutex_trylock
pthread/mutex/unlockpthread_mutex_unlock
pthread/cond/initpthread_cond_init
pthread/cond/destroypthread_cond_destroy
pthread/cond/waitpthread_cond_wait
pthread/cond/timedwaitpthread_cond_timedwait
pthread/cond/signalpthread_cond_signal
pthread/cond/broadcastpthread_cond_broadcast
pthread/oncepthread_once
pthread/key/createpthread_key_create
pthread/key/deletepthread_key_delete
pthread/setspecificpthread_setspecific
pthread/getspecificpthread_getspecific
pthread/cleanup/pushpthread_cleanup_push
pthread/cleanup/poppthread_cleanup_pop
pthread/attr/initpthread_attr_init
pthread/attr/destroypthread_attr_destroy
pthread/attr/getstacksizepthread_attr_getstacksize
pthread/attr/setstacksizepthread_attr_setstacksize
pthread/attr/getdetachstatepthread_attr_getdetachstate
pthread/attr/setdetachstatepthread_attr_setdetachstate
flockfileflockfile
ftrylockfileftrylockfile
funlockfilefunlockfile
getc/unlockedgetc_unlocked
getchar/unlockedgetchar_unlocked
putc/unlockedputc_unlocked
putc/unlockedputc_unlocked
pthread/detachpthread_detach
pthread/threads/maxPTHREAD_THREADS_MAX
pthread/keys/maxPTHREAD_KEYS_MAX
pthread/stack/minPTHREAD_STACK_MIN
pthread/create/detachedPTHREAD_CREATE_DETACHED
pthread/create/joinablePTHREAD_CREATE_JOINABLE

MPI

TermReplacement
mpi/successMPI_SUCCESS
mpi/err/bufferMPI_ERR_BUFFER
mpi/err/countMPI_ERR_COUNT
mpi/err/typeMPI_ERR_TYPE
mpi/err/tagMPI_ERR_TAG
mpi/err/commMPI_ERR_COMM
mpi/err/rankMPI_ERR_RANK
mpi/err/requestMPI_ERR_REQUEST
mpi/err/rootMPI_ERR_ROOT
mpi/err/groupMPI_ERR_GROUP
mpi/err/opMPI_ERR_OP
mpi/err/topologyMPI_ERR_TOPOLOGY
mpi/err/dimsMPI_ERR_DIMS
mpi/err/argMPI_ERR_ARG
mpi/err/unknownMPI_ERR_UNKNOWN
mpi/err/truncateMPI_ERR_TRUNCATE
mpi/err/otherMPI_ERR_OTHER
mpi/err/internMPI_ERR_INTERN
mpi/pendingMPI_PENDING
mpi/err/in/statusMPI_ERR_IN_STATUS
mpi/err/lastcodeMPI_ERR_LASTCODE
mpi/bottomMPI_BOTTOM
mpi/proc/nullMPI_PROC_NULL
mpi/any/sourceMPI_ANY_SOURCE
mpi/any/tagMPI_ANY_TAG
mpi/undefinedMPI_UNDEFINED
mpi/bsend/overheadMPI_BSEND_OVERHEAD
mpi/keyval/invalidMPI_KEYVAL_INVALID
mpi/errors/are/fatalMPI_ERRORS_ARE_FATAL
mpi/errors/returnMPI_ERRORS_RETURN
mpi/max/processor/nameMPI_MAX_PROCESSOR_NAME
mpi/max/error/stringMPI_MAX_ERROR_STRING
mpi/charMPI_CHAR
mpi/shortMPI_SHORT
mpi/intMPI_INT
mpi/longMPI_LONG
mpi/unsigned/charMPI_UNSIGNED_CHAR
mpi/unsigned/shortMPI_UNSIGNED_SHORT
mpi/unsignedMPI_UNSIGNED
mpi/unsigned/longMPI_UNSIGNED_LONG
mpi/floatMPI_FLOAT
mpi/doubleMPI_DOUBLE
mpi/long/doubleMPI_LONG_DOUBLE
mpi/byteMPI_BYTE
mpi/packedMPI_PACKED
mpi/float/intMPI_FLOAT_INT
mpi/double/intMPI_DOUBLE_INT
mpi/long/intMPI_LONG_INT
mpi/2intMPI_2INT
mpi/short/intMPI_SHORT_INT
mpi/long/double/intMPI_LONG_DOUBLE_INT
mpi/long/long/intMPI_LONG_LONG_INT
mpi/ubMPI_UB
mpi/lbMPI_LB
mpi/comm/worldMPI_COMM_WORLD
mpi/comm/selfMPI_COMM_SELF
mpi/identMPI_IDENT
mpi/congruentMPI_CONGRUENT
mpi/similarMPI_SIMILAR
mpi/unequalMPI_UNEQUAL
mpi/tag/ubMPI_TAG_UB
mpi/ioMPI_IO
mpi/hostMPI_HOST
mpi/wtime/is/globalMPI_WTIME_IS_GLOBAL
mpi/maxMPI_MAX
mpi/minMPI_MIN
mpi/sumMPI_SUM
mpi/prodMPI_PROD
mpi/maxlocMPI_MAXLOC
mpi/minlocMPI_MINLOC
mpi/bandMPI_BAND
mpi/borMPI_BOR
mpi/bxorMPI_BXOR
mpi/landMPI_LAND
mpi/lorMPI_LOR
mpi/lxorMPI_LXOR
mpi/group/nullMPI_GROUP_NULL
mpi/comm/nullMPI_COMM_NULL
mpi/datatype/nullMPI_DATATYPE_NULL
mpi/request/nullMPI_REQUEST_NULL
mpi/op/nullMPI_OP_NULL
mpi/errhandler/nullMPI_ERRHANDLER_NULL
mpi/group/emptyMPI_GROUP_EMPTY
mpi/graphMPI_GRAPH
mpi/cartMPI_CART
mpi/aintMPI_Aint
mpi/statusMPI_Status
mpi/status/ignoreMPI_STATUS_IGNORE
mpi/statuses/ignoreMPI_STATUSES_IGNORE
mpi/groupMPI_Group
mpi/commMPI_Comm
mpi/datatypeMPI_Datatype
mpi/requestMPI_Request
mpi/opMPI_Op
mpi/copy/functionMPI_Copy_function
mpi/delete/functionMPI_Delete_function
mpi/handler/functionMPI_Handler_function
mpi/user/functionMPI_User_function
mpi/initMPI_Init
mpi/comm/sizeMPI_Comm_size
mpi/comm/rankMPI_Comm_rank
mpi/abortMPI_Abort
mpi/get/processor/nameMPI_Get_processor_name
mpi/get/versionMPI_Get_version
mpi/initializedMPI_Initialized
mpi/wtimeMPI_Wtime
mpi/wtickMPI_Wtick
mpi/finalizeMPI_Finalize

Philosophy, Terminology, and Semiotics

The reason why LISP is capitalized in LISP/c and C is not is because it looks more like LISP than C. That's literally the whole reason.

The reason why I keep bolding LISP and C is for quick reference: the LISP-heavy portions and C-heavy portions of this document are intended to be useful to be able to be looked up.

LISP/c is meant to be pronounced "lispsy".

TODO

Add support for error checking.

Add support for OpenMP.

Add support for handling import directives that span multiple directories.

Maybe get away from the name-c pragma.