Fundamentals 25 min read

Master Q-Expressions: Build Head, Tail, Join, List, and Eval in a C Lisp Interpreter

This tutorial walks through adding Q‑Expression support to a Lisp‑style interpreter written in C, covering syntax definition, parser updates, implementation of head, tail, join, list, and eval functions, macro‑based assertions, and a complete source listing with compilation instructions.

AI Cyberspace

Mar 14, 2023

Master Q-Expressions: Build Head, Tail, Join, List, and Eval in a C Lisp Interpreter

C Language Speedrun (0) C Family Development Chronicle

C Language Speedrun (1) HelloWorld

Quoted Expressions

The previously implemented symbolic expression parser stores user‑input symbols in a tree structure. Next we implement quoted expressions (Q‑Expressions) to give certain symbols special meanings, allowing them to act as variables, keywords, or even functions.

Quoted Expression Parser

Q‑Expression Syntax Parsing Implementation

Q‑Expressions are wrapped in curly braces {} while S‑Expressions use parentheses (()). The grammar rules are:

mpc_parser_t* Number = mpc_new("number");
mpc_parser_t* Symbol = mpc_new("symbol");
mpc_parser_t* Sexpr  = mpc_new("sexpr");
mpc_parser_t* Qexpr  = mpc_new("qexpr");
mpc_parser_t* Expr   = mpc_new("expr");
mpc_parser_t* Lispy  = mpc_new("lispy");

mpca_lang(MPCA_LANG_DEFAULT,
  "\
    number : /-?[0-9]+/ ;\
    symbol : '+' | '-' | '*' | '/' ;\
    sexpr  : '(' <expr>* ')' ;\
    qexpr  : '{' <expr>* '}' ;\
    expr   : <number> | <symbol> | <sexpr> | <qexpr> ;\
    lispy  : /^/ <expr>* $/ ;",
  Number, Symbol, Sexpr, Qexpr, Expr, Lispy);

mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);

Q‑Expression Storage Implementation

Because Q‑Expressions and S‑Expressions share a similar structure, their internal representations are also alike.

First, add a new type for Q‑Expressions:

enum { LVAL_ERR, LVAL_NUM, LVAL_SYM, LVAL_SEXPR, LVAL_QEXPR };

Then add a constructor:

/* A pointer to a new empty Qexpr lval */
lval* lval_qexpr(void) {
  lval* v = malloc(sizeof(lval));
  v->type = LVAL_QEXPR;
  v->count = 0;
  v->cell = NULL;
  return v;
}

Update the destructor and print functions to handle the new type:

void lval_del(lval* v) {
  switch (v->type) {
    case LVAL_NUM: break;
    case LVAL_ERR: free(v->err); break;
    case LVAL_SYM: free(v->sym); break;
    case LVAL_QEXPR:
    case LVAL_SEXPR:
      for (int i = 0; i < v->count; i++) {
        lval_del(v->cell[i]);
      }
      free(v->cell);
      break;
  }
  free(v);
}

void lval_print(lval* v) {
  switch (v->type) {
    case LVAL_NUM:   printf("%li", v->num); break;
    case LVAL_ERR:   printf("Error: %s", v->err); break;
    case LVAL_SYM:   printf("%s", v->sym); break;
    case LVAL_SEXPR: lval_expr_print(v, '(', ')'); break;
    case LVAL_QEXPR: lval_expr_print(v, '{', '}'); break;
  }
}

Reading and Storing S‑Expression

Modify lval_read to correctly read and store Q‑Expression AST nodes:

if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); }

Also skip curly‑brace tokens during tree traversal:

if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
if (strcmp(t->children[i]->contents, "{") == 0) { continue; }

Since Q‑Expressions are not evaluated directly, no evaluation logic is added here.

Key Q‑Expression Functions

Five functions are introduced to manipulate Q‑Expressions:

Head : Returns a new Q‑Expression containing only the first element.

Tail : Returns a new Q‑Expression containing all elements except the first.

Join : Concatenates multiple Q‑Expressions into one.

List : Converts a series of S‑Expressions into a Q‑Expression.

Eval : Treats a Q‑Expression as an S‑Expression and evaluates it.

Head Function

