commit a83bc9783c242ef0783938d8b98cbaf3b4ecb2e9
Author: rxi <rxi@users.noreply.github.com>
Date:   Tue Apr 9 19:50:39 2019 +0100

    Initial commit

diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..c50cd78
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,19 @@
+Copyright (c) 2019 rxi
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..1e8196f
--- /dev/null
+++ b/README.md
@@ -0,0 +1,42 @@
+# fe
+A *tiny*, embeddable language implemented in ANSI C
+
+```clojure
+(= reverse (fn (lst)
+  (let res nil)
+  (while lst
+    (= res (cons (car lst) res))
+    (= lst (cdr lst))
+  )
+  res
+))
+
+(= animals '("cat" "dog" "fox"))
+
+(print (reverse animals)) ; => ("fox" "dog" "cat")
+```
+
+## Overview
+* Supports numbers, symbols, strings, pairs, lambdas, macros
+* Lexically scoped variables, closures
+* Small memory usage within a fixed-sized memory region — no mallocs
+* Simple mark and sweep garbage collector
+* Easy to use C API
+* Portable ANSI C — works on 32 and 64bit
+* Concise — less than 800 sloc
+
+---
+
+* **[Demo Scripts](scripts)**
+* **[Language Overview](doc/lang.md)**
+* **[Implementation Overview](doc/impl.md)**
+
+
+## Contributing
+The library focuses on being lightweight and minimal; pull requests will
+likely not be merged. Bug reports and questions are welcome.
+
+
+## License
+This library is free software; you can redistribute it and/or modify it under
+the terms of the MIT license. See [LICENSE](LICENSE) for details.
diff --git a/doc/impl.md b/doc/impl.md
new file mode 100644
index 0000000..3555a07
--- /dev/null
+++ b/doc/impl.md
@@ -0,0 +1,155 @@
+
+# Implementation
+
+## Overview
+The implementation aims to fulfill the following goals:
+* Small memory usage within a fixed-sized memory region — no mallocs
+* Practical for small scripts (extension scripts, config files)
+* Concise source — less than 1000 loc
+* Portable ANSI C (Windows, Linux, DOS — 32 and 64bit)
+* Simple and easy to understand source
+* Simple and easy to use C API
+
+The language offers the following:
+* Numbers, symbols, strings, pairs, lambdas, macros, cfuncs, ptrs
+* Lexically scoped variables
+* Closures
+* Variadic functions
+* Mark and sweep garbage collector
+* Stack traceback on error
+
+
+## Memory
+The implementation uses a fixed-sized region of memory supplied by the user when
+creating the `context`. The implementation stores the `context` at the start of
+this memory region and uses the rest of the region to store `object`s.
+
+
+## Objects
+All data is stored in fixed-sized `object`s. Each `object` consists of a `car`
+and `cdr`. The lowest bit of an `object`'s `car` stores type information — if
+the `object` is a `PAIR` (cons cell) the lowest bit is `0`, otherwise it is `1`.
+The second-lowest bit is used by the garbage collector to mark the object and is
+always `0` outside of the `collectgarbage()` function.
+
+Pairs use the `car` and `cdr` as pointers to other `object`s. As all
+`object`s are at least 4byte-aligned we can always assume the lower two
+bits on a pointer referencing an `object` are `0`.
+
+Non-pair `object`s store their full type in the first byte of `car`.
+
+##### String
+Strings are stored using multiple `object`s of type `STRING` linked together —
+each string `object` stores a part of the string in the bytes of `car` not used
+by the type and gc mark. The `cdr` stores the `object` with the next part of
+the string or `nil` if this was the last part of the string.
+
+##### Symbol
+Symbols store a pair object in the `cdr`; the `car` of this pair contains a
+`string` object, the `cdr` part contains the globally bound value for the
+symbol. Symbols are interned.
+
+##### Number
+Numbers store a `Number` in the `cdr` part of the `object`. By default
+`Number` is a `float`, but any value can be used so long as it is equal
+or smaller in size than an `object` pointer. If a different type of
+value is used, `lsp_read()` and `lsp_write()` must also be updated to
+handle the new type correctly.
+
+##### Prim
+Primitives (built-ins) store an enum in the `cdr` part of the `object`.
+
+##### CFunc
+CFuncs store a `CFunc` pointer in the `cdr` part of the `object`.
+
+##### Ptr
+Ptrs store a `void` pointer in the `cdr` part of the `object`. The handler
+functions `gc` and `mark` are called whenever a `ptr` is collected or marked by
+the garbage collector — the set `lsp_CFunc` is passed the object itself in place
+of an arguments list.
+
+
+## Environments
+Environments are stored as association lists, for example: an environment with
+the symbol `x` bound to `10` and `y` bound to `20` would be
+`((x . 10) (y . 20))`. Globally bound values are stored directly in the `symbol`
+object.
+
+
+## Macros
+Macros work similar to functions, but receive their arguments unevaluated and
+return code which is evaluated in the scope of the caller. The first time a
+macro is called the code which called it is replaced by the generated code, such
+that the macro itself is only ran once in each place it is called. For example,
+we could define the following macro to increment a value by one:
+
+```clojure
+(= incr
+  (mac (sym)
+    (list '= sym (list '+ sym 1))))
+```
+
+And use it in the following while loop:
+
+```clojure
+(= i 0)
+(while (< i 0)
+  (print i)
+  (incr i))
+```
+
+Upon the first call to `incr`, the program code would be modified in-place,
+replacing the call to the macro with the code it generated:
+
+```clojure
+(= i 0)
+(while (< i 0)
+  (print i)
+  (= i (+ i 1)))
+```
+
+Subsequent iterations of the loop would run the new code which now exists where
+the macro call was originally.
+
+
+## Garbage Collection
+A simple mark-and-sweep garbage collector is used in conjunction with a
+`freelist`. When the `context` is initialized a `freelist` is created from all
+the `object`s. When an `object` is required it is popped from the `freelist`. If
+there are no more `object`s on the `freelist` the garbage collector does a full
+mark-and-sweep, pushing unreachable `object`s back to the `freelist`, thus
+garbage collection may occur whenever a new `object` is created.
+
+The `context` maintains a `gcstack` — this is used to protect `object`s which
+may not be reachable from being collected. These may include, for example:
+`object`s returned after an eval, or a list which is currently being constructed
+from multiple pairs. Newly created `object`s are automatically pushed to this
+stack.
+
+
+## Error Handling
+If an error occurs the `lsp_error()` function is called — this function resets
+the `context` to a safe state and calls the `error` handler if one is set. The
+error handler function is passed the error message and list representing the
+call stack (*both these values are valid only for this function*). The error
+handler can be safely longjmp'd out of to recover from the error and use of the
+`context` can continue — this can be seen in the REPL. New `object`s should not
+be created from inside the error handler.
+
+If no error handler is set or if the error handler returns then the error
+message and callstack are printed to `stderr` and `exit` is called with the
+value `EXIT_FAILURE`.
+
+
+## Known Issues
+The implementation has some known issues; these exist as a side effect of trying
+to keep the implementation terse, but should not hinder normal usage:
+
+* The garbage collector recurses on the `CAR` of objects thus deeply nested
+  `CAR`s may overflow the C stack — an object's `CDR` is looped on and will not
+  overflow the stack
+* The storage of an object's type and GC mark assumes a little-endian system and
+  will not work correctly on systems of other endianness
+* Proper tailcalls are not implemented — `while` can be used for iterating over
+  lists
+* Strings are null-terminated and therefor not binary safe
diff --git a/doc/lang.md b/doc/lang.md
new file mode 100644
index 0000000..0df44d2
--- /dev/null
+++ b/doc/lang.md
@@ -0,0 +1,143 @@
+# Language
+
+## Forms
+
+### Special-forms
+##### (let sym val)
+Creates a new binding of `sym` to the value `val` in the current environment.
+
+##### (= sym val)
+Sets the existing binding of `sym` to the value `val`; in lieu of an
+existing binding the global value is set.
+
+##### (if cond then else ...)
+If `cond` is true evaluates `then`, else evaluates `else` — `else` and `then`
+statements can be chained to replicate the functionality of else-if blocks.
+
+```clojure
+> (= x 2)
+nil
+> (if (is x 1) "one"
+      (is x 2) "two"
+      (is x 3) "three"
+      "?")
+two
+```
+
+##### (fn params ...)
+Creates a new function.
+
+```clojure
+> (= sqr (fn (n) (* n n)))
+nil
+> (sqr 4)
+16
+```
+
+##### (mac params ...)
+Creates a new *macro*.
+```clojure
+> (= incr (mac (x) (list '= x (list '+ x 1))))
+nil
+> (= n 0)
+nil
+> (incr n)
+nil
+> n
+1
+```
+
+##### (while cond ...)
+If `cond` evaluates to true evaluates the rest of its arguments and keeps
+repeating until `cond` evaluates to `nil`.
+
+```clojure
+> (= i 0)
+nil
+> (while (< i 3)
+    (print i)
+    (= i (+ i 1)))
+0
+1
+2
+nil
+```
+
+##### (quote val)
+Returns `val` unevaluated.
+
+```clojure
+> (quote (hello world))
+(hello world)
+```
+
+##### (and ...)
+Evaluates each argument until one results in `nil` — the last argument's value
+is returned if all the arguments are true.
+
+##### (or ...)
+Evaluates each argument until one results in true, in which case that arguments
+value is returned — `nil` is returned if no arguments are true.
+
+##### (do ...)
+Evaluates each of its arguments and returns the value of the last one.
+
+### Functions
+##### (cons car cdr)
+Creates a new pair with the given `car` and `cdr` values.
+
+##### (car pair)
+Returns the `car` of the `pair` or `nil` if `pair` is `nil`.
+
+##### (cdr pair)
+Returns the `cdr` of the `pair` or `nil` if `pair` is `nil`.
+
+##### (setcar pair val)
+Sets the `car` of `pair` to `val`.
+
+##### (setcdr pair val)
+Sets the `cdr` of `pair` to `val`.
+
+##### (list ...)
+Returns all its arguments as a list.
+```clojure
+> (list 1 2 3)
+(1 2 3)
+```
+
+##### (not val)
+Returns true if `val` is `nil`, else returns `nil`
+```clojure
+> (not 1)
+nil
+```
+
+##### (is a b)
+Returns true if the values `a` and `b` are equal in value. Numbers and strings
+are equal if equivalent, all other values are equal only if it is the same
+underlying object.
+
+##### (atom x)
+Returns true if `x` is not a pair, otherwise `nil`.
+
+##### (print ...)
+Prints all it's arguments to `stdout`, each separated by a space and followed by
+a new line.
+
+##### (< a b)
+Returns true if the numerical value `a` is less than `b`.
+
+##### (<= a b)
+Returns true if the numerical value `a` is less than or equal to `b`.
+
+##### (+ ...)
+Adds all its arguments together.
+
+##### (- ...)
+Subtracts all its arguments, left-to-right.
+
+##### (* ...)
+Multiplies all its arguments.
+
+##### (/ ...)
+Divides all its arguments, left-to-right.
diff --git a/fe.c b/fe.c
new file mode 100644
index 0000000..4ac1f27
--- /dev/null
+++ b/fe.c
@@ -0,0 +1,884 @@
+/*
+** Copyright (c) 2019 rxi
+**
+** Permission is hereby granted, free of charge, to any person obtaining a copy
+** of this software and associated documentation files (the "Software"), to
+** deal in the Software without restriction, including without limitation the
+** rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+** sell copies of the Software, and to permit persons to whom the Software is
+** furnished to do so, subject to the following conditions:
+**
+** The above copyright notice and this permission notice shall be included in
+** all copies or substantial portions of the Software.
+**
+** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+** IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+** FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+** AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+** LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+** FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+** IN THE SOFTWARE.
+*/
+
+#include <string.h>
+#include "fe.h"
+
+#define unused(x)     ( (void) (x) )
+#define car(x)        ( (x)->car.o )
+#define cdr(x)        ( (x)->cdr.o )
+#define tag(x)        ( (x)->car.c )
+#define isnil(x)      ( (x) == &nil )
+#define type(x)       ( tag(x) & 0x1 ? tag(x) >> 2 : FE_TPAIR )
+#define settype(x,t)  ( tag(x) = (t) << 2 | 1 )
+#define number(x)     ( (x)->cdr.n )
+#define prim(x)       ( (x)->cdr.c )
+#define cfunc(x)      ( (x)->cdr.f )
+#define strbuf(x)     ( &(x)->car.c + 1 )
+
+#define STRBUFSIZE    ( (int) sizeof(fe_Object*) - 1 )
+#define GCMARKBIT     ( 0x2 )
+#define GCSTACKSIZE   ( 256 )
+
+
+enum {
+ P_LET, P_SET, P_IF, P_FN, P_MAC, P_WHILE, P_QUOTE, P_AND, P_OR, P_DO, P_CONS,
+ P_CAR, P_CDR, P_SETCAR, P_SETCDR, P_LIST, P_NOT, P_IS, P_ATOM, P_PRINT, P_LT,
+ P_LTE, P_ADD, P_SUB, P_MUL, P_DIV, P_MAX
+};
+
+static const char *primnames[] = {
+  "let", "=", "if", "fn", "mac", "while", "quote", "and", "or", "do", "cons",
+  "car", "cdr", "setcar", "setcdr", "list", "not", "is", "atom", "print", "<",
+  "<=", "+", "-", "*", "/"
+};
+
+static const char *typenames[] = {
+  "pair", "free", "nil", "number", "symbol", "string",
+  "func", "macro", "prim", "cfunc", "ptr"
+};
+
+typedef union { fe_Object *o; fe_CFunc f; fe_Number n; char c; } Value;
+
+struct fe_Object { Value car, cdr; };
+
+struct fe_Context {
+  fe_Handlers handlers;
+  fe_Object *gcstack[GCSTACKSIZE];
+  int gcstack_idx;
+  fe_Object *objects;
+  int object_count;
+  fe_Object *calllist;
+  fe_Object *freelist;
+  fe_Object *symlist;
+  fe_Object *t;
+  int nextchr;
+};
+
+static fe_Object nil = {{ (void*) (FE_TNIL << 2 | 1) }, { NULL }};
+
+
+fe_Handlers* fe_handlers(fe_Context *ctx) {
+  return &ctx->handlers;
+}
+
+
+void fe_error(fe_Context *ctx, const char *msg) {
+  fe_Object *cl = ctx->calllist;
+  /* reset context state */
+  ctx->calllist = &nil;
+  /* do error handler */
+  if (ctx->handlers.error) { ctx->handlers.error(ctx, msg, cl); }
+  /* error handler returned -- print error and traceback, exit */
+  fprintf(stderr, "error: %s\n", msg);
+  for (; !isnil(cl); cl = cdr(cl)) {
+    char buf[64];
+    fe_tostring(ctx, car(cl), buf, sizeof(buf));
+    fprintf(stderr, "=> %s\n", buf);
+  }
+  exit(EXIT_FAILURE);
+}
+
+
+fe_Object* fe_nextarg(fe_Context *ctx, fe_Object **arg) {
+  fe_Object *a = *arg;
+  if (type(a) != FE_TPAIR) {
+    if (isnil(a)) { fe_error(ctx, "too few arguments"); }
+    fe_error(ctx, "dotted pair in argument list");
+  }
+  *arg = cdr(a);
+  return car(a);
+}
+
+
+static fe_Object* checktype(fe_Context *ctx, fe_Object *obj, int type) {
+  char buf[64];
+  if (type(obj) != type) {
+    sprintf(buf, "expected %s, got %s", typenames[type], typenames[type(obj)]);
+    fe_error(ctx, buf);
+  }
+  return obj;
+}
+
+
+int fe_type(fe_Context *ctx, fe_Object *obj) {
+  unused(ctx);
+  return type(obj);
+}
+
+
+int fe_isnil(fe_Context *ctx, fe_Object *obj) {
+  unused(ctx);
+  return isnil(obj);
+}
+
+
+void fe_pushgc(fe_Context *ctx, fe_Object *obj) {
+  if (ctx->gcstack_idx == GCSTACKSIZE) {
+    fe_error(ctx, "gc stack overflow");
+  }
+  ctx->gcstack[ctx->gcstack_idx++] = obj;
+}
+
+
+void fe_restoregc(fe_Context *ctx, int idx) {
+  ctx->gcstack_idx = idx;
+}
+
+
+int fe_savegc(fe_Context *ctx) {
+  return ctx->gcstack_idx;
+}
+
+
+void fe_mark(fe_Context *ctx, fe_Object *obj) {
+  fe_Object *car;
+begin:
+  if (tag(obj) & GCMARKBIT) { return; }
+  car = car(obj); /* store car before modifying it with GCMARKBIT */
+  tag(obj) |= GCMARKBIT;
+
+  switch (type(obj)) {
+    case FE_TPAIR:
+      fe_mark(ctx, car);
+      /* fall through */
+    case FE_TFUNC: case FE_TMACRO: case FE_TSYMBOL: case FE_TSTRING:
+      obj = cdr(obj);
+      goto begin;
+
+    case FE_TPTR:
+      if (ctx->handlers.mark) { ctx->handlers.mark(ctx, obj); }
+      break;
+  }
+}
+
+
+static void collectgarbage(fe_Context *ctx) {
+  int i;
+  /* mark */
+  for (i = 0; i < ctx->gcstack_idx; i++) {
+    fe_mark(ctx, ctx->gcstack[i]);
+  }
+  fe_mark(ctx, ctx->symlist);
+  /* sweep and unmark */
+  for (i = 0; i < ctx->object_count; i++) {
+    fe_Object *obj = &ctx->objects[i];
+    if (type(obj) == FE_TFREE) { continue; }
+    if (~tag(obj) & GCMARKBIT) {
+      if (type(obj) == FE_TPTR && ctx->handlers.gc) {
+        ctx->handlers.gc(ctx, obj);
+      }
+      settype(obj, FE_TFREE);
+      cdr(obj) = ctx->freelist;
+      ctx->freelist = obj;
+    } else {
+      tag(obj) &= ~GCMARKBIT;
+    }
+  }
+}
+
+
+static int equal(fe_Object *a, fe_Object *b) {
+  if (a == b) { return 1; }
+  if (type(a) != type(b)) { return 0; }
+  if (type(a) == FE_TNUMBER) { return number(a) == number(b); }
+  if (type(a) == FE_TSTRING) {
+    for (; !isnil(a) && !isnil(b); a = cdr(a), b = cdr(b)) {
+      if (car(a) != car(b)) { return 0; }
+    }
+    return isnil(a) && isnil(b);
+  }
+  return 0;
+}
+
+
+static int streq(fe_Object *obj, const char *str) {
+  while (!isnil(obj)) {
+    int i;
+    for (i = 0; i < STRBUFSIZE; i++) {
+      if (strbuf(obj)[i] != *str) { return 0; }
+      if (*str) { str++; }
+    }
+    obj = cdr(obj);
+  }
+  return *str == '\0';
+}
+
+
+static fe_Object* object(fe_Context *ctx) {
+  fe_Object *obj;
+  /* do gc if freelist has no more objects */
+  if (isnil(ctx->freelist)) {
+    collectgarbage(ctx);
+    if (isnil(ctx->freelist)) { fe_error(ctx, "out of memory"); }
+  }
+  /* get object from freelist and push to the gcstack */
+  obj = ctx->freelist;
+  ctx->freelist = cdr(obj);
+  fe_pushgc(ctx, obj);
+  return obj;
+}
+
+
+fe_Object* fe_cons(fe_Context *ctx, fe_Object *car, fe_Object *cdr) {
+  fe_Object *obj = object(ctx);
+  car(obj) = car;
+  cdr(obj) = cdr;
+  return obj;
+}
+
+
+fe_Object* fe_bool(fe_Context *ctx, int b) {
+  return b ? ctx->t : &nil;
+}
+
+
+fe_Object* fe_number(fe_Context *ctx, fe_Number n) {
+  fe_Object *obj = object(ctx);
+  settype(obj, FE_TNUMBER);
+  number(obj) = n;
+  return obj;
+}
+
+
+static fe_Object* buildstring(fe_Context *ctx, fe_Object *tail, int chr) {
+  if (!tail || strbuf(tail)[STRBUFSIZE - 1] != '\0') {
+    fe_Object *obj = fe_cons(ctx, NULL, &nil);
+    settype(obj, FE_TSTRING);
+    if (tail) {
+      cdr(tail) = obj;
+      ctx->gcstack_idx--;
+    }
+    tail = obj;
+  }
+  strbuf(tail)[strlen(strbuf(tail))] = chr;
+  return tail;
+}
+
+
+fe_Object* fe_string(fe_Context *ctx, const char *str) {
+  fe_Object *obj = buildstring(ctx, NULL, '\0');
+  fe_Object *tail = obj;
+  while (*str) {
+    tail = buildstring(ctx, tail, *str++);
+  }
+  return obj;
+}
+
+
+fe_Object* fe_symbol(fe_Context *ctx, const char *name) {
+  fe_Object *obj;
+  /* try to find in symlist */
+  for (obj = ctx->symlist; !isnil(obj); obj = cdr(obj)) {
+    if (streq(car(cdr(car(obj))), name)) {
+      return car(obj);
+    }
+  }
+  /* create new object, push to symlist and return */
+  obj = object(ctx);
+  settype(obj, FE_TSYMBOL);
+  cdr(obj) = fe_cons(ctx, fe_string(ctx, name), &nil);
+  ctx->symlist = fe_cons(ctx, obj, ctx->symlist);
+  return obj;
+}
+
+
+fe_Object* fe_cfunc(fe_Context *ctx, fe_CFunc fn) {
+  fe_Object *obj = object(ctx);
+  settype(obj, FE_TCFUNC);
+  cfunc(obj) = fn;
+  return obj;
+}
+
+
+fe_Object* fe_ptr(fe_Context *ctx, void *ptr) {
+  fe_Object *obj = object(ctx);
+  settype(obj, FE_TPTR);
+  cdr(obj) = ptr;
+  return obj;
+}
+
+
+fe_Object* fe_list(fe_Context *ctx, fe_Object **objs, int n) {
+  fe_Object *res = &nil;
+  while (n--) {
+    res = fe_cons(ctx, objs[n], res);
+  }
+  return res;
+}
+
+
+fe_Object* fe_car(fe_Context *ctx, fe_Object *obj) {
+  if (isnil(obj)) { return obj; }
+  return car(checktype(ctx, obj, FE_TPAIR));
+}
+
+
+fe_Object* fe_cdr(fe_Context *ctx, fe_Object *obj) {
+  if (isnil(obj)) { return obj; }
+  return cdr(checktype(ctx, obj, FE_TPAIR));
+}
+
+
+static void writestr(fe_Context *ctx, fe_WriteFn fn, void *udata, const char *s) {
+  while (*s) { fn(ctx, udata, *s++); }
+}
+
+void fe_write(fe_Context *ctx, fe_Object *obj, fe_WriteFn fn, void *udata, int qt) {
+  char buf[32];
+
+  switch (type(obj)) {
+    case FE_TNIL:
+      writestr(ctx, fn, udata, "nil");
+      break;
+
+    case FE_TNUMBER:
+      sprintf(buf, "%.7g", number(obj));
+      writestr(ctx, fn, udata, buf);
+      break;
+
+    case FE_TPAIR:
+      fn(ctx, udata, '(');
+      for (;;) {
+        fe_write(ctx, car(obj), fn, udata, 1);
+        obj = cdr(obj);
+        if (type(obj) != FE_TPAIR) { break; }
+        fn(ctx, udata, ' ');
+      }
+      if (!isnil(obj)) {
+        writestr(ctx, fn, udata, " . ");
+        fe_write(ctx, obj, fn, udata, 1);
+      }
+      fn(ctx, udata, ')');
+      break;
+
+    case FE_TSYMBOL:
+      fe_write(ctx, car(cdr(obj)), fn, udata, 0);
+      break;
+
+    case FE_TSTRING:
+      if (qt) { fn(ctx, udata, '"'); }
+      while (!isnil(obj)) {
+        int i;
+        for (i = 0; i < STRBUFSIZE && strbuf(obj)[i]; i++) {
+          if (qt && strbuf(obj)[i] == '"') { fn(ctx, udata, '\\'); }
+          fn(ctx, udata, strbuf(obj)[i]);
+        }
+        obj = cdr(obj);
+      }
+      if (qt) { fn(ctx, udata, '"'); }
+      break;
+
+    default:
+      sprintf(buf, "[%s %p]", typenames[type(obj)], (void*) obj);
+      writestr(ctx, fn, udata, buf);
+      break;
+  }
+}
+
+
+static void writefp(fe_Context *ctx, void *udata, char chr) {
+  unused(ctx);
+  fputc(chr, udata);
+}
+
+void fe_writefp(fe_Context *ctx, fe_Object *obj, FILE *fp) {
+  fe_write(ctx, obj, writefp, fp, 0);
+}
+
+
+typedef struct { char *p; int n; } CharPtrInt;
+
+static void writebuf(fe_Context *ctx, void *udata, char chr) {
+  CharPtrInt *x = udata;
+  unused(ctx);
+  if (x->n) { *x->p++ = chr; x->n--; }
+}
+
+int fe_tostring(fe_Context *ctx, fe_Object *obj, char *dst, int size) {
+  CharPtrInt x;
+  x.p = dst;
+  x.n = size - 1;
+  fe_write(ctx, obj, writebuf, &x, 0);
+  *x.p = '\0';
+  return size - x.n - 1;
+}
+
+
+fe_Number fe_tonumber(fe_Context *ctx, fe_Object *obj) {
+  return number(checktype(ctx, obj, FE_TNUMBER));
+}
+
+
+void* fe_toptr(fe_Context *ctx, fe_Object *obj) {
+  return cdr(checktype(ctx, obj, FE_TPTR));
+}
+
+
+static fe_Object* getbound(fe_Object *sym, fe_Object *env) {
+  /* try to find in environment */
+  for (; !isnil(env); env = cdr(env)) {
+    fe_Object *x = car(env);
+    if (car(x) == sym) { return x; }
+  }
+  /* return global */
+  return cdr(sym);
+}
+
+
+void fe_set(fe_Context *ctx, fe_Object *sym, fe_Object *v) {
+  unused(ctx);
+  cdr(getbound(sym, &nil)) = v;
+}
+
+
+static fe_Object rparen;
+
+static fe_Object* read_(fe_Context *ctx, fe_ReadFn fn, void *udata) {
+  const char *delimiter = " \n\t\r();";
+  fe_Object *v, *res, **tail;
+  fe_Number n;
+  int chr, gc;
+  char buf[64], *p;
+
+  /* get next character */
+  chr = ctx->nextchr ? ctx->nextchr : fn(ctx, udata);
+  ctx->nextchr = '\0';
+
+  /* skip whitespace */
+  while (chr && strchr(" \n\t\r", chr)) {
+    chr = fn(ctx, udata);
+  }
+
+  switch (chr) {
+    case '\0':
+      return NULL;
+
+    case ';':
+      while (chr && chr != '\n') { chr = fn(ctx, udata); }
+      return read_(ctx, fn, udata);
+
+    case ')':
+      return &rparen;
+
+    case '(':
+      res = &nil;
+      tail = &res;
+      gc = fe_savegc(ctx);
+      fe_pushgc(ctx, res); /* to cause error on too-deep nesting */
+      while ( (v = read_(ctx, fn, udata)) != &rparen ) {
+        if (v == NULL) { fe_error(ctx, "unclosed list"); }
+        if (type(v) == FE_TSYMBOL && streq(car(cdr(v)), ".")) {
+          /* dotted pair */
+          *tail = fe_read(ctx, fn, udata);
+        } else {
+          /* proper pair */
+          *tail = fe_cons(ctx, v, &nil);
+          tail = &cdr(*tail);
+        }
+        fe_restoregc(ctx, gc);
+        fe_pushgc(ctx, res);
+      }
+      return res;
+
+    case '\'':
+      v = fe_read(ctx, fn, udata);
+      if (!v) { fe_error(ctx, "stray '''"); }
+      return fe_cons(ctx, fe_symbol(ctx, "quote"), fe_cons(ctx, v, &nil));
+
+    case '"':
+      res = buildstring(ctx, NULL, '\0');
+      v = res;
+      chr = fn(ctx, udata);
+      while (chr != '"') {
+        if (chr == '\0') { fe_error(ctx, "unclosed string"); }
+        if (chr == '\\') {
+          chr = fn(ctx, udata);
+          if (strchr("nrt", chr)) { chr = strchr("n\nr\rt\t", chr)[1]; }
+        }
+        v = buildstring(ctx, v, chr);
+        chr = fn(ctx, udata);
+      }
+      return res;
+
+    default:
+      p = buf;
+      do {
+        if (p == buf + sizeof(buf) - 1) { fe_error(ctx, "symbol too long"); }
+        *p++ = chr;
+        chr = fn(ctx, udata);
+      } while (chr && !strchr(delimiter, chr));
+      *p = '\0';
+      ctx->nextchr = chr;
+      n = strtod(buf, &p);  /* try to read as number */
+      if (p != buf && strchr(delimiter, *p)) { return fe_number(ctx, n); }
+      if (!strcmp(buf, "nil")) { return &nil; }
+      return fe_symbol(ctx, buf);
+  }
+}
+
+
+fe_Object* fe_read(fe_Context *ctx, fe_ReadFn fn, void *udata) {
+  fe_Object* obj = read_(ctx, fn, udata);
+  if (obj == &rparen) { fe_error(ctx, "stray ')'"); }
+  return obj;
+}
+
+
+static char readfp(fe_Context *ctx, void *udata) {
+  int chr;
+  unused(ctx);
+  return (chr = fgetc(udata)) == EOF ? '\0' : chr;
+}
+
+fe_Object* fe_readfp(fe_Context *ctx, FILE *fp) {
+  return fe_read(ctx, readfp, fp);
+}
+
+
+static fe_Object* eval(fe_Context *ctx, fe_Object *obj, fe_Object *env, fe_Object **bind);
+
+static fe_Object* evallist(fe_Context *ctx, fe_Object *lst, fe_Object *env) {
+  fe_Object *res = &nil;
+  fe_Object **tail = &res;
+  while (!isnil(lst)) {
+    *tail = fe_cons(ctx, eval(ctx, fe_nextarg(ctx, &lst), env, NULL), &nil);
+    tail = &cdr(*tail);
+  }
+  return res;
+}
+
+
+static fe_Object* dolist(fe_Context *ctx, fe_Object *lst, fe_Object *env) {
+  fe_Object *res = &nil;
+  int save = fe_savegc(ctx);
+  while (!isnil(lst)) {
+    fe_restoregc(ctx, save);
+    fe_pushgc(ctx, env);
+    res = eval(ctx, fe_nextarg(ctx, &lst), env, &env);
+  }
+  return res;
+}
+
+
+static fe_Object* argstoenv(fe_Context *ctx, fe_Object *prm, fe_Object *arg, fe_Object *env) {
+  while (!isnil(prm)) {
+    if (type(prm) != FE_TPAIR) {
+      env = fe_cons(ctx, fe_cons(ctx, prm, arg), env);
+      break;
+    }
+    env = fe_cons(ctx, fe_cons(ctx, car(prm), fe_car(ctx, arg)), env);
+    prm = cdr(prm);
+    arg = fe_cdr(ctx, arg);
+  }
+  return env;
+}
+
+
+#define evalarg() eval(ctx, fe_nextarg(ctx, &arg), env, NULL)
+
+#define arithop(op) {                             \
+    fe_Number x = fe_tonumber(ctx, evalarg());    \
+    while (!isnil(arg)) {                         \
+      x = x op fe_tonumber(ctx, evalarg());       \
+    }                                             \
+    res = fe_number(ctx, x);                      \
+  }
+
+#define numcmpop(op) {                            \
+    va = checktype(ctx, evalarg(), FE_TNUMBER);   \
+    vb = checktype(ctx, evalarg(), FE_TNUMBER);   \
+    res = fe_bool(ctx, number(va) op number(vb)); \
+  }
+
+
+static fe_Object* eval(fe_Context *ctx, fe_Object *obj, fe_Object *env, fe_Object **newenv) {
+  fe_Object *fn, *arg, *res;
+  fe_Object cl, *va, *vb;
+  int n, gc;
+
+  switch (type(obj)) {
+    case FE_TSYMBOL: return cdr(getbound(obj, env));
+    case FE_TPAIR: break;
+    default: return obj;
+  }
+
+  car(&cl) = obj, cdr(&cl) = ctx->calllist;
+  ctx->calllist = &cl;
+
+  gc = fe_savegc(ctx);
+  fn = eval(ctx, car(obj), env, NULL);
+  arg = cdr(obj);
+  res = &nil;
+
+  switch (type(fn)) {
+    case FE_TPRIM:
+      switch (prim(fn)) {
+        case P_LET:
+          va = checktype(ctx, fe_nextarg(ctx, &arg), FE_TSYMBOL);
+          if (newenv) {
+            *newenv = fe_cons(ctx, fe_cons(ctx, va, evalarg()), env);
+          }
+          break;
+
+        case P_SET:
+          va = checktype(ctx, fe_nextarg(ctx, &arg), FE_TSYMBOL);
+          cdr(getbound(va, env)) = evalarg();
+          break;
+
+        case P_IF:
+          while (!isnil(arg)) {
+            va = evalarg();
+            if (!isnil(va)) {
+              res = isnil(arg) ? va : evalarg();
+              break;
+            }
+            if (isnil(arg)) { break; }
+            arg = cdr(arg);
+          }
+          break;
+
+        case P_FN: case P_MAC:
+          va = fe_cons(ctx, env, arg);
+          fe_nextarg(ctx, &arg);
+          res = object(ctx);
+          settype(res, prim(fn) == P_FN ? FE_TFUNC : FE_TMACRO);
+          cdr(res) = va;
+          break;
+
+        case P_WHILE:
+          va = fe_nextarg(ctx, &arg);
+          n = fe_savegc(ctx);
+          while (!isnil(eval(ctx, va, env, NULL))) {
+            dolist(ctx, arg, env);
+            fe_restoregc(ctx, n);
+          }
+          break;
+
+        case P_QUOTE:
+          res = fe_nextarg(ctx, &arg);
+          break;
+
+        case P_AND:
+          while (!isnil(arg) && !isnil(res = evalarg()));
+          break;
+
+        case P_OR:
+          while (!isnil(arg) && isnil(res = evalarg()));
+          break;
+
+        case P_DO:
+          res = dolist(ctx, arg, env);
+          break;
+
+        case P_CONS:
+          va = evalarg();
+          res = fe_cons(ctx, va, evalarg());
+          break;
+
+        case P_CAR:
+          res = fe_car(ctx, evalarg());
+          break;
+
+        case P_CDR:
+          res = fe_cdr(ctx, evalarg());
+          break;
+
+        case P_SETCAR:
+          va = checktype(ctx, evalarg(), FE_TPAIR);
+          car(va) = evalarg();
+          break;
+
+        case P_SETCDR:
+          va = checktype(ctx, evalarg(), FE_TPAIR);
+          cdr(va) = evalarg();
+          break;
+
+        case P_LIST:
+          res = evallist(ctx, arg, env);
+          break;
+
+        case P_NOT:
+          res = fe_bool(ctx, isnil(evalarg()));
+          break;
+
+        case P_IS:
+          va = evalarg();
+          res = fe_bool(ctx, equal(va, evalarg()));
+          break;
+
+        case P_ATOM:
+          res = fe_bool(ctx, fe_type(ctx, evalarg()) != FE_TPAIR);
+          break;
+
+        case P_PRINT:
+          while (!isnil(arg)) {
+            fe_writefp(ctx, evalarg(), stdout);
+            if (!isnil(arg)) { printf(" "); }
+          }
+          printf("\n");
+          break;
+
+        case P_LT: numcmpop(<); break;
+        case P_LTE: numcmpop(<=); break;
+        case P_ADD: arithop(+); break;
+        case P_SUB: arithop(-); break;
+        case P_MUL: arithop(*); break;
+        case P_DIV: arithop(/); break;
+      }
+      break;
+
+    case FE_TCFUNC:
+      res = cfunc(fn)(ctx, evallist(ctx, arg, env));
+      break;
+
+    case FE_TFUNC:
+      arg = evallist(ctx, arg, env);
+      va = cdr(fn); /* (env params ...) */
+      vb = cdr(va); /* (params ...) */
+      res = dolist(ctx, cdr(vb), argstoenv(ctx, car(vb), arg, car(va)));
+      break;
+
+    case FE_TMACRO:
+      va = cdr(fn); /* (env params ...) */
+      vb = cdr(va); /* (params ...) */
+      /* replace caller object with code generated by macro and re-eval */
+      *obj = *dolist(ctx, cdr(vb), argstoenv(ctx, car(vb), arg, car(va)));
+      fe_restoregc(ctx, gc);
+      ctx->calllist = cdr(&cl);
+      return eval(ctx, obj, env, NULL);
+
+    default:
+      fe_error(ctx, "tried to call non-callable value");
+  }
+
+  fe_restoregc(ctx, gc);
+  fe_pushgc(ctx, res);
+  ctx->calllist = cdr(&cl);
+  return res;
+}
+
+
+fe_Object* fe_eval(fe_Context *ctx, fe_Object *obj) {
+  return eval(ctx, obj, &nil, NULL);
+}
+
+
+fe_Context* fe_open(void *ptr, int size) {
+  int i, save;
+  fe_Context *ctx;
+
+  /* init context struct */
+  ctx = ptr;
+  memset(ctx, 0, sizeof(fe_Context));
+  ptr = (char*) ptr + sizeof(fe_Context);
+  size -= sizeof(fe_Context);
+
+  /* make sure object memory region is 32bit aligned */
+  while ((size_t) ptr & 0x3) { ptr = (char*) ptr + 1; size--; }
+
+  /* init objects memory region */
+  ctx->objects = (fe_Object*) ptr;
+  ctx->object_count = size / sizeof(fe_Object);
+
+  /* init lists */
+  ctx->calllist = &nil;
+  ctx->freelist = &nil;
+  ctx->symlist = &nil;
+
+  /* populate freelist */
+  for (i = 0; i < ctx->object_count; i++) {
+    fe_Object *obj = &ctx->objects[i];
+    settype(obj, FE_TFREE);
+    cdr(obj) = ctx->freelist;
+    ctx->freelist = obj;
+  }
+
+  /* init objects */
+  ctx->t = fe_symbol(ctx, "t");
+  fe_set(ctx, ctx->t, ctx->t);
+
+  /* register built in primitives */
+  save = fe_savegc(ctx);
+  for (i = 0; i < P_MAX; i++) {
+    fe_Object *v = object(ctx);
+    settype(v, FE_TPRIM);
+    prim(v) = i;
+    fe_set(ctx, fe_symbol(ctx, primnames[i]), v);
+    fe_restoregc(ctx, save);
+  }
+
+  return ctx;
+}
+
+
+void fe_close(fe_Context *ctx) {
+  /* clear gcstack and symlist; makes all objects unreachable */
+  ctx->gcstack_idx = 0;
+  ctx->symlist = &nil;
+  collectgarbage(ctx);
+}
+
+
+#ifdef FE_STANDALONE
+
+#include <setjmp.h>
+
+static jmp_buf toplevel;
+static char buf[64000];
+
+static void onerror(fe_Context *ctx, const char *msg, fe_Object *cl) {
+  unused(ctx), unused(cl);
+  fprintf(stderr, "error: %s\n", msg);
+  longjmp(toplevel, -1);
+}
+
+
+int main(int argc, char **argv) {
+  int gc;
+  fe_Object *obj;
+  FILE *volatile fp = stdin;
+  fe_Context *ctx = fe_open(buf, sizeof(buf));
+
+  /* init input file */
+  if (argc > 1) {
+    fp = fopen(argv[1], "rb");
+    if (!fp) { fe_error(ctx, "could not open input file"); }
+  }
+
+  if (fp == stdin) { fe_handlers(ctx)->error = onerror; }
+  gc = fe_savegc(ctx);
+  setjmp(toplevel);
+
+  /* re(p)l */
+  for (;;) {
+    fe_restoregc(ctx, gc);
+    if (fp == stdin) { printf("> "); }
+    if (!(obj = fe_readfp(ctx, fp))) { break; }
+    obj = fe_eval(ctx, obj);
+    if (fp == stdin) { fe_writefp(ctx, obj, stdout); printf("\n"); }
+  }
+
+  return EXIT_SUCCESS;
+}
+
+#endif
diff --git a/fe.h b/fe.h
new file mode 100644
index 0000000..f5f30ab
--- /dev/null
+++ b/fe.h
@@ -0,0 +1,61 @@
+/*
+** Copyright (c) 2019 rxi
+**
+** This library is free software; you can redistribute it and/or modify it
+** under the terms of the MIT license. See `fe.c` for details.
+*/
+
+#ifndef FE_H
+#define FE_H
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#define FE_VERSION "1.0"
+
+typedef float fe_Number;
+typedef struct fe_Object fe_Object;
+typedef struct fe_Context fe_Context;
+typedef fe_Object* (*fe_CFunc)(fe_Context *ctx, fe_Object *args);
+typedef void (*fe_ErrorFn)(fe_Context *ctx, const char *err, fe_Object *cl);
+typedef void (*fe_WriteFn)(fe_Context *ctx, void *udata, char chr);
+typedef char (*fe_ReadFn)(fe_Context *ctx, void *udata);
+typedef struct { fe_ErrorFn error; fe_CFunc mark, gc; } fe_Handlers;
+
+enum {
+  FE_TPAIR, FE_TFREE, FE_TNIL, FE_TNUMBER, FE_TSYMBOL, FE_TSTRING,
+  FE_TFUNC, FE_TMACRO, FE_TPRIM, FE_TCFUNC, FE_TPTR
+};
+
+fe_Context* fe_open(void *ptr, int size);
+void fe_close(fe_Context *ctx);
+fe_Handlers* fe_handlers(fe_Context *ctx);
+void fe_error(fe_Context *ctx, const char *msg);
+fe_Object* fe_nextarg(fe_Context *ctx, fe_Object **arg);
+int fe_type(fe_Context *ctx, fe_Object *obj);
+int fe_isnil(fe_Context *ctx, fe_Object *obj);
+void fe_pushgc(fe_Context *ctx, fe_Object *obj);
+void fe_restoregc(fe_Context *ctx, int idx);
+int fe_savegc(fe_Context *ctx);
+void fe_mark(fe_Context *ctx, fe_Object *obj);
+fe_Object* fe_cons(fe_Context *ctx, fe_Object *car, fe_Object *cdr);
+fe_Object* fe_bool(fe_Context *ctx, int b);
+fe_Object* fe_number(fe_Context *ctx, fe_Number n);
+fe_Object* fe_string(fe_Context *ctx, const char *str);
+fe_Object* fe_symbol(fe_Context *ctx, const char *name);
+fe_Object* fe_cfunc(fe_Context *ctx, fe_CFunc fn);
+fe_Object* fe_ptr(fe_Context *ctx, void *ptr);
+fe_Object* fe_list(fe_Context *ctx, fe_Object **objs, int n);
+fe_Object* fe_car(fe_Context *ctx, fe_Object *obj);
+fe_Object* fe_cdr(fe_Context *ctx, fe_Object *obj);
+void fe_write(fe_Context *ctx, fe_Object *obj, fe_WriteFn fn, void *udata, int qt);
+void fe_writefp(fe_Context *ctx, fe_Object *obj, FILE *fp);
+int fe_tostring(fe_Context *ctx, fe_Object *obj, char *dst, int size);
+fe_Number fe_tonumber(fe_Context *ctx, fe_Object *obj);
+void* fe_toptr(fe_Context *ctx, fe_Object *obj);
+void fe_set(fe_Context *ctx, fe_Object *sym, fe_Object *v);
+fe_Object* fe_read(fe_Context *ctx, fe_ReadFn fn, void *udata);
+fe_Object* fe_readfp(fe_Context *ctx, FILE *fp);
+fe_Object* fe_eval(fe_Context *ctx, fe_Object *obj);
+
+#endif
diff --git a/scripts/fib.fe b/scripts/fib.fe
new file mode 100644
index 0000000..91adf0b
--- /dev/null
+++ b/scripts/fib.fe
@@ -0,0 +1,10 @@
+
+(= fib (fn (n)
+  (if (<= 2 n)
+    (+ (fib (- n 1)) (fib (- n 2)))
+    n
+  )
+))
+
+(print (fib 28))
+
diff --git a/scripts/life.fe b/scripts/life.fe
new file mode 100644
index 0000000..da8d7c9
--- /dev/null
+++ b/scripts/life.fe
@@ -0,0 +1,112 @@
+(= nth (fn (n lst)
+  (while (< 0 n)
+    (= n (- n 1))
+    (= lst (cdr lst)))
+  (if (is n 0) (car lst))
+))
+
+
+(= rev (fn (lst)
+  (let res nil)
+  (while lst
+    (= res (cons (car lst) res))
+    (= lst (cdr lst))
+  )
+  res
+))
+
+
+(= map (fn (f lst)
+  (let res nil)
+  (while lst
+    (= res (cons (f (car lst)) res))
+    (= lst (cdr lst))
+  )
+  (rev res)
+))
+
+
+(= print-grid (fn (grid)
+  (map
+    (fn (row)
+      (print (map (fn (x) (if (is x 0) '- '#)) row))
+    )
+    grid
+  )
+))
+
+
+(= get-cell (fn (grid x y)
+  (or (nth x (nth y grid)) 0)
+))
+
+
+(= next-cell (fn (grid cell x y)
+  (let n (+
+    (get-cell grid (- x 1)  (- y 1))
+    (get-cell grid (- x 1)  y      )
+    (get-cell grid (- x 1)  (+ y 1))
+    (get-cell grid x        (- y 1))
+    (get-cell grid x        (+ y 1))
+    (get-cell grid (+ x 1)  (- y 1))
+    (get-cell grid (+ x 1)  y      )
+    (get-cell grid (+ x 1)  (+ y 1))
+  ))
+  (if
+    (and (is cell 1) (or (is n 2) (is n 3))) 1
+    (and (is cell 0) (is n 3)) 1
+    0
+  )
+))
+
+
+(= next-grid (fn (grid)
+  (let y -1)
+  (map
+    (fn (row)
+      (= y (+ y 1))
+      (let x -1)
+      (map
+        (fn (cell)
+          (= x (+ x 1))
+          (next-cell grid cell x y)
+        )
+        row
+      )
+    )
+    grid
+  )
+))
+
+
+(= life (fn (n grid)
+  (let i 1)
+  (while (<= i n)
+    (print ">> iteration" i)
+    (print-grid grid)
+    (print)
+    (= grid (next-grid grid))
+    (= i (+ i 1))
+  )
+))
+
+
+; blinker in a 3x3 universe
+(life 5 '(
+  (0 1 0)
+  (0 1 0)
+  (0 1 0)
+))
+
+
+; glider in an 8x8 universe
+(life 22 '(
+  (0 0 1 0 0 0 0 0)
+  (0 0 0 1 0 0 0 0)
+  (0 1 1 1 0 0 0 0)
+  (0 0 0 0 0 0 0 0)
+  (0 0 0 0 0 0 0 0)
+  (0 0 0 0 0 0 0 0)
+  (0 0 0 0 0 0 0 0)
+  (0 0 0 0 0 0 0 0)
+))
diff --git a/scripts/mandelbrot.fe b/scripts/mandelbrot.fe
new file mode 100644
index 0000000..6c51372
--- /dev/null
+++ b/scripts/mandelbrot.fe
@@ -0,0 +1,35 @@
+; printed output should be written to a .pgm file
+
+(do
+  (let width  500)
+  (let height 300)
+  (let maxiter 16)
+
+  ; write header
+  (print "P2")
+  (print width height)
+  (print maxiter)
+
+  ; write pixels
+  (let ypixel 0)
+  (while (< ypixel height)
+    (let y (- (/ ypixel (/ height 2)) 1))
+    (let xpixel 0)
+    (while (< xpixel width)
+      (let x (- (/ xpixel (/ width 3)) 2))
+      (let x0 x)
+      (let y0 y)
+      (let iter 0)
+      (while (and (< iter maxiter) (<= (+ (* x0 x0) (* y0 y0)) 4))
+        (let x1 (+ (- (* x0 x0) (* y0 y0)) x))
+        (let y1 (+ (* 2 x0 y0) y))
+        (= x0 x1)
+        (= y0 y1)
+        (= iter (+ iter 1))
+      )
+      (print iter)
+      (= xpixel (+ xpixel 1))
+    )
+    (= ypixel (+ ypixel 1))
+  )
+)