typedef struct expression {
  struct expression *ca,*cd;
} list_space, *LIST;
#define NIL 0
#define CAR(x) ((x)->ca)
#define CDR(x) ((x)->cd)
#define RPLACA(l, r) (CAR(l) = (r))
#define RPLACD(l, r) (CDR(l) = (r))
#define LARGE 1000
list_space heap[LARGE];
list HEAP = &heap[0];
#define CONS(A, D) (RPLACA(HEAP, A), RPLACD(HEAP, D), (HEAP++))
#define EQ(s, t) ((s) == (t))
#define NULLP(e) (!(e))
#define ATOM_VALUE ((list)-1)
#define ATOMP(e) (CAR(e) == ATOM_VALUE)
#define MAKE_ATOM(e) CONS(ATOM_VALUE, e)

list INTERN(s)
char *s;
{
/* puts symbols into the OBLIST so symbols with same
  names are eq */
}

 #define ENQUOTE(e) CONS(intern("quote"), CONS(e, NIL))
 #define READ_ELEMENTS()  (peek_ch() == ')') ? NIL : CONS(read(), read_cdr())
list READ_CDR()
{
  if (scan_if('.'))
    return read();
  else
    return read_elements();
}
list READ()
{
  int ch;
  list ret;
  switch (ch = scan()) {
    case NIL:
      return NIL;
    case atom_token:
      return atom_val;
    case '\'':
      return enquote(read());
    case '(':
      ret = read_elements();
      scan_if(')');
      return ret;
    default:
      error("unexpected token");
      return NIL;
    }
}

list APPLY(fn, args, alist)
list fn, args, alist;
{
/* get the definition of fn, bind formals to actuals, then
  evaluate the body of the function in that scope context */
}
list ASSOC(n, alist)
list n, alist;
{
/* returns the association of n in the alist e.g.,
  assoc('a, '((a . b)(b . c)(x . nil))) returns (a . b) */
}
list EVAL_BODY(l, alist)
register list l, alist;
{
  register list res;
  for (res=NIL; l; l = CDR(l))
    res = eval(CAR(l), alist);
  return res;
}
list EVAL(e, alist)
list e, alist;
{
  if (nullp(e))
    return e;
  else if (symbolp(e))
    return CDR(assoc(e, alist));
  else
    return apply(CAR(e), CDR(e), alist);
}

void PRINT_CDR(s)
register list s;
{
  for (; s; s=CDR(s))
    if (atomp(s)) {
      put_str(" . "); print(l);
    } else {
      put_char(' '); print(CAR(s));
    }
}
#define PRINT_ATOM(a) put_str(CDR(a))
void PRINT_LIST(s)
list s;
{
  print(CAR(s));
  print_cdr(CDR(s));
}
list PRINT(s)
list s;
{
  if (atomp(s))
    print_atom(s);
  else
    print_list(s);
  return s;
}

void main()
{
  for (;;)
    print(eval(read(), NIL));
}

(expr add_bindings (new old)
  (cond [!new nil]
    [(eq (caar new) nil) old]
    [(assoc (caar new) old) (add_bindings (cdr new) old]
    [(cons (car new) (add_bindings (cdr new) old]
]
(expr solve_goal_conjunction (l b)
  (cond [!b nil]
    [!l b]
    [(solve_goal_conjunction (cdr l) (add_bindings (satisfy (car l) b) b)]
]
(expr solve_clause (g clause bindings)
  (solve_goal_conjunction (cdr clause) (unify g (car clause) bindings]
(expr some_satisfying_clause (g bindings clauses)
  (cond [!clauses nil]
    [(add_bindings (solve_clause g (car clauses) bindings) bindings)]
    [(some_satisfying_clause g bindings (cdr clauses)]
]
(expr satisfy (g bindings)
  (some_satisfying_clause g bindings (get_clauses (car g]
(expr solve (g)
  (satisfy g '((nil.nil)))
]

(expr is_var (a)
  (and a (symbolp a) (eq (scar (get_prop a 'pname))  ?]
(expr transitive_binding (var bindings)
  (= a (assoc var bindings))
  (cond [(is_var (cdr a)) (transitive_binding (cdr a) bindings]
    [(cdr a)]
]
(expr add_bound_variable (var val bindings)
  (cond [(is_var var) (add_bound_variable val
        (transitive_binding var bindings) bindings]
    [(equal val var) bindings]
]
(expr add_binding_if_consistent (var val bindings)
  (cond [!bindings nil]
    [(= R (assoc var bindings)) (add_bound_variable (cdr R) val bindings]
    [(cons (cons var val) bindings]
]
(expr find_bindings (pat1 pat2 bindings)
  (cond [!bindings nil]
    [(is_var pat1) (add_binding_if_consistent pat1 pat2 bindings)]
    [(is_var pat2) (add_binding_if_consistent pat2 pat1 bindings)]
    [(or (atomp pat1) (atomp pat2)) (and (eq pat1 pat2) bindings]
    [(find_bindings (cdr pat1) (cdr pat2)
          (find_bindings (car pat1) (car pat2) bindings))]))
(expr unify (pat1 pat2)
  (find_bindings pat1 pat2 '((nil.nil]

(expr push_prop (i v p)
  (put_prop i (cons v (get_prop i p)) p]
(expr get_clauses (n) (get_prop n 'clauses]
(expr put_fact (f)
  (push_prop (caar f) f 'clauses)
]
(fexpr fact (l)
  (put_fact l]

(fact (parents ryan (kris john)))
(fact (parents kris (jenifer carl)))
(fact (parents john (laura steve)))
(fact (grandparents ?person (?dgrandma ?mgrandma) (?dgrandpa ?mgrandpa))
    (parents ?person (?mom ?dad))
    (parents ?dad (?dgrandma ?dgrandpa))
    (parents ?mom (?mgrandma ?mgrandpa))
]
(expr question ()
  (solve '(grandparents ryan ?grandmas ?grandpas))
]