lval* builtin_head(lval* a) {
  if (a->count != 1) { lval_del(a); return lval_err("Function 'head' passed too many arguments!"); }
  if (a->cell[0]->type != LVAL_QEXPR) { lval_del(a); return lval_err("Function 'head' passed incorrect types!"); }
  if (a->cell[0]->count == 0) { lval_del(a); return lval_err("Function 'head' passed {}!"); }
  lval* v = lval_take(a, 0);
  while (v->count > 1) { lval_del(lval_pop(v, 1)); }
  return v;
}

Tail Function

lval* builtin_tail(lval* a) {
  if (a->count != 1) { lval_del(a); return lval_err("Function 'tail' passed too many arguments!"); }
  if (a->cell[0]->type != LVAL_QEXPR) { lval_del(a); return lval_err("Function 'tail' passed incorrect types!"); }
  if (a->cell[0]->count == 0) { lval_del(a); return lval_err("Function 'tail' passed {}!"); }
  lval* v = lval_take(a, 0);
  lval_del(lval_pop(v, 0));
  return v;
}

Macro‑Based Assertions

To simplify error handling, a macro LASSERT(args, cond, err) is defined:

#define LASSERT(args, cond, err) \
  if (!(cond)) { lval_del(args); return lval_err(err); }

The macro is then used to rewrite builtin_head and builtin_tail more concisely.

Join Function

lval* lval_join(lval* x, lval* y) {
  while (y->count) { x = lval_add(x, lval_pop(y, 0)); }
  lval_del(y);
  return x;
}

lval* builtin_join(lval* a) {
  for (int i = 0; i < a->count; i++) {
    LASSERT(a, a->cell[i]->type == LVAL_QEXPR, "Function 'join' passed incorrect type.");
  }
  lval* x = lval_pop(a, 0);
  while (a->count) { x = lval_join(x, lval_pop(a, 0)); }
  lval_del(a);
  return x;
}

List Function

lval* builtin_list(lval* a) {
  a->type = LVAL_QEXPR;
  return a;
}

Eval Function

lval* builtin_eval(lval* a) {
  LASSERT(a, a->count == 1, "Function 'eval' passed too many arguments!");
  LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'eval' passed incorrect type!");
  lval* x = lval_take(a, 0);
  x->type = LVAL_SEXPR;
  return lval_eval(x);
}

Function Router

lval* builtin(lval* a, char* func) {
  if (strcmp("list", func) == 0) { return builtin_list(a); }
  if (strcmp("head", func) == 0) { return builtin_head(a); }
  if (strcmp("tail", func) == 0) { return builtin_tail(a); }
  if (strcmp("join", func) == 0) { return builtin_join(a); }
  if (strcmp("eval", func) == 0) { return builtin_eval(a); }
  if (strstr("+-/*", func)) { return builtin_op(a, func); }
  lval_del(a);
  return lval_err("Unknown Function!");
}

Complete Source Code

#include <stdio.h>
#include <stdlib.h>
#include "mpc.h"

#define LASSERT(args, cond, err) \
  if (!(cond)) { lval_del(args); return lval_err(err); }

#ifdef _WIN32
#include <string.h>
static char buffer[2048];
char* readline(char* prompt) {
  fputs(prompt, stdout);
  fgets(buffer, 2048, stdin);
  char* cpy = malloc(strlen(buffer)+1);
  strcpy(cpy, buffer);
  cpy[strlen(cpy)-1] = '\0';
  return cpy;
}
void add_history(char* unused) {}
#else
#ifdef __linux__
#include <readline/readline.h>
#include <readline/history.h>
#endif
#ifdef __MACH__
#include <readline/readline.h>
#endif
#endif

enum { LVAL_NUM, LVAL_ERR, LVAL_SYM, LVAL_SEXPR, LVAL_QEXPR };

typedef struct lval {
  int type;
  long num;
  struct lval** cell;
  int count;
  char* err;
  char* sym;
} lval;

lval* lval_num(long x) { lval* v = malloc(sizeof(lval)); v->type = LVAL_NUM; v->num = x; return v; }
lval* lval_err(char* msg) { lval* v = malloc(sizeof(lval)); v->type = LVAL_ERR; v->err = malloc(strlen(msg)+1); strcpy(v->err, msg); return v; }
lval* lval_sym(char* s) { lval* v = malloc(sizeof(lval)); v->type = LVAL_SYM; v->sym = malloc(strlen(s)+1); strcpy(v->sym, s); return v; }
lval* lval_sexpr(void) { lval* v = malloc(sizeof(lval)); v->type = LVAL_SEXPR; v->count = 0; v->cell = NULL; return v; }
lval* lval_qexpr(void) { lval* v = malloc(sizeof(lval)); v->type = LVAL_QEXPR; v->count = 0; v->cell = NULL; return v; }

void lval_del(lval* v) {
  switch (v->type) {
    case LVAL_ERR: free(v->err); break;
    case LVAL_SYM: free(v->sym); break;
    case LVAL_QEXPR:
    case LVAL_SEXPR:
      for (int i = 0; i < v->count; i++) { lval_del(v->cell[i]); }
      free(v->cell);
      break;
  }
  free(v);
}

lval* lval_add(lval* v, lval* x) { v->count++; v->cell = realloc(v->cell, sizeof(lval*) * v->count); v->cell[v->count-1] = x; return v; }

lval* lval_pop(lval* v, int i) {
  lval* x = v->cell[i];
  memmove(&v->cell[i], &v->cell[i+1], sizeof(lval*) * (v->count-i-1));
  v->count--;
  v->cell = realloc(v->cell, sizeof(lval*) * v->count);
  return x;
}

lval* lval_take(lval* v, int i) { lval* x = lval_pop(v, i); lval_del(v); return x; }

lval* builtin_op(lval* a, char* op) {
  for (int i = 0; i < a->count; i++) {
    if (a->cell[i]->type != LVAL_NUM) { lval_del(a); return lval_err("Cannot operate on non-number!"); }
  }
  lval* x = lval_pop(a, 0);
  if (strcmp(op, "-") == 0 && a->count == 0) { x->num = -x->num; }
  while (a->count) {
    lval* y = lval_pop(a, 0);
    if (strcmp(op, "+") == 0) { x->num += y->num; }
    if (strcmp(op, "-") == 0) { x->num -= y->num; }
    if (strcmp(op, "*") == 0) { x->num *= y->num; }
    if (strcmp(op, "/") == 0) {
      if (y->num == 0) { lval_del(x); lval_del(y); x = lval_err("Division By Zero!"); break; }
      x->num /= y->num;
    }
    lval_del(y);
  }
  lval_del(a);
  return x;
}

lval* lval_eval_sexpr(lval* v) {
  for (int i = 0; i < v->count; i++) { v->cell[i] = lval_eval(v->cell[i]); }
  for (int i = 0; i < v->count; i++) { if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); } }
  if (v->count == 0) { return v; }
  if (v->count == 1) { return lval_take(v, 0); }
  lval* f = lval_pop(v, 0);
  if (f->type != LVAL_SYM) { lval_del(f); lval_del(v); return lval_err("S-expression Does not start with symbol!"); }
  lval* result = builtin(v, f->sym);
  lval_del(f);
  return result;
}

lval* lval_eval(lval* v) {
  if (v->type == LVAL_SEXPR) { return lval_eval_sexpr(v); }
  return v;
}

lval* builtin_head(lval* a) {
  LASSERT(a, a->count == 1, "Function 'head' passed too many arguments!");
  LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'head' passed incorrect type!");
  LASSERT(a, a->cell[0]->count != 0, "Function 'head' passed {}!");
  lval* v = lval_take(a, 0);
  while (v->count > 1) { lval_del(lval_pop(v, 1)); }
  return v;
}

lval* builtin_tail(lval* a) {
  LASSERT(a, a->count == 1, "Function 'tail' passed too many arguments!");
  LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'tail' passed incorrect type!");
  LASSERT(a, a->cell[0]->count != 0, "Function 'tail' passed {}!");
  lval* v = lval_take(a, 0);
  lval_del(lval_pop(v, 0));
  return v;
}

lval* builtin_list(lval* a) { a->type = LVAL_QEXPR; return a; }

lval* builtin_eval(lval* a) {
  LASSERT(a, a->count == 1, "Function 'eval' passed too many arguments!");
  LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'eval' passed incorrect type!");
  lval* x = lval_take(a, 0);
  x->type = LVAL_SEXPR;
  return lval_eval(x);
}

lval* lval_join(lval* x, lval* y) {
  while (y->count) { x = lval_add(x, lval_pop(y, 0)); }
  lval_del(y);
  return x;
}

lval* builtin_join(lval* a) {
  for (int i = 0; i < a->count; i++) {
    LASSERT(a, a->cell[i]->type == LVAL_QEXPR, "Function 'join' passed incorrect type.");
  }
  lval* x = lval_pop(a, 0);
  while (a->count) { x = lval_join(x, lval_pop(a, 0)); }
  lval_del(a);
  return x;
}

lval* builtin(lval* a, char* func) {
  if (strcmp("list", func) == 0) { return builtin_list(a); }
  if (strcmp("head", func) == 0) { return builtin_head(a); }
  if (strcmp("tail", func) == 0) { return builtin_tail(a); }
  if (strcmp("join", func) == 0) { return builtin_join(a); }
  if (strcmp("eval", func) == 0) { return builtin_eval(a); }
  if (strstr("+-/*", func)) { return builtin_op(a, func); }
  lval_del(a);
  return lval_err("Unknown Function!");
}

int main(int argc, char* argv[]) {
  mpc_parser_t* Number = mpc_new("number");
  mpc_parser_t* Symbol = mpc_new("symbol");
  mpc_parser_t* Sexpr  = mpc_new("sexpr");
  mpc_parser_t* Qexpr  = mpc_new("qexpr");
  mpc_parser_t* Expr   = mpc_new("expr");
  mpc_parser_t* Lispy  = mpc_new("lispy");

  mpca_lang(MPCA_LANG_DEFAULT,
    "\
      number : /-?[0-9]+/ ;\
      symbol : \"list\" | \"head\" | \"tail\" | \"join\" | \"eval\" | '+' | '-' | '*' | '/' ;\
      sexpr  : '(' <expr>* ')' ;\
      qexpr  : '{' <expr>* '}' ;\
      expr   : <number> | <symbol> | <sexpr> | <qexpr> ;\
      lispy  : /^/ <expr>* $/ ;",
    Number, Symbol, Sexpr, Qexpr, Expr, Lispy);

  puts("Lispy Version 0.1");
  puts("Press Ctrl+c to Exit
");

  while (1) {
    char* input = readline("lispy> ");
    add_history(input);
    mpc_result_t r;
    if (mpc_parse("<stdin>", input, Lispy, &r)) {
      lval* x = lval_eval(lval_read(r.output));
      lval_println(x);
      lval_del(x);
      mpc_ast_delete(r.output);
    } else {
      mpc_err_print(r.error);
      mpc_err_delete(r.error);
    }
    free(input);
  }

  mpc_cleanup(6, Number, Symbol, Sexpr, Qexpr, Expr, Lispy);
  return 0;
}

Compile with:

gcc -g -std=c99 -Wall main.c mpc.c -lreadline -lm -o main

Running the interpreter demonstrates the new Q‑Expression functions:

Lispy Version 0.1
Press Ctrl+c to Exit

lispy> head {1 2 3}
{1}

lispy> tail {1 2 3}
{2 3}

lispy> join {1 2 3} {4 5 6}
{1 2 3 4 5 6}

lispy> list {1 2 3} {4 5 6}
{{1 2 3} {4 5 6}}

lispy> eval {+ 1 2 3}
6

C macro list operations Parser Lisp interpreter Q-Expression

Written by

AI Cyberspace

AI, big data, cloud computing, and networking.

0 followers

Reader feedback

How this landed with the community

Rate this article

Was this worth your time?

Discussion

0 Comments

Thoughtful readers leave field notes, pushback, and hard-won operational detail here.

Previous Articles

Quoted Expressions

Quoted Expression Parser

Q‑Expression Syntax Parsing Implementation

Q‑Expression Storage Implementation

Reading and Storing S‑Expression

Key Q‑Expression Functions

Head Function

Tail Function

Macro‑Based Assertions

Join Function

List Function

Eval Function

Function Router

Complete Source Code

AI Cyberspace

How this landed with the community

Was this worth your time?

0 Comments