Improved ast.c side.

Pascal J. Bourguignon [2013-02-03 23:48]
Improved ast.c side.
Filename
ast.c
diff --git a/ast.c b/ast.c
index 4d0a233..1bf9729 100644
--- a/ast.c
+++ b/ast.c
@@ -1,28 +1,92 @@
+/* -*- mode:c;coding:iso-8859-1 -*- */
+/*****************************************************************************
+****FILE:               ast.c
+****LANGUAGE:           c
+****SYSTEM:             POSIX
+****USER-INTERFACE:     NONE
+****DESCRIPTION
+****
+****    Dumps the AST obtained from the clang-c parsing library as a
+****    S-Exp, that can be easily read by lisp programs.
+****
+****AUTHORS
+****    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+****MODIFICATIONS
+****    2013-01-29 <PJB> Created.
+****    2013-02-03 <PJB>
+****BUGS
+****LEGAL
+****    AGPL3
+****
+****    Copyright Pascal J. Bourguignon 2013 - 2013
+****
+****    This program is free software: you can redistribute it and/or
+****    modify it under the terms of the GNU Affero General Public
+****    License as published by the Free Software Foundation, either
+****    version 3 of the License, or (at your option) any later
+****    version.
+****
+****    This program is distributed in the hope that it will be
+****    useful, but WITHOUT ANY WARRANTY; without even the implied
+****    warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+****    PURPOSE.  See the GNU Affero General Public License for more
+****    details.
+****
+****    You should have received a copy of the GNU Affero General
+****    Public License along with this program.  If not, see
+****    <http://www.gnu.org/licenses/>.
+*****************************************************************************/
 #include <stdio.h>
 #include <stdlib.h>
 #include <stdarg.h>
 #include <string.h>
 #include <iso646.h>
+#include <ctype.h>
+#include <limits.h>
 #include <clang-c/Index.h>

-// Viva Greenspun's Tenth Law!
-
+// Viva Greenspun's Tenth Law! (even Q&D).

 typedef enum {false=0,true=1} bool;

 #define INCF(X) (++(X))
 #define DECF(X) (--(X))
+
 #define CONCAT_INTERN(A,B) A##B
 #define CONCAT(A,B) CONCAT_INTERN(A,B)
-#define PUSH(ELEMENT,LIST_PLACE) \
+
+#define PUSH(ELEMENT,LIST_PLACE)                                        \
     ({ (LIST_PLACE)=cons((ELEMENT),(LIST_PLACE)); })
-#define POP_INTERN(RESVAR,LIST_PLACE) \
-    ({ id RESVAR=car(LIST_PLACE); (LIST_PLACE)=cdr(LIST_PLACE); RESVAR; })
-#define POP(LIST_PLACE) \
+
+#define POP_INTERN(RESVAR,LIST_PLACE)                                   \
+    ({ id RESVAR=car(LIST_PLACE);                                       \
+        (LIST_PLACE)=cdr(LIST_PLACE);                                   \
+        RESVAR; })
+
+#define POP(LIST_PLACE)                                                 \
     POP_INTERN(CONCAT(result_,__LINE__),LIST_PLACE)

 #define PUSH2(k,v,plist) ({PUSH(v,plist);PUSH(k,plist);})

+#define DOTIMES_INTERNAL(VAR,COUNT_VAR,COUNT,BODY)                      \
+    do{                                                                 \
+        typeof(COUNT) COUNT_VAR=(COUNT);                                \
+        for(typeof(COUNT) VAR=0;VAR<COUNT_VAR;INCF(VAR)){               \
+            BODY}                                                       \
+    }while(0)
+#define DOTIMES(VAR,COUNT,BODY) \
+    DOTIMES_INTERNAL(VAR,CONCAT(count_,__LINE__),COUNT,BODY)
+
+#define DOLIST_INTERNAL(VAR,LIST_VAR,LIST,BODY)                         \
+    do{                                                                 \
+        id LIST_VAR=(LIST);                                             \
+        while(LIST_VAR){                                                \
+            do{ id VAR=car(LIST_VAR); BODY }while(0);                   \
+            LIST_VAR=cdr(LIST_VAR);}                                    \
+    }while(0)
+#define DOLIST(VAR,LIST_EXPRESSION,BODY) \
+    DOLIST_INTERNAL(VAR,CONCAT(list_,__LINE__),LIST_EXPRESSION,BODY)
+



@@ -36,23 +100,22 @@ void signal_error(const char* file,int line,const char* function,const char* mes
     fflush(stderr);}


-#define ERROR_INTERNAL(MESSAGE,...)                      \
+#define ERROR_INTERNAL(MESSAGE,...)                                         \
     do{                                                                     \
         signal_error(__FILE__,__LINE__,__FUNCTION__,MESSAGE,##__VA_ARGS__); \
-        exit(1);                                                            \
-    }while(0)
+        exit(1);}                                                           \
+    while(0)
 #define ERROR(MESSAGE,...)                                              \
     ERROR_INTERNAL(MESSAGE,##__VA_ARGS__)

 #define ASSERT_INTERNAL(EXPRESSION)                                     \
     do{                                                                 \
-        if(!(EXPRESSION)){                                              \
-            fflush(stdout);                                             \
-            signal_error(__FILE__,__LINE__,__FUNCTION__,                \
-                         "assertion failed: %s",#EXPRESSION);           \
-            exit(1);                                                    \
-        }                                                               \
-    }while(0)
+       if(!(EXPRESSION)){                                               \
+           fflush(stdout);                                              \
+           signal_error(__FILE__,__LINE__,__FUNCTION__,                 \
+                        "assertion failed: %s",#EXPRESSION);            \
+           exit(1);}}                                                   \
+    while(0)

 #define UNLESS_ASSERT_INTERNAL(EXPRESSION,BODY)                         \
     do{                                                                 \
@@ -62,15 +125,14 @@ void signal_error(const char* file,int line,const char* function,const char* mes
                          "assertion failed: %s",#EXPRESSION);           \
             { BODY }                                                    \
               fflush(stderr);                                           \
-              exit(1);                                                  \
-        }                                                               \
-    }while(0)
+              exit(1);}}                                                \
+    while(0)


 #define assert(EXPRESSION) ASSERT_INTERNAL(EXPRESSION)
 #define unless_assert(EXPRESSION,BODY) UNLESS_ASSERT_INTERNAL(EXPRESSION,BODY)
-#define ASSERT(EXPRESSION,MESSAGE,...) UNLESS_ASSERT_INTERNAL(EXPRESSION,{fprintf(stderr,MESSAGE,##__VA_ARGS__);})
-
+#define ASSERT(EXPRESSION,MESSAGE,...) \
+    UNLESS_ASSERT_INTERNAL(EXPRESSION,{fprintf(stderr,MESSAGE,##__VA_ARGS__);})



@@ -85,49 +147,69 @@ void* memory_allocate(const char* fname,int element_size,int element_count){
     // /*DEBUG*/printf("%s(%s,%d)\n",__FUNCTION__,fname,size); fflush(stdout);
     void* memory=malloc(imax(0,element_size*element_count));
     if(0==memory){
-        fprintf(stderr,"%s: out of memory\n",fname);
-        exit(1);}
+        ERROR("%s: out of memory.",fname);}
     return(memory);}



-
+typedef long long integer_t;
+typedef char      character_t;
+#define INTEGER_FMT   "%lld"
+#define CHARACTER_FMT "%c"

 typedef enum {
     ot_nil=0,
     ot_t,
     ot_object=ot_t,
-    ot_CXCursor,    // CXCursor*
+    ot_CXCursor,    // CXCursor
+    ot_CXType,      // CXType
+    ot_CXToken,     // CXToken
+    ot_CXTranslationUnit, // CXTranslationUnit
+    ot_stream,      // FILE*
     ot_int,         // int
     ot_char,        // char
-    ot_cons,        // cons*
-    ot_vector,      // vector*
-    ot_hashtable,   // hashtable*
+    ot_cons,        // cons_t*
+    ot_vector,      // vector_t*
+    ot_symbol,      // symbol_t*
+    ot_package,     // package_t*
+    ot_hashtable,   // hashtable_t*
 } object_type;

 const char* type_name(object_type type){
-    switch(type){
-      case ot_nil:       return("nil");
-      case ot_t:         return("t");
-      case ot_CXCursor:  return("CXCursor");
-      case ot_int:       return("integer");
-      case ot_char:      return("character");
-      case ot_cons:      return("cons");
-      case ot_vector:    return("vector");
-      case ot_hashtable: return("hashtable");
-      default:           ASSERT(false,"Unknown type %d",type);}}
+switch(type){
+  case ot_nil:                 return("nil");
+  case ot_t:                   return("t");
+  case ot_CXCursor:            return("CXCursor");
+  case ot_CXType:              return("CXType");
+  case ot_CXToken:             return("CXToken");
+  case ot_CXTranslationUnit:   return("CXTranslationUnit");
+  case ot_stream:              return("stream");
+  case ot_int:                 return("integer");
+  case ot_char:                return("character");
+  case ot_cons:                return("cons");
+  case ot_vector:              return("vector");
+  case ot_symbol:              return("symbol");
+  case ot_package:             return("package");
+  case ot_hashtable:           return("hashtable");
+  default:                     ASSERT(false,"Unknown type %d",type);}}

 int type_size(object_type type){
-    switch(type){
-      case ot_nil:       return(0);
-      case ot_t:         return(sizeof(struct object*));
-      case ot_CXCursor:  return(sizeof(CXCursor));
-      case ot_int:       return(sizeof(int));
-      case ot_char:      return(sizeof(char));
-      case ot_cons:      return(sizeof(struct cons*));
-      case ot_vector:    return(sizeof(struct vector*));
-      case ot_hashtable: return(sizeof(struct hashtable*));
-      default:           ASSERT(false,"Unknown type %d",type);}}
+switch(type){
+  case ot_nil:                 return(0);
+  case ot_t:                   return(sizeof(struct object*));
+  case ot_CXCursor:            return(sizeof(CXCursor));
+  case ot_CXType:              return(sizeof(CXType));
+  case ot_CXToken:             return(sizeof(CXToken));
+  case ot_CXTranslationUnit:   return(sizeof(CXTranslationUnit));
+  case ot_stream:              return(sizeof(FILE*));
+  case ot_int:                 return(sizeof(integer_t));
+  case ot_char:                return(sizeof(character_t));
+  case ot_cons:                return(sizeof(struct cons*));
+  case ot_vector:              return(sizeof(struct vector*));
+  case ot_symbol:              return(sizeof(struct symbol*));
+  case ot_package:             return(sizeof(struct package*));
+  case ot_hashtable:           return(sizeof(struct hashtable*));
+  default:                     ASSERT(false,"Unknown type %d",type);}}



@@ -137,16 +219,43 @@ typedef struct object {
     object_type type;
     union {
         CXCursor cursor;
-        int integer;
-        char character;
+        CXType type;
+        CXToken token;
+        CXTranslationUnit translation_unit;
+        integer_t integer;
+        character_t character;
+        FILE* stream;
         struct cons* cons;
         struct vector* vector;
+        struct symbol* symbol;
+        struct package* package;
         struct hashtable* hashtable;
     } value;
 } object;

 typedef object* id;

+id string(const char*);
+id intern(id name,id pack);
+#define KW(NAME) (intern(string(#NAME),keyword))
+#define SY(NAME) (intern(string(#NAME),package))
+
+
+
+id standard_input=0;
+id standard_output=0;
+id error_output=0;
+id trace_output=0;
+id objects_being_printed=0;
+id print_circle=0;
+id all_packages=0; // list all packages
+id user=0;    // user package
+id keyword=0; // keyword package
+id package=0; // current package
+
+id prin1(id object,id stream);
+
+

 void* nil=0;

@@ -154,15 +263,17 @@ bool null(void* object){
     return(0==object);}

 static object t_object={ot_t};
-id t=&t_object;
+id t=&t_object; // temporarily. It's replaced my SY(t) in initialize.a

 id boolean(int value){
     return(value?t:nil);}


 object_type type_of(id object){
-    assert(nil!=object);
-    return(object->type);}
+    if(null(object)){
+        return(ot_nil);}
+    else{
+        return(object->type);}}

 id box(object_type type,...){
     id o=memory_allocate(__FUNCTION__,sizeof(*o),1);
@@ -171,10 +282,17 @@ id box(object_type type,...){
     va_start(ap,type);
     switch(type){
       case ot_CXCursor:  o->value.cursor=(va_arg(ap,CXCursor));             break;
-      case ot_int:       o->value.integer=va_arg(ap,int);                   break;
+      case ot_CXType:    o->value.type=(va_arg(ap,CXType));                 break;
+      case ot_CXToken:   o->value.token=(va_arg(ap,CXToken));               break;
+      case ot_CXTranslationUnit:
+          o->value.translation_unit=(va_arg(ap,CXTranslationUnit));         break;
+      case ot_stream:    o->value.stream=(va_arg(ap,FILE*));                break;
+      case ot_int:       o->value.integer=va_arg(ap,integer_t);             break;
       case ot_char:      o->value.character=va_arg(ap,int);                 break;
       case ot_cons:      o->value.cons=va_arg(ap,struct cons*);             break;
       case ot_vector:    o->value.vector=va_arg(ap,struct vector*);         break;
+      case ot_symbol:    o->value.symbol=va_arg(ap,struct symbol*);         break;
+      case ot_package:   o->value.package=va_arg(ap,struct package*);       break;
       case ot_hashtable: o->value.hashtable=va_arg(ap,struct hashtable*);   break;
       default: ERROR("unexpected object type %s.",type_name(type));         break;}
     va_end(ap);
@@ -193,13 +311,66 @@ CXCursor unbox_cursor(id o){
     return(o->value.cursor);}


+id typep(id x){
+    return(boolean(not(null(x)) and (ot_CXType==type_of(x))));}
+
+id type(CXType value){
+    return(box(ot_CXType,value));}
+
+CXType unbox_type(id o){
+    assert(nil!=o);
+    assert(ot_CXType==type_of(o));
+    return(o->value.type);}
+
+
+id tokenp(id x){
+    return(boolean(not(null(x)) and (ot_CXToken==type_of(x))));}
+
+id token(CXToken value){
+    return(box(ot_CXToken,value));}
+
+CXToken unbox_token(id o){
+    assert(nil!=o);
+    assert(ot_CXToken==type_of(o));
+    return(o->value.token);}
+
+
+
+
+id translation_unit_p(id x){
+    return(boolean(not(null(x)) and (ot_CXTranslationUnit==type_of(x))));}
+
+id translationUnit(CXTranslationUnit value){
+    return(box(ot_CXTranslationUnit,value));}
+
+CXTranslationUnit unbox_translation_unit(id o){
+    assert(nil!=o);
+    assert(ot_CXTranslationUnit==type_of(o));
+    return(o->value.translation_unit);}
+
+
+
+id streamp(id x){
+    return(boolean(not(null(x)) and (ot_stream==type_of(x))));}
+
+id stream(FILE* value){
+    return(box(ot_stream,value));}
+
+FILE* unbox_stream(id o){
+    assert(nil!=o);
+    assert(ot_stream==type_of(o));
+    return(o->value.stream);}
+
+
+
+
 id integerp(id x){
     return(boolean(not(null(x)) and (ot_int==type_of(x))));}

-id integer(int value){
+id integer(integer_t value){
     return(box(ot_int,value));}

-int unbox_integer(id o){
+integer_t unbox_integer(id o){
     assert(nil!=o);
     assert(ot_int==type_of(o));
     return(o->value.integer);}
@@ -219,10 +390,10 @@ id minusp(id object){
 id characterp(id x){
     return(boolean(not(null(x)) and (ot_char==type_of(x))));}

-id character(char value){
+id character(character_t value){
     return(box(ot_char,value));}

-char unbox_character(id o){
+character_t unbox_character(id o){
     assert(nil!=o);
     assert(ot_char==type_of(o));
     return(o->value.character);}
@@ -320,7 +491,7 @@ int list_length(id list){
     int n=0;
     while(consp(list)){
         list=cdr(list);
-        n++;}
+        INCF(n);}
     return(n);}

 id list(int n,...){
@@ -332,7 +503,7 @@ id list(int n,...){
           va_start(ap,n);
           id result=cons(va_arg(ap,id),nil);
           id tail=result;
-          for(int i=1;i<n;i++){
+          for(int i=1;i<n;INCF(i)){
               setcdr(tail,cons(va_arg(ap,id),nil));
               tail=cdr(tail);}
           va_end(ap);
@@ -354,7 +525,7 @@ id prepend(int n,...){
           va_start(ap,n);
           id result=cons(va_arg(ap,id),nil);
           id tail=result;
-          for(int i=2;i<n;i++){
+          for(int i=2;i<n;INCF(i)){
               setcdr(tail,cons(va_arg(ap,id),nil));
               tail=cdr(tail);}
           va_end(ap);
@@ -385,8 +556,8 @@ id nreverse(id list){

 id copy_list(id list){
     if(null(list)){
-        return(nil);
-    }else{
+        return(nil);}
+    else{
         id result=cons(car(list),nil);
         id tail=result;
         list=cdr(list);
@@ -410,13 +581,34 @@ id append(int n,...){
           va_start(ap,n);
           id result=cons(nil,nil);
           id tail=result;
-          for(int i=1;i<n;i++){
+          for(int i=1;i<n;INCF(i)){
               setcdr(tail,copy_list(va_arg(ap,id)));
               tail=last(tail);}
           setcdr(tail,va_arg(ap,id));
           va_end(ap);
           return(cdr(result));}}}

+id nconc(int n,...){
+    switch(n){
+      case 0: return(nil);
+      case 1:{
+          va_list ap;
+          va_start(ap,n);
+          id result=va_arg(ap,id);
+          va_end(ap);
+          return(result);}
+      default:{
+          va_list ap;
+          va_start(ap,n);
+          id result=cons(nil,nil);
+          id tail=result;
+          for(int i=1;i<n;INCF(i)){
+              setcdr(tail,va_arg(ap,id));
+              tail=last(tail);}
+          setcdr(tail,va_arg(ap,id));
+          va_end(ap);
+          return(cdr(result));}}}
+

 typedef struct vector {
     object_type element_type;
@@ -447,8 +639,7 @@ id make_vector(object_type element_type,int size,int fill_pointer,const void* in
     v->size=size;
     v->fill_pointer=fill_pointer;
     if(0!=initial_element){
-        for(int i=0;i<size;i++){
-            vector_set_data(v,i,initial_element);}}
+        DOTIMES(i,size,{vector_set_data(v,i,initial_element);});}
     return(box(ot_vector,v));}

 object_type vector_element_type(id vect){
@@ -483,13 +674,13 @@ vector_t* vector_set_data(vector_t* v,int index,const void* data){
     memcpy(slot,data,element_size);
     return(v);}

-id vector_set_char(id vect,int index,char data){
+id vector_set_char(id vect,int index,character_t data){
     vector_t* v=unbox_vector(vect);
     assert(ot_char==v->element_type);
     vector_set_data(v,index,&data);
     return(vect);}

-id vector_set_int(id vect,int index,int data){
+id vector_set_int(id vect,int index,integer_t data){
     vector_t* v=unbox_vector(vect);
     assert(ot_int==v->element_type);
     vector_set_data(v,index,&data);
@@ -503,24 +694,21 @@ id vector_set(id vect,int index,id object){
           break;
       case ot_int:
           if(ot_int==type_of(object)){
-              int value=unbox_integer(object);
-              vector_set_data(v,index,&value);
-          }else{
-              ERROR("Trying to store a non-integer into a (VECTOR INTEGER).");
-          }
+              integer_t value=unbox_integer(object);
+              vector_set_data(v,index,&value);}
+          else{
+              ERROR("Trying to store a non-integer into a (VECTOR INTEGER).");}
           break;
       case ot_char:
           if(ot_char==type_of(object)){
-              char value=unbox_character(object);
-              vector_set_data(v,index,&value);
-          }else{
-              ERROR("Trying to store a non-character into a STRING.");
-          }
+              character_t value=unbox_character(object);
+              vector_set_data(v,index,&value);}
+          else{
+              ERROR("Trying to store a non-character into a STRING.");}
           break;
       default:
           ERROR("Unexpected vector element type %s.",type_name(v->element_type));
-          break;
-    }
+          break;}
     return(vect);}

 id vector(int n,...){
@@ -531,8 +719,7 @@ id vector(int n,...){
           id v=make_vector(ot_t,n,n,0);
           va_list ap;
           va_start(ap,n);
-          for(int i=0;i<n;i++){
-              vector_set(v,i,va_arg(ap,id));}
+          DOTIMES(i,n,{vector_set(v,i,va_arg(ap,id));});
           va_end(ap);
           return(v);}}}

@@ -542,18 +729,18 @@ void* vector_get_data(vector_t* v,int index){
     assert(index<v->size);
     return(v->data+type_size(v->element_type)*index);}

-char vector_get_char(id vect,int index){
+character_t vector_get_char(id vect,int index){
     vector_t* v=unbox_vector(vect);
     assert(ot_char==v->element_type);
-    char result;
-    memcpy(&result,vector_get_data(v,index),sizeof(char));
+    character_t result;
+    memcpy(&result,vector_get_data(v,index),sizeof(character_t));
     return(result);}

-int vector_get_int(id vect,int index){
+integer_t vector_get_int(id vect,int index){
     vector_t* v=unbox_vector(vect);
     assert(ot_int==v->element_type);
-    int result;
-    memcpy(&result,vector_get_data(v,index),sizeof(int));
+    integer_t result;
+    memcpy(&result,vector_get_data(v,index),sizeof(integer_t));
     return(result);}

 id vector_get(id vect,int index){
@@ -561,18 +748,17 @@ id vector_get(id vect,int index){
     id result=0;
     switch(v->element_type){
       case ot_t:
-          memcpy(&result,vector_get_data(v,index),sizeof(id));
+          memcpy(&result,vector_get_data(v,index),type_size(ot_t));
           break;
       case ot_int:
-          result=integer(*(int*)vector_get_data(v,index));
+          result=integer(*(integer_t*)vector_get_data(v,index));
           break;
       case ot_char:
-          result=character(*(char*)vector_get_data(v,index));
+          result=character(*(character_t*)vector_get_data(v,index));
           break;
       default:
           ERROR("Unexpected vector element type %s.",type_name(v->element_type));
-          break;
-    }
+          break;}
     return(result);}


@@ -583,8 +769,8 @@ id stringp(id x){

 id string(const char* text){
     int len=strlen(text);
-    id vect=make_vector(ot_char,len,len,0);
-    memcpy(vect->value.vector->data,text,len);
+    id vect=make_vector(ot_char,1+len,len,0);
+    strcpy(vect->value.vector->data,text);
     return(vect);}

 const char* unbox_string(id string){
@@ -595,11 +781,12 @@ bool string_equal(vector_t* a,vector_t* b){
     if((a->element_type!=b->element_type)
        or (ot_char!=a->element_type)
        or (a->fill_pointer!=b->fill_pointer)){
-        return(false);
-    }
+        return(false);}
     return(0==memcmp(a->data,b->data,a->fill_pointer));}

-unsigned string_hash(vector_t* s){
+unsigned string_hash(id string){
+    assert(stringp(string));
+    vector_t* s=unbox_vector(string);
     // djb2 (k=33)
     assert(nil!=s);
     assert(ot_char==s->element_type);
@@ -612,37 +799,40 @@ unsigned string_hash(vector_t* s){
     return(hash);}


-
-
 int length(id object){
     if(null(object)){
-        return(0);
-    }else if(consp(object)){
-        return(list_length(object));
-    }else if(vectorp(object)){
-        return(vector_length(object));
-    }else{
+        return(0);}
+    else if(consp(object)){
+        return(list_length(object));}
+    else if(vectorp(object)){
+        return(vector_length(object));}
+    else{
         ERROR("Expected object of type SEQUENCE, not %s.",type_name(type_of(object)));
         return(0);}}


 id equal(id a,id b){
     if(a==b){
-        return(t);
-    }else if(a->type==b->type){
+        return(t);}
+    else if(null(a) or null(b)){
+        return(false);}
+    else if(a->type==b->type){
         switch(a->type){
           case ot_nil:       return(t);
           case ot_CXCursor:  return(boolean(clang_equalCursors(a->value.cursor,b->value.cursor)));
+          case ot_CXType:    return(boolean(clang_equalTypes(a->value.type,b->value.type)));
           case ot_int:       return(boolean(a->value.integer==b->value.integer));
           case ot_char:      return(boolean(a->value.character==b->value.character));
           case ot_cons:      return(boolean(equal(car(a),car(b)) and equal(cdr(a),cdr(b))));
           case ot_vector:    return(boolean((a->value.vector==b->value.vector)
                                             or ((ot_char==a->value.vector->element_type))
-                                                and (ot_char==b->value.vector->element_type)
-                                                and string_equal(a->value.vector,b->value.vector)));
+                                            and (ot_char==b->value.vector->element_type)
+                                            and string_equal(a->value.vector,b->value.vector)));
+          case ot_symbol:    return(boolean(a->value.symbol==b->value.symbol));
+          case ot_package:   return(boolean(a->value.package==b->value.package));
           case ot_hashtable: return(boolean(a->value.hashtable==b->value.hashtable));
-          default: assert(!"Unexpected type in an object."); return(nil); }
-    }else{
+          default: assert(!"Unexpected type in an object."); return(nil); }}
+    else{
         return(nil);}}


@@ -653,47 +843,60 @@ typedef struct hashtable {
     float rehash_size;
     float rehash_threshold;
     id* entries;
-} hashtable;
+} hashtable_t;

 id hashtablep(id x){
     return(boolean(not(null(x)) and (ot_hashtable==type_of(x))));}

-hashtable* unbox_hashtable(id o){
+hashtable_t* unbox_hashtable(id o){
     assert(nil!=o);
     assert(ot_hashtable==type_of(o));
     return(o->value.hashtable);}

 int hashtable_count(id table){
-    hashtable* h=unbox_hashtable(table);
+    hashtable_t* h=unbox_hashtable(table);
     return(h->count);}

 int hashtable_size(id table){
-    hashtable* h=unbox_hashtable(table);
+    hashtable_t* h=unbox_hashtable(table);
     return(h->size);}

 float hashtable_rehash_size(id table){
-    hashtable* h=unbox_hashtable(table);
+    hashtable_t* h=unbox_hashtable(table);
     return(h->rehash_size);}

 float hashtable_rehash_threshold(id table){
-    hashtable* h=unbox_hashtable(table);
+    hashtable_t* h=unbox_hashtable(table);
     return(h->rehash_threshold);}

-
-unsigned hashtable_hash(hashtable*);
+unsigned hashtable_hash(hashtable_t*);
+id symbol_name(id symbol);

 unsigned sxhash(id o){
-    switch(o->type){
+    switch(type_of(o)){
       case ot_nil:       return(0);
+      case ot_t:         assert(!"Invalid object"); return(0);
       case ot_CXCursor:  return(clang_hashCursor(o->value.cursor));
+      case ot_CXType:    return(o->value.type.kind
+                                ^((unsigned)(o->value.type.data[0])<<5)
+                                ^((unsigned)(o->value.type.data[1])));
+      case ot_CXToken:   return(o->value.token.int_data[0]
+                                ^(o->value.token.int_data[1]<<1)
+                                ^(o->value.token.int_data[2]<<2)
+                                ^(o->value.token.int_data[3]<<3)
+                                ^((unsigned)(o->value.token.ptr_data)<<5));
+      case ot_CXTranslationUnit:  return((unsigned)(o->value.translation_unit));
+      case ot_stream:    return((unsigned)(o->value.stream));
       case ot_int:       return(o->value.integer);
       case ot_char:      return(o->value.character);
-      case ot_cons:      return(sxhash(car(o))+(sxhash(cdr(o))<<1));
+      case ot_cons:      return(sxhash(car(o))^(sxhash(cadr(o))<<1)^(sxhash(caddr(o))<<3));
+      case ot_symbol:    return(string_hash(symbol_name(o)));
       case ot_vector:    return((ot_char==o->value.vector->element_type)
-                                ?string_hash(o->value.vector)
+                                ?string_hash(o)
                                 :(unsigned)(o->value.vector));
-      case ot_hashtable: return((unsigned)(o->value.hashtable));
-      case ot_t:         assert(!"Invalid object"); return(0); }}
+      case ot_package:   return((unsigned)(o->value.package));
+      case ot_hashtable: return((unsigned)(o->value.hashtable));}
+    return(0);}


 int ceiling_to_nearest_prime(int n);
@@ -705,24 +908,21 @@ bool hashtable_entry_deleted_p(id entry){

 id make_hashtable(int size){
     if(null(hashtable_deleted_entry)){
-        hashtable_deleted_entry=cons(nil,nil);}
-    hashtable* h=memory_allocate(__FUNCTION__,sizeof(*h),1);
+        hashtable_deleted_entry=cons(string("deleted"),nil);}
+    hashtable_t* h=memory_allocate(__FUNCTION__,sizeof(*h),1);
     h->count=0;
     h->size=primep(size)?size:ceiling_to_nearest_prime(1+size);
     h->rehash_size=2.0;
     h->rehash_threshold=1.5;
     h->entries=memory_allocate(__FUNCTION__,sizeof(*(h->entries)),h->size);
-    int i=0;
-    for(i=0;i<h->size;i++){
-        h->entries[i]=nil;}
+    DOTIMES(i,h->size,{h->entries[i]=nil;});
     return(box(ot_hashtable,h));}

-unsigned hashtable_hash(hashtable* table){
+unsigned hashtable_hash(hashtable_t* table){
     return((table->size<<3)+table->count);}

-
 id hashtable_get(id table,id key){
-    hashtable* h=unbox_hashtable(table);
+    hashtable_t* h=unbox_hashtable(table);
     unsigned hash=sxhash(key);
     int i=hash%h->size;
     while(not(null(h->entries[i]))
@@ -730,8 +930,14 @@ id hashtable_get(id table,id key){
         i=(i+1)%h->size;}
     return(cdr(h->entries[i]));}

+id hashtable_clear(id table){
+    hashtable_t* h=unbox_hashtable(table);
+    h->count=0;
+    memset(h->entries,0,sizeof(h->entries[0])*h->size);
+    return(table);}
+
 id hashtable_remove(id table,id key){
-    hashtable* h=unbox_hashtable(table);
+    hashtable_t* h=unbox_hashtable(table);
     unsigned hash=sxhash(key);
     int i=hash%h->size;
     while(not(null(h->entries[i]))
@@ -741,40 +947,154 @@ id hashtable_remove(id table,id key){
     if(equal(car(entry),key)){
         DECF(h->count);
         h->entries[i]=hashtable_deleted_entry;
-        return(cdr(entry));
-    }else{
+        return(cdr(entry));}
+    else{
         return(nil);}}

 typedef void(*hashtable_mapper_function)(id key,id value,void* data);

 void hashtable_map(id table,hashtable_mapper_function fun,void* data){
-    hashtable* h=unbox_hashtable(table);
+    hashtable_t* h=unbox_hashtable(table);
     int size=h->size;
     id* entries=h->entries;
-    for(int i=0;i<size;i++){
-        id entry=entries[i];
-        if(not(null(entry) or hashtable_entry_deleted_p(entry))){
-            fun(car(entry),cdr(entry),data);}}}
+    DOTIMES(i,size,
+            { id entry=entries[i];
+              if(not(null(entry) or hashtable_entry_deleted_p(entry))){
+                  fun(car(entry),cdr(entry),data);}});}

-void hashtable_statistics(id table){
-    hashtable* h=unbox_hashtable(table);
-    int runs=0;
-    int minrun=0;
-    int maxrun=0;
-    int deleted=0;
-    int maxdeleted=0;
-    int mindeleted=0;

-    id* entries=h->entries;
-
-}
+#define HASH_TRACE(BODY)

-hashtable* hashtable_grow(hashtable* h){
+id hashtable_statistics(id table){
+    hashtable_t* h=unbox_hashtable(table);
+    int runs=0;
+    int count_nil=0;
+    int count_deleted=0;
+    int count_used=0;
+    int start_used=0;
+    int start_deleted=0;
+    int run_size_min=INT_MAX;
+    int run_size_max=0;
+    int deleted_size_min=INT_MAX;
+    int deleted_size_max=0;
+    int nil_after_deleted=0;
+    int deleted_after_nil=0;
+    id* entries=h->entries;
+    enum {state_nil,state_deleted_in_nil,state_deleted_in_used,state_used} state=state_nil;
+    HASH_TRACE({printf("\n");});
+    for(int i=0;i<h->size;INCF(i)){
+        id entry=h->entries[i];
+        if(null(entry)){
+            HASH_TRACE({printf("_");});
+            INCF(count_nil);}
+        else if(hashtable_entry_deleted_p(entry)){
+            HASH_TRACE({printf("x");});
+            INCF(count_deleted);}
+        else{
+            HASH_TRACE({printf("U");});
+            INCF(count_used);}
+        switch(state){
+          case state_nil:
+              if(null(entry)){
+                  /*no change*/}
+              else if(hashtable_entry_deleted_p(entry)){
+                  if((0!=i) or null(h->entries[h->size-1])){
+                      INCF(deleted_after_nil);}
+                  start_deleted=i;
+                  state=state_deleted_in_nil;}
+              else{
+                  INCF(runs);
+                  start_used=i;
+                  state=state_used;}
+              break;
+          case state_deleted_in_nil:
+              if(null(entry)){
+                  INCF(nil_after_deleted);
+                  int currun=i-start_deleted;
+                  deleted_size_min=imin(deleted_size_min,currun);
+                  deleted_size_max=imax(deleted_size_max,currun);
+                  state=state_nil;}
+              else if(hashtable_entry_deleted_p(entry)){
+                  /*no change*/}
+              else{
+                  INCF(runs);
+                  int currun=i-start_deleted;
+                  deleted_size_min=imin(deleted_size_min,currun);
+                  deleted_size_max=imax(deleted_size_max,currun);
+                  start_used=i;
+                  state=state_used;}
+              break;
+          case state_deleted_in_used:
+              if(null(entry)){
+                  INCF(nil_after_deleted);
+                  int currun=i-start_deleted;
+                  deleted_size_min=imin(deleted_size_min,currun);
+                  deleted_size_max=imax(deleted_size_max,currun);
+                  currun=i-start_used;
+                  run_size_min=imin(run_size_min,currun);
+                  run_size_max=imax(run_size_max,currun);
+                  state=state_nil;}
+              else if(hashtable_entry_deleted_p(entry)){
+                  /*no change*/}
+              else{
+                  int currun=i-start_deleted;
+                  deleted_size_min=imin(deleted_size_min,currun);
+                  deleted_size_max=imax(deleted_size_max,currun);
+                  state=state_used;}
+              break;
+          case state_used:
+              if(null(entry)){
+                  int currun=i-start_used;
+                  run_size_min=imin(run_size_min,currun);
+                  run_size_max=imax(run_size_max,currun);
+                  HASH_TRACE({printf("(%d,%d)",run_size_min,run_size_max);});
+                  state=state_nil;}
+              else if(hashtable_entry_deleted_p(entry)){
+                  start_deleted=i;
+                  state=state_deleted_in_used;}
+              else{
+                  /*no change*/}
+              break;}}
+    switch(state){
+      case state_nil:
+          break;
+      case state_deleted_in_nil:
+          break;
+      case state_deleted_in_used:{
+          INCF(nil_after_deleted);
+          int currun=h->size-start_deleted;
+          deleted_size_min=imin(deleted_size_min,currun);
+          deleted_size_max=imax(deleted_size_max,currun);
+          currun=h->size-start_used;
+          run_size_min=imin(run_size_min,currun);
+          run_size_max=imax(run_size_max,currun);
+          state=state_nil;
+          break;}
+      case state_used:{
+          int currun=h->size-start_used;
+          run_size_min=imin(run_size_min,currun);
+          run_size_max=imax(run_size_max,currun);
+          HASH_TRACE({printf("(%d,%d)",run_size_min,run_size_max);});
+          break;}}
+    HASH_TRACE({printf("\n"); fflush(stdout);});
+    return(list(20,
+                KW(runs),integer(runs),
+                KW(count-nil),integer(count_nil),
+                KW(count-deleted),integer(count_deleted),
+                KW(count-used),integer(count_used),
+                KW(run-size-min),integer(run_size_min),
+                KW(run-size-max),integer(run_size_max),
+                KW(deleted-size-min),integer(deleted_size_min),
+                KW(deleted-size-max),integer(deleted_size_max),
+                KW(nil-after-deleted),integer(nil_after_deleted),
+                KW(deleted-after-nil),integer(deleted_after_nil)));}
+
+hashtable_t* hashtable_grow(hashtable_t* h){
     int newsize=ceiling_to_nearest_prime(h->size*h->rehash_threshold);
     id* newentries=memory_allocate(__FUNCTION__,sizeof(id),newsize);
-    for(int j=0;j<newsize;j++){
+    for(int j=0;j<newsize;INCF(j)){
         newentries[j]=nil;}
-    for(int i=0;i<h->size;i++){
+    for(int i=0;i<h->size;INCF(i)){
         id entry=h->entries[i];
         if(not(null(entry) or hashtable_entry_deleted_p(entry))){
             unsigned hash=sxhash(car(entry));
@@ -787,7 +1107,7 @@ hashtable* hashtable_grow(hashtable* h){
     return(h);}

 id hashtable_set(id table,id key,id value){
-    hashtable* h=unbox_hashtable(table);
+    hashtable_t* h=unbox_hashtable(table);
     unsigned hash=sxhash(key);
     int i=hash%h->size;
     while(not(null(h->entries[i]))
@@ -797,14 +1117,13 @@ id hashtable_set(id table,id key,id value){
     if(null(entry) or hashtable_entry_deleted_p(entry)){
         if(h->size<=h->count*h->rehash_size){
             hashtable_grow(h);
-            return(hashtable_set(table,key,value));
-        }else{
+            // /*DEBUG*/ prin1(hashtable_statistics(table),trace_output);
+            return(hashtable_set(table,key,value));}
+        else{
             INCF(h->count);
-            h->entries[i]=cons(key,value);
-        }
-    }else{
-        setcdr(entry,value);
-    }
+            h->entries[i]=cons(key,value);}}
+    else{
+        setcdr(entry,value);}
     return(value);}


@@ -812,17 +1131,17 @@ id compute_primes_to(int n){
     // /*DEBUG*/printf("%s(%d)\n",__FUNCTION__,n); fflush(stdout);
     const int zero=0;
     if(n<2){
-        return(make_vector(ot_int,0,0,&zero));
-    }else if(2==n){
+        return(make_vector(ot_int,0,0,&zero));}
+    else if(2==n){
         id primes=make_vector(ot_int,1,1,&zero);
         vector_set_int(primes,0,2);
-        return(primes);
-    }else if(3==n){
+        return(primes);}
+    else if(3==n){
         id primes=make_vector(ot_int,2,2,&zero);
         vector_set_int(primes,0,2);
         vector_set_int(primes,1,3);
-        return(primes);
-    }else{
+        return(primes);}
+    else{
         int bits_max;
         int words_max;
         int word_size=8*sizeof(int);
@@ -830,12 +1149,11 @@ id compute_primes_to(int n){
         int bit;
         int prime_count=2;
         int cur_prime=3;
-
         n-=(n%1)?3:2;
         bits_max=n/2;
         words_max=(bits_max+word_size-1)/word_size;
         bits=memory_allocate(__FUNCTION__,sizeof(int),words_max);
-        for(int i=0;i<words_max;i++){
+        for(int i=0;i<words_max;INCF(i)){
             bits[i]=(~0);}
         while(cur_prime<n){
             bit=cur_prime+(cur_prime-3)/2;
@@ -845,14 +1163,13 @@ id compute_primes_to(int n){
             bit=1+((cur_prime-3)/2);
             int pos=bit;
             while((pos<=bits_max) and (0==(bits[pos/word_size]&(1<<pos%word_size)))){
-                pos++; }
+                INCF(pos); }
             bit=pos;
             if(bit<bits_max){
                 cur_prime=bit+bit+3;
-                prime_count++;
-            }else{
-                cur_prime=n;
-            }}
+                INCF(prime_count);}
+            else{
+                cur_prime=n;}}
         // /*DEBUG*/printf("%s(%d) prime_count=%d\n",__FUNCTION__,n,prime_count); fflush(stdout);
         id primes=make_vector(ot_int,(1+prime_count),0,&zero);
         vector_set_fill_pointer(primes,1);
@@ -864,15 +1181,15 @@ id compute_primes_to(int n){
         vector_set_int(primes,curnum++,3);
         bit=1;
         while((bit<=bits_max) and (0==(bits[bit/word_size]&(1<<bit%word_size)))){
-            bit++; }
+            INCF(bit); }
         while((curnum<=prime_count) and (bit<bits_max)){
             cur_prime=bit+bit+3;
             vector_set_fill_pointer(primes,1+curnum);
             vector_set_int(primes,curnum++,cur_prime);
             // /*DEBUG*/printf("%s(%d) prime=%d\n",__FUNCTION__,n,cur_prime); fflush(stdout);
-            bit++;
+            INCF(bit);
             while((bit<=bits_max) and (0==(bits[bit/word_size]&(1<<bit%word_size)))){
-                bit++; }}
+                INCF(bit); }}
         // /*DEBUG*/printf("%s(%d) exit\n",__FUNCTION__,n); fflush(stdout);
         return(primes);}}

@@ -882,17 +1199,16 @@ id primes=0;

 int search_prime(int n,int* order){
     if((nil==primes) or (vector_get_int(primes,vector_length(primes)-1)<n)){
-        primes=compute_primes_to(n*2);
-    }
+        primes=compute_primes_to(n*2);}
     /*
-        +-------------------+----------+-------+----------+----------------+
-        | Case              |  found   | index |  order   |     Error      |
-        +-------------------+----------+-------+----------+----------------+
-        | x < a[i]          |   FALSE  |  min  |  less    |      0         |
-        | a[i] < x < a[i+1] |   FALSE  |   i   |  greater |      0         |
-        | x = a[i]          |   TRUE   |   i   |  equal   |      0         |
-        | a[max] < x        |   FALSE  |  max  |  greater |      0         |
-        +-------------------+----------+-------+----------+----------------+
+    +-------------------+----------+-------+----------+----------------+
+    | Case              |  found   | index |  order   |     Error      |
+    +-------------------+----------+-------+----------+----------------+
+    | x < a[i]          |   FALSE  |  min  |  less    |      0         |
+    | a[i] < x < a[i+1] |   FALSE  |   i   |  greater |      0         |
+    | x = a[i]          |   TRUE   |   i   |  equal   |      0         |
+    | a[max] < x        |   FALSE  |  max  |  greater |      0         |
+    +-------------------+----------+-------+----------+----------------+
     */
     int min=0;
     int max=vector_length(primes)-1;
@@ -901,10 +1217,9 @@ int search_prime(int n,int* order){
     int ord=(n==cur)?0:(n<cur)?-1:1;
     while((0!=ord) and (min!=ind)){
         if(ord<0){
-            max=ind;
-        }else{
-            min=ind;
-        }
+            max=ind;}
+        else{
+            min=ind;}
         ind=(min+max)/2;
         cur=vector_get_int(primes,ind);
         ord=(n==cur)?0:(n<cur)?-1:1;}
@@ -923,107 +1238,438 @@ int ceiling_to_nearest_prime(int n){
     int ord=0;
     int ind=search_prime(n,&ord);
     if(ord<0){
-        return(vector_get_int(primes,1));
-    }else{
-        return(vector_get_int(primes,1+ind));
-    }}
+        return(vector_get_int(primes,1));}
+    else{
+        return(vector_get_int(primes,1+ind));}}
+
+
+typedef struct symbol {
+    id name;
+    id value;
+    id function;
+    id plist;
+    id package;
+} symbol_t;
+
+id make_symbol(id name,id package){
+    symbol_t* sym=memory_allocate(__FUNCTION__,sizeof(*sym),1);
+    sym->name=name;
+    sym->package=package;
+    sym->value=nil;
+    sym->function=nil;
+    sym->plist=nil;
+    return(box(ot_symbol,sym));}
+
+id symbolp(id object){
+    return(boolean(null(object) or (ot_symbol==type_of(object))));}
+
+
+symbol_t* unbox_symbol(id object){
+    assert(symbolp(object));
+    if(null(object)){
+        object=SY(nil);}
+    return(object->value.symbol);}
+
+id symbol_name(id symbol){
+    assert(symbolp(symbol));
+    symbol_t* s=unbox_symbol(symbol);
+    return(s->name);}
+
+id symbol_package(id symbol){
+    assert(symbolp(symbol));
+    symbol_t* s=unbox_symbol(symbol);
+    return(s->package);}
+
+id symbol_value(id symbol){
+    assert(symbolp(symbol));
+    symbol_t* s=unbox_symbol(symbol);
+    return(s->value);}
+
+id symbol_function(id symbol){
+    assert(symbolp(symbol));
+    symbol_t* s=unbox_symbol(symbol);
+    return(s->function);}
+
+id symbol_plist(id symbol){
+    assert(symbolp(symbol));
+    symbol_t* s=unbox_symbol(symbol);
+    return(s->plist);}
+
+id symbol_set_value(id symbol,id value){
+    assert(symbolp(symbol));
+    symbol_t* s=unbox_symbol(symbol);
+    s->value=value;
+    return(value);}
+
+id symbol_set_function(id symbol,id function){
+    assert(symbolp(symbol));
+    symbol_t* s=unbox_symbol(symbol);
+    s->function=function;
+    return(function);}
+
+id symbol_set_plist(id symbol,id plist){
+    assert(symbolp(symbol));
+    symbol_t* s=unbox_symbol(symbol);
+    s->plist=plist;
+    return(plist);}


+typedef struct package {
+    id name;
+    id symbols;
+} package_t;

+id find_package(id name);

+id make_package(id name){
+    assert(not(find_package(name)));
+    package_t* pack=memory_allocate(__FUNCTION__,sizeof(*pack),1);
+    pack->name=name;
+    pack->symbols=make_hashtable(17);
+    return(box(ot_package,pack));}
+
+id packagep(id object){
+    return(boolean(not(null(object)) and (ot_package==type_of(object))));}
+
+package_t* unbox_package(id object){
+    assert(nil!=object);
+    assert(ot_package==type_of(object));
+    return(object->value.package);}
+
+id package_name(id package){
+    assert(packagep(package));
+    package_t* p=unbox_package(package);
+    return(p->name);}
+
+id package_symbols(id package){
+    assert(packagep(package));
+    package_t* p=unbox_package(package);
+    return(p->symbols);}
+
+id find_package(id name){
+    id p=all_packages;
+    while(p and not(equal(name,package_name(car(p))))){
+        p=cdr(p);}
+    return(car(p));}
+
+id intern(id name,id pack){
+    assert(stringp(name));
+    assert(null(pack) or stringp(pack) or packagep(pack));
+    id the_package;
+    if(null(pack)){
+        the_package=package;}
+    else if(stringp(pack)){
+        the_package=find_package(pack);
+        if(null(the_package)){
+            ERROR("No package named \"%s\"",unbox_string(name));}}
+    else if(packagep(pack)){
+        the_package=pack;}
+    id syms=package_symbols(the_package);
+    id sym=hashtable_get(syms,name);
+    if(null(sym)){
+        sym=make_symbol(name,the_package);
+        hashtable_set(syms,name,sym);}
+    return(sym);}
+
+
+
+
+void initialize(void){
+    standard_input=stream(stdin);
+    standard_output=stream(stdout);
+    error_output=stream(stderr);
+    trace_output=error_output;
+    objects_being_printed=make_hashtable(10000);
+    keyword=make_package(string("keyword"));
+    PUSH(keyword,all_packages);
+    user=make_package(string("user"));
+    PUSH(user,all_packages);
+    package=user;
+    t=SY(t);
+    symbol_set_value(t,t);
+    SY(nil);}
+
+
+id terpri(id stream){
+    assert(null(stream) or streamp(stream));
+    if(null(stream)){
+        stream=standard_output;}
+    fprintf(unbox_stream(stream),"\n");
+    return(nil);}


 id prin1_object(id object,FILE* file);
-id print_list(id object,FILE* file){
-    if(null(object)){
-        fprintf(file,"nil");
-    }else{
-        fprintf(file,"(");
-        prin1_object(car(object),file);
-        while(consp(object=cdr(object))){
-            fprintf(file," ");
-            prin1_object(car(object),file);}
-        if(not(null(object))){
-            fprintf(file," . ");
-            prin1_object(object,file);}
-        fprintf(file,")");}
+
+void scan_object_sharing(id object,id table){
+    // We enter into the table all the non trivial objects,
+    // mapped to an integer number-of-occurences.
+    if(not(null(object))){
+        switch(type_of(object)){
+          case ot_int:    break;
+          case ot_char:   break;
+          case ot_symbol: break;
+          default:{
+              id ref=hashtable_get(table,object);
+              if(null(ref)){
+                  hashtable_set(table,object,integer(1));
+                  switch(type_of(object)){
+                    case ot_cons:
+                        scan_object_sharing(car(object),table);
+                        scan_object_sharing(cdr(object),table);
+                        break;
+                    case ot_vector:
+                        if(ot_t==vector_element_type(object)){
+                            DOTIMES(i,length(object),{scan_object_sharing(vector_get(object,i),table);});}
+                        break;
+                    default:
+                        break;}}
+              else{
+                  hashtable_set(table,object,integer(1+unbox_integer(ref)));}}}}}
+
+typedef struct {
+    id table;
+    int count;
+} object_sharing_cleanup_closure;
+
+void clean_object(id key,id ref,void* data){
+    // This removes the entries that have ref==1
+    // and replaces the others by a cons (nil . unique-ident)
+    object_sharing_cleanup_closure* closure=data;
+    if(1==unbox_integer(ref)){
+        hashtable_remove(closure->table,key);}
+    else{
+        hashtable_set(closure->table,key,cons(nil,integer(INCF(closure->count))));}}
+
+void clean_object_sharing(id table){
+    object_sharing_cleanup_closure closure;
+    closure.table=table;
+    closure.count=0;
+    hashtable_map(table,clean_object,&closure);}
+
+
+id prin1(id object,id stream){
+    assert(null(stream) or streamp(stream));
+    if(null(stream)){
+        stream=standard_output;}
+    hashtable_clear(objects_being_printed);
+    if(print_circle){
+        scan_object_sharing(object,objects_being_printed);
+        clean_object_sharing(objects_being_printed);}
+    prin1_object(object,unbox_stream(stream));
     return(object);}

+id princ(id object,id stream){
+    assert(null(stream) or streamp(stream));
+    if(null(stream)){
+        stream=standard_output;}
+    if(print_circle){
+        hashtable_clear(objects_being_printed);}
+    if(characterp(object)){
+        fprintf(unbox_stream(stream),"%c",unbox_character(object));}
+    else if(stringp(object)){
+        fprintf(unbox_stream(stream),"%s",unbox_string(object));}
+    else if(symbolp(object)){
+        fprintf(unbox_stream(stream),"%s",unbox_string(symbol_name(object)));}
+    else{
+        hashtable_clear(objects_being_printed);
+        prin1_object(object,unbox_stream(stream));}
+    return(object);}
+
+id print(id object,id stream){
+    terpri(stream);
+    return(prin1(object,stream));}

-id print_string(id object,FILE* file){
+
+typedef id(*predicate)(id object);
+
+id every(predicate fun,id sequence){
+    if(null(sequence)){
+        return(t);}
+    else if(consp(sequence)){
+        while(sequence and fun(car(sequence))){
+            sequence=cdr(sequence);}
+        return(boolean(not(sequence)));}
+    else if(vectorp(sequence)){
+        int len=length(sequence);
+        int i=0;
+        while((i<len) and fun(vector_get(sequence,i))){
+            INCF(i);}
+        return(boolean(not(i<len)));}
+    else{
+        ERROR("Expected a sequence, not a %s",type_name(type_of(sequence)));}}
+
+id unescaped_character_p(id ch){
+    return(boolean(0!=strchr("$%&*+,-./0123456789<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_abcdefghijklmnopqrstuvwxyz~",unbox_character(ch))));}
+
+id prin1_escaped_name(id name,FILE* file){
+    assert(stringp(name));
+    if(every(unescaped_character_p,name)){
+        fprintf(file,"%s",unbox_string(name));}
+    else{
+        int len=length(name);
+        for(int i=0;i<len;INCF(i)){
+            id ch=vector_get(name,i);
+            if(not(unescaped_character_p(ch))){
+                fprintf(file,"\\");}
+            fprintf(file,"%c",unbox_character(ch));}}
+    return(name);}
+
+id prin1_symbol(id object,FILE* file){
+    assert(symbolp(object));
+    id p=symbol_package(object);
+    id n=symbol_name(object);
+    if(p!=package){
+        if(p==keyword){
+            fprintf(file,":");}
+        else{
+            prin1_escaped_name(package_name(p),file);
+            fprintf(file,":");;}}
+    prin1_escaped_name(n,file);
+    return(object);}
+
+id prin1_string(id object,FILE* file){
     assert(vectorp(object) and (ot_char==vector_element_type(object)));
     fprintf(file,"\"");
     int count=vector_length(object);
-    for(int i=0;i<count;i++){
+    for(int i=0;i<count;INCF(i)){
         char ch=vector_get_char(object,i);
         if(('"'==ch)or('\\'==ch)){
-            fprintf(file,"\\%c",ch);
-        }else{
+            fprintf(file,"\\%c",ch);}
+        else{
             fprintf(file,"%c",ch);}}
     fprintf(file,"\"");
     return(object);}

-
-id print_vector(id object,FILE* file){
+id prin1_vector(id object,FILE* file){
     assert(vectorp(object));
     int count=vector_length(object);
     const char* sep="";
     switch(vector_element_type(object)){
       case ot_char:
-          print_string(object,file);
+          prin1_string(object,file);
           break;
-      case ot_int:
+      case ot_int:{
           fprintf(file,"#(");
-          for(int i=0;i<count;i++){
-              fprintf(file,"%s%d",sep,vector_get_int(object,i));
+          for(int i=0;i<count;INCF(i)){
+              fprintf(file,"%s"INTEGER_FMT,sep,vector_get_int(object,i));
               sep=" ";}
           fprintf(file,")");
-          break;
-      case ot_t:
+          break;}
+      case ot_t:{
           fprintf(file,"#(");
-          for(int i=0;i<count;i++){
+          for(int i=0;i<count;INCF(i)){
               prin1_object(vector_get(object,i),file);
               sep=" ";}
           fprintf(file,")");
-          break;
+          break;}
       default:
-          fprintf(file,"#<vector>");
-          break;
-    }
+          fprintf(file,"#<vector unexpected element type %d>",vector_element_type(object));
+          break;}
     return(object);}

+id prin1_list(id object,FILE* file){
+    if(null(object)){
+        fprintf(file,"nil");}
+    else{
+        id ref=hashtable_get(objects_being_printed,object);
+        if(car(ref)){
+            fprintf(file,"#"INTEGER_FMT"#",unbox_integer(cdr(ref)));}
+        else{
+            if(ref){
+                fprintf(file,"#"INTEGER_FMT"=",unbox_integer(cdr(ref)));
+                setcar(ref,t);}
+            id current=object;
+            fprintf(file,"(");
+            prin1_object(car(current),file);
+            while(consp(current=cdr(current))){
+                id ref=hashtable_get(objects_being_printed,current);
+                if(car(ref)){
+                    fprintf(file," . #"INTEGER_FMT"#)",unbox_integer(cdr(ref)));
+                    return(object);}
+                else if(ref){
+                        fprintf(file," . ");
+                        prin1_object(current,file);
+                        fprintf(file,")");
+                        return(object);}
+                else{
+                    fprintf(file," ");
+                    prin1_object(car(current),file);}}
+            if(not(null(current))){
+                fprintf(file," . ");
+                prin1_object(current,file);}
+            fprintf(file,")");}}
+    return(object);}

 id prin1_object(id object,FILE* file){
     if(null(object)){
-        fprintf(file,"nil");
-    }else{
+        fprintf(file,"nil");}
+    else{
         switch(type_of(object)){
-          case ot_CXCursor:
-              fprintf(file,"#<CXCursor %d>",sxhash(object));
-              break;
           case ot_int:
-              fprintf(file,"%d",unbox_integer(object));
+              fprintf(file,INTEGER_FMT,unbox_integer(object));
               break;
-          case ot_char:
-              fprintf(file,"#\%c",unbox_character(object));
+          case ot_char:{
+              char chname[20];
+              char ch=unbox_character(object);
+              switch(ch){
+                case ' ':  strcpy(chname,"space");   break;
+                case '\n': strcpy(chname,"newline"); break;
+                default:
+                    if(!isgraph(ch)){
+                        sprintf(chname,"U+%04X",ch);}
+                    break;}
+              if(chname){
+                  fprintf(file,"#\\%s",chname);}
+              else{
+                  fprintf(file,"#\\%c",ch);}
+              break;}
+          case ot_symbol:
+              prin1_symbol(object,file);
               break;
           case ot_cons:
-              print_list(object,file);
+              prin1_list(object,file);
               break;
-          case ot_vector:
-              if(stringp(object)){
-                  print_string(object,file);
-              }else{
-                  print_vector(object,file);
-              }
-              break;
-          case ot_hashtable:
-              fprintf(file,"#<hashtable :count %d>",hashtable_count(object));
-              break;
-          default:
-              fprintf(file,"#<OBJECT-OF-UNKNOWN-TYPE>");
-              break;
-        }}
+          default:{
+              id ref=hashtable_get(objects_being_printed,object);
+              if(car(ref)){
+                  fprintf(file,"#"INTEGER_FMT"#",unbox_integer(cdr(ref)));}
+              else{
+                  if(ref){
+                      fprintf(file,"#"INTEGER_FMT"=",unbox_integer(cdr(ref)));
+                      setcar(ref,t);}
+                  switch(type_of(object)){
+                    case ot_CXCursor:
+                        fprintf(file,"#<CXCursor %u>",sxhash(object));
+                        break;
+                    case ot_CXType:
+                        fprintf(file,"#<CXType %p>",object);
+                        break;
+                    case ot_stream:{
+                        const char* name=0;
+                        FILE* file=unbox_stream(object);
+                        if(file==stdout){ name="stdout"; }
+                        else if(file==stderr){ name="stderr"; }
+                        else if(file==stdin){ name="stdin"; }
+                        if(name){
+                            fprintf(file,"#<stream %s>",name);}
+                        else{
+                            fprintf(file,"#<stream %p>",file);}
+                        break;}
+                    case ot_vector:
+                        if(stringp(object)){
+                            prin1_string(object,file);}
+                        else{
+                            prin1_vector(object,file);}
+                        break;
+                    case ot_package:
+                        fprintf(file,"#<package %s>",unbox_string(package_name(object)));
+                        break;
+                    case ot_hashtable:
+                        fprintf(file,"#<hashtable :count %d>",hashtable_count(object));
+                        break;
+                    default:
+                        fprintf(file,"#<object unexpected type %d>",type_of(object));
+                        break;}}}}}
     return(object);}


@@ -1032,37 +1678,37 @@ id prin1_object(id object,FILE* file){

 id argv_to_list(const char* const* argv){
     id args=nil;
-    for(int i=0;argv[i];i++){
+    for(int i=0;argv[i];INCF(i)){
         PUSH(string(argv[i]),args);}
     return(nreverse(args));}

 const char* const* list_to_argv(id args){
     int cnt=length(args);
     const char** result=memory_allocate(__FUNCTION__,sizeof(char*),(1+cnt));
-    for(int i=0;i<cnt;i++,args=rest(args)){
+    for(int i=0;i<cnt;INCF(i),args=rest(args)){
         assert(stringp(car(args)));
         result[i]=unbox_string(car(args));}
     result[cnt]=0;
     return(result);}

 int argv_count(const char* const* argv){
-    // /*DEBUG*/printf("%s(…)\n",__FUNCTION__); fflush(stdout);
+    // /*DEBUG*/printf("%s(...)\n",__FUNCTION__); fflush(stdout);
     int cnt=0;
     while(argv[cnt]){
-        cnt++;
-    }
+        INCF(cnt);}
+
     return(cnt);}

 const char* const* argv_concat(const char* const* argv1,const char* const* argv2){
-    // /*DEBUG*/printf("%s(…)\n",__FUNCTION__); fflush(stdout);
+    // /*DEBUG*/printf("%s(...)\n",__FUNCTION__); fflush(stdout);
     int cnt1=argv_count(argv1);
     int cnt2=argv_count(argv2);
     const char** result=memory_allocate(__FUNCTION__,sizeof(char*),(1+cnt1+cnt2));
     int s=0;
     int d=0;
-    for(s=0;s<cnt1;s++){
+    for(s=0;s<cnt1;INCF(s)){
         result[d++]=argv1[s];}
-    for(s=0;s<cnt2;s++){
+    for(s=0;s<cnt2;INCF(s)){
         result[d++]=argv2[s];}
     result[d]=0;
     return(result);}
@@ -1071,1403 +1717,614 @@ const char* const* argv_concat(const char* const* argv1,const char* const* argv2
 //// clang-c


-
-const char* cursorSymbol(int cursorKind){
+id cursorSymbol(int cursorKind){
     switch(cursorKind){
-      case CXCursor_UnexposedDecl:                      return ":unexposed-decl";
-      case CXCursor_StructDecl:                         return ":struct-decl";
-      case CXCursor_UnionDecl:                          return ":union-decl";
-      case CXCursor_ClassDecl:                          return ":class-decl";
-      case CXCursor_EnumDecl:                           return ":enum-decl";
-      case CXCursor_FieldDecl:                          return ":field-decl";
-      case CXCursor_EnumConstantDecl:                   return ":enum-constant-decl";
-      case CXCursor_FunctionDecl:                       return ":function-decl";
-      case CXCursor_VarDecl:                            return ":var-decl";
-      case CXCursor_ParmDecl:                           return ":parm-decl";
-      case CXCursor_ObjCInterfaceDecl:                  return ":objc-interface-decl";
-      case CXCursor_ObjCCategoryDecl:                   return ":objc-category-decl";
-      case CXCursor_ObjCProtocolDecl:                   return ":objc-protocol-decl";
-      case CXCursor_ObjCPropertyDecl:                   return ":objc-property-decl";
-      case CXCursor_ObjCIvarDecl:                       return ":objc-ivar-decl";
-      case CXCursor_ObjCInstanceMethodDecl:             return ":objc-instance-method-decl";
-      case CXCursor_ObjCClassMethodDecl:                return ":objc-class-method-decl";
-      case CXCursor_ObjCImplementationDecl:             return ":objc-implementation-decl";
-      case CXCursor_ObjCCategoryImplDecl:               return ":objc-category-impl-decl";
-      case CXCursor_TypedefDecl:                        return ":typedef-decl";
-      case CXCursor_CXXMethod:                          return ":cxx-method";
-      case CXCursor_Namespace:                          return ":namespace";
-      case CXCursor_LinkageSpec:                        return ":linkage-spec";
-      case CXCursor_Constructor:                        return ":constructor";
-      case CXCursor_Destructor:                         return ":destructor";
-      case CXCursor_ConversionFunction:                 return ":conversion-function";
-      case CXCursor_TemplateTypeParameter:              return ":template-type-parameter";
-      case CXCursor_NonTypeTemplateParameter:           return ":non-type-template-parameter";
-      case CXCursor_TemplateTemplateParameter:          return ":template-template-parameter";
-      case CXCursor_FunctionTemplate:                   return ":function-template";
-      case CXCursor_ClassTemplate:                      return ":class-template";
-      case CXCursor_ClassTemplatePartialSpecialization: return ":class-template-partial-specialization";
-      case CXCursor_NamespaceAlias:                     return ":namespace-alias";
-      case CXCursor_UsingDirective:                     return ":using-directive";
-      case CXCursor_UsingDeclaration:                   return ":using-declaration";
-      case CXCursor_TypeAliasDecl:                      return ":type-alias-decl";
-      case CXCursor_ObjCSynthesizeDecl:                 return ":objc-synthesize-decl";
-      case CXCursor_ObjCDynamicDecl:                    return ":objc-dynamic-decl";
-      case CXCursor_CXXAccessSpecifier:                 return ":cxx-access-specifier";
-      case CXCursor_ObjCSuperClassRef:                  return ":objc-super-class-ref";
-      case CXCursor_ObjCProtocolRef:                    return ":objc-protocol-ref";
-      case CXCursor_ObjCClassRef:                       return ":objc-class-ref";
-      case CXCursor_TypeRef:                            return ":type-ref";
-      case CXCursor_CXXBaseSpecifier:                   return ":cxx-base-specifier";
-      case CXCursor_TemplateRef:                        return ":template-ref";
-      case CXCursor_NamespaceRef:                       return ":namespace-ref";
-      case CXCursor_MemberRef:                          return ":member-ref";
-      case CXCursor_LabelRef:                           return ":label-ref";
-      case CXCursor_OverloadedDeclRef:                  return ":overloaded-decl-ref";
-      case CXCursor_VariableRef:                        return ":variable-ref";
-      case CXCursor_InvalidFile:                        return ":invalid-file";
-      case CXCursor_NoDeclFound:                        return ":no-decl-found";
-      case CXCursor_NotImplemented:                     return ":not-implemented";
-      case CXCursor_InvalidCode:                        return ":invalid-code";
-      case CXCursor_UnexposedExpr:                      return ":unexposed-expr";
-      case CXCursor_DeclRefExpr:                        return ":decl-ref-expr";
-      case CXCursor_MemberRefExpr:                      return ":member-ref-expr";
-      case CXCursor_CallExpr:                           return ":call-expr";
-      case CXCursor_ObjCMessageExpr:                    return ":objc-message-expr";
-      case CXCursor_BlockExpr:                          return ":block-expr";
-      case CXCursor_IntegerLiteral:                     return ":integer-literal";
-      case CXCursor_FloatingLiteral:                    return ":floating-literal";
-      case CXCursor_ImaginaryLiteral:                   return ":imaginary-literal";
-      case CXCursor_StringLiteral:                      return ":string-literal";
-      case CXCursor_CharacterLiteral:                   return ":character-literal";
-      case CXCursor_ParenExpr:                          return ":paren-expr";
-      case CXCursor_UnaryOperator:                      return ":unary-operator";
-      case CXCursor_ArraySubscriptExpr:                 return ":array-subscript-expr";
-      case CXCursor_BinaryOperator:                     return ":binary-operator";
-      case CXCursor_CompoundAssignOperator:             return ":compound-assign-operator";
-      case CXCursor_ConditionalOperator:                return ":conditional-operator";
-      case CXCursor_CStyleCastExpr:                     return ":cstyle-cast-expr";
-      case CXCursor_CompoundLiteralExpr:                return ":compound-literal-expr";
-      case CXCursor_InitListExpr:                       return ":init-list-expr";
-      case CXCursor_AddrLabelExpr:                      return ":addr-label-expr";
-      case CXCursor_StmtExpr:                           return ":stmt-expr";
-      case CXCursor_GenericSelectionExpr:               return ":generic-selection-expr";
-      case CXCursor_GNUNullExpr:                        return ":gnunull-expr";
-      case CXCursor_CXXStaticCastExpr:                  return ":cxx-static-cast-expr";
-      case CXCursor_CXXDynamicCastExpr:                 return ":cxx-dynamic-cast-expr";
-      case CXCursor_CXXReinterpretCastExpr:             return ":cxx-reinterpret-cast-expr";
-      case CXCursor_CXXConstCastExpr:                   return ":cxx-const-cast-expr";
-      case CXCursor_CXXFunctionalCastExpr:              return ":cxx-functional-cast-expr";
-      case CXCursor_CXXTypeidExpr:                      return ":cxx-typeid-expr";
-      case CXCursor_CXXBoolLiteralExpr:                 return ":cxx-bool-literal-expr";
-      case CXCursor_CXXNullPtrLiteralExpr:              return ":cxx-null-ptr-literal-expr";
-      case CXCursor_CXXThisExpr:                        return ":cxx-this-expr";
-      case CXCursor_CXXThrowExpr:                       return ":cxx-throw-expr";
-      case CXCursor_CXXNewExpr:                         return ":cxx-new-expr";
-      case CXCursor_CXXDeleteExpr:                      return ":cxx-delete-expr";
-      case CXCursor_UnaryExpr:                          return ":unary-expr";
-      case CXCursor_ObjCStringLiteral:                  return ":objc-string-literal";
-      case CXCursor_ObjCEncodeExpr:                     return ":objc-encode-expr";
-      case CXCursor_ObjCSelectorExpr:                   return ":objc-selector-expr";
-      case CXCursor_ObjCProtocolExpr:                   return ":objc-protocol-expr";
-      case CXCursor_ObjCBridgedCastExpr:                return ":objc-bridged-cast-expr";
-      case CXCursor_PackExpansionExpr:                  return ":pack-expansion-expr";
-      case CXCursor_SizeOfPackExpr:                     return ":size-of-pack-expr";
-      case CXCursor_LambdaExpr:                         return ":lambda-expr";
-      case CXCursor_ObjCBoolLiteralExpr:                return ":objc-bool-literal-expr";
-      case CXCursor_UnexposedStmt:                      return ":unexposed-stmt";
-      case CXCursor_LabelStmt:                          return ":label-stmt";
-      case CXCursor_CompoundStmt:                       return ":compound-stmt";
-      case CXCursor_CaseStmt:                           return ":case-stmt";
-      case CXCursor_DefaultStmt:                        return ":default-stmt";
-      case CXCursor_IfStmt:                             return ":if-stmt";
-      case CXCursor_SwitchStmt:                         return ":switch-stmt";
-      case CXCursor_WhileStmt:                          return ":while-stmt";
-      case CXCursor_DoStmt:                             return ":do-stmt";
-      case CXCursor_ForStmt:                            return ":for-stmt";
-      case CXCursor_GotoStmt:                           return ":goto-stmt";
-      case CXCursor_IndirectGotoStmt:                   return ":indirect-goto-stmt";
-      case CXCursor_ContinueStmt:                       return ":continue-stmt";
-      case CXCursor_BreakStmt:                          return ":break-stmt";
-      case CXCursor_ReturnStmt:                         return ":return-stmt";
-      case CXCursor_GCCAsmStmt:                         return ":gccasm-stmt";
-      case CXCursor_ObjCAtTryStmt:                      return ":objc-at-try-stmt";
-      case CXCursor_ObjCAtCatchStmt:                    return ":objc-at-catch-stmt";
-      case CXCursor_ObjCAtFinallyStmt:                  return ":objc-at-finally-stmt";
-      case CXCursor_ObjCAtThrowStmt:                    return ":objc-at-throw-stmt";
-      case CXCursor_ObjCAtSynchronizedStmt:             return ":objc-at-synchronized-stmt";
-      case CXCursor_ObjCAutoreleasePoolStmt:            return ":objc-autorelease-pool-stmt";
-      case CXCursor_ObjCForCollectionStmt:              return ":objc-for-collection-stmt";
-      case CXCursor_CXXCatchStmt:                       return ":cxx-catch-stmt";
-      case CXCursor_CXXTryStmt:                         return ":cxx-try-stmt";
-      case CXCursor_CXXForRangeStmt:                    return ":cxx-for-range-stmt";
-      case CXCursor_SEHTryStmt:                         return ":seh-try-stmt";
-      case CXCursor_SEHExceptStmt:                      return ":seh-except-stmt";
-      case CXCursor_SEHFinallyStmt:                     return ":seh-finally-stmt";
-      case CXCursor_MSAsmStmt:                          return ":msasm-stmt";
-      case CXCursor_NullStmt:                           return ":null-stmt";
-      case CXCursor_DeclStmt:                           return ":decl-stmt";
-      case CXCursor_TranslationUnit:                    return ":translation-unit";
-      case CXCursor_UnexposedAttr:                      return ":unexposed-attr";
-      case CXCursor_IBActionAttr:                       return ":ibaction-attr";
-      case CXCursor_IBOutletAttr:                       return ":iboutlet-attr";
-      case CXCursor_IBOutletCollectionAttr:             return ":iboutlet-collection-attr";
-      case CXCursor_CXXFinalAttr:                       return ":cxx-final-attr";
-      case CXCursor_CXXOverrideAttr:                    return ":cxx-override-attr";
-      case CXCursor_AnnotateAttr:                       return ":annotate-attr";
-      case CXCursor_AsmLabelAttr:                       return ":asm-label-attr";
-      case CXCursor_PreprocessingDirective:             return ":preprocessing-directive";
-      case CXCursor_MacroDefinition:                    return ":macro-definition";
-      case CXCursor_MacroExpansion:                     return ":macro-expansion";
-      case CXCursor_InclusionDirective:                 return ":inclusion-directive";
-      case CXCursor_ModuleImportDecl:                   return ":module-import-decl";
-      default:                                          return ":invalid";}}
-
-
-
-const char* cursorLinkage(int linkageKind){
+      case CXCursor_UnexposedDecl:                      return SY(unexposed-decl);
+      case CXCursor_StructDecl:                         return SY(struct-decl);
+      case CXCursor_UnionDecl:                          return SY(union-decl);
+      case CXCursor_ClassDecl:                          return SY(class-decl);
+      case CXCursor_EnumDecl:                           return SY(enum-decl);
+      case CXCursor_FieldDecl:                          return SY(field-decl);
+      case CXCursor_EnumConstantDecl:                   return SY(enum-constant-decl);
+      case CXCursor_FunctionDecl:                       return SY(function-decl);
+      case CXCursor_VarDecl:                            return SY(var-decl);
+      case CXCursor_ParmDecl:                           return SY(parm-decl);
+      case CXCursor_ObjCInterfaceDecl:                  return SY(objc-interface-decl);
+      case CXCursor_ObjCCategoryDecl:                   return SY(objc-category-decl);
+      case CXCursor_ObjCProtocolDecl:                   return SY(objc-protocol-decl);
+      case CXCursor_ObjCPropertyDecl:                   return SY(objc-property-decl);
+      case CXCursor_ObjCIvarDecl:                       return SY(objc-ivar-decl);
+      case CXCursor_ObjCInstanceMethodDecl:             return SY(objc-instance-method-decl);
+      case CXCursor_ObjCClassMethodDecl:                return SY(objc-class-method-decl);
+      case CXCursor_ObjCImplementationDecl:             return SY(objc-implementation-decl);
+      case CXCursor_ObjCCategoryImplDecl:               return SY(objc-category-impl-decl);
+      case CXCursor_TypedefDecl:                        return SY(typedef-decl);
+      case CXCursor_CXXMethod:                          return SY(cxx-method);
+      case CXCursor_Namespace:                          return SY(namespace);
+      case CXCursor_LinkageSpec:                        return SY(linkage-spec);
+      case CXCursor_Constructor:                        return SY(constructor);
+      case CXCursor_Destructor:                         return SY(destructor);
+      case CXCursor_ConversionFunction:                 return SY(conversion-function);
+      case CXCursor_TemplateTypeParameter:              return SY(template-type-parameter);
+      case CXCursor_NonTypeTemplateParameter:           return SY(non-type-template-parameter);
+      case CXCursor_TemplateTemplateParameter:          return SY(template-template-parameter);
+      case CXCursor_FunctionTemplate:                   return SY(function-template);
+      case CXCursor_ClassTemplate:                      return SY(class-template);
+      case CXCursor_ClassTemplatePartialSpecialization: return SY(class-template-partial-specialization);
+      case CXCursor_NamespaceAlias:                     return SY(namespace-alias);
+      case CXCursor_UsingDirective:                     return SY(using-directive);
+      case CXCursor_UsingDeclaration:                   return SY(using-declaration);
+      case CXCursor_TypeAliasDecl:                      return SY(type-alias-decl);
+      case CXCursor_ObjCSynthesizeDecl:                 return SY(objc-synthesize-decl);
+      case CXCursor_ObjCDynamicDecl:                    return SY(objc-dynamic-decl);
+      case CXCursor_CXXAccessSpecifier:                 return SY(cxx-access-specifier);
+      case CXCursor_ObjCSuperClassRef:                  return SY(objc-super-class-ref);
+      case CXCursor_ObjCProtocolRef:                    return SY(objc-protocol-ref);
+      case CXCursor_ObjCClassRef:                       return SY(objc-class-ref);
+      case CXCursor_TypeRef:                            return SY(type-ref);
+      case CXCursor_CXXBaseSpecifier:                   return SY(cxx-base-specifier);
+      case CXCursor_TemplateRef:                        return SY(template-ref);
+      case CXCursor_NamespaceRef:                       return SY(namespace-ref);
+      case CXCursor_MemberRef:                          return SY(member-ref);
+      case CXCursor_LabelRef:                           return SY(label-ref);
+      case CXCursor_OverloadedDeclRef:                  return SY(overloaded-decl-ref);
+      case CXCursor_VariableRef:                        return SY(variable-ref);
+      case CXCursor_InvalidFile:                        return SY(invalid-file);
+      case CXCursor_NoDeclFound:                        return SY(no-decl-found);
+      case CXCursor_NotImplemented:                     return SY(not-implemented);
+      case CXCursor_InvalidCode:                        return SY(invalid-code);
+      case CXCursor_UnexposedExpr:                      return SY(unexposed-expr);
+      case CXCursor_DeclRefExpr:                        return SY(decl-ref-expr);
+      case CXCursor_MemberRefExpr:                      return SY(member-ref-expr);
+      case CXCursor_CallExpr:                           return SY(call-expr);
+      case CXCursor_ObjCMessageExpr:                    return SY(objc-message-expr);
+      case CXCursor_BlockExpr:                          return SY(block-expr);
+      case CXCursor_IntegerLiteral:                     return SY(integer-literal);
+      case CXCursor_FloatingLiteral:                    return SY(floating-literal);
+      case CXCursor_ImaginaryLiteral:                   return SY(imaginary-literal);
+      case CXCursor_StringLiteral:                      return SY(string-literal);
+      case CXCursor_CharacterLiteral:                   return SY(character-literal);
+      case CXCursor_ParenExpr:                          return SY(paren-expr);
+      case CXCursor_UnaryOperator:                      return SY(unary-operator);
+      case CXCursor_ArraySubscriptExpr:                 return SY(array-subscript-expr);
+      case CXCursor_BinaryOperator:                     return SY(binary-operator);
+      case CXCursor_CompoundAssignOperator:             return SY(compound-assign-operator);
+      case CXCursor_ConditionalOperator:                return SY(conditional-operator);
+      case CXCursor_CStyleCastExpr:                     return SY(cstyle-cast-expr);
+      case CXCursor_CompoundLiteralExpr:                return SY(compound-literal-expr);
+      case CXCursor_InitListExpr:                       return SY(init-list-expr);
+      case CXCursor_AddrLabelExpr:                      return SY(addr-label-expr);
+      case CXCursor_StmtExpr:                           return SY(stmt-expr);
+      case CXCursor_GenericSelectionExpr:               return SY(generic-selection-expr);
+      case CXCursor_GNUNullExpr:                        return SY(gnunull-expr);
+      case CXCursor_CXXStaticCastExpr:                  return SY(cxx-static-cast-expr);
+      case CXCursor_CXXDynamicCastExpr:                 return SY(cxx-dynamic-cast-expr);
+      case CXCursor_CXXReinterpretCastExpr:             return SY(cxx-reinterpret-cast-expr);
+      case CXCursor_CXXConstCastExpr:                   return SY(cxx-const-cast-expr);
+      case CXCursor_CXXFunctionalCastExpr:              return SY(cxx-functional-cast-expr);
+      case CXCursor_CXXTypeidExpr:                      return SY(cxx-typeid-expr);
+      case CXCursor_CXXBoolLiteralExpr:                 return SY(cxx-bool-literal-expr);
+      case CXCursor_CXXNullPtrLiteralExpr:              return SY(cxx-null-ptr-literal-expr);
+      case CXCursor_CXXThisExpr:                        return SY(cxx-this-expr);
+      case CXCursor_CXXThrowExpr:                       return SY(cxx-throw-expr);
+      case CXCursor_CXXNewExpr:                         return SY(cxx-new-expr);
+      case CXCursor_CXXDeleteExpr:                      return SY(cxx-delete-expr);
+      case CXCursor_UnaryExpr:                          return SY(unary-expr);
+      case CXCursor_ObjCStringLiteral:                  return SY(objc-string-literal);
+      case CXCursor_ObjCEncodeExpr:                     return SY(objc-encode-expr);
+      case CXCursor_ObjCSelectorExpr:                   return SY(objc-selector-expr);
+      case CXCursor_ObjCProtocolExpr:                   return SY(objc-protocol-expr);
+      case CXCursor_ObjCBridgedCastExpr:                return SY(objc-bridged-cast-expr);
+      case CXCursor_PackExpansionExpr:                  return SY(pack-expansion-expr);
+      case CXCursor_SizeOfPackExpr:                     return SY(size-of-pack-expr);
+      case CXCursor_LambdaExpr:                         return SY(lambda-expr);
+      case CXCursor_ObjCBoolLiteralExpr:                return SY(objc-bool-literal-expr);
+      case CXCursor_UnexposedStmt:                      return SY(unexposed-stmt);
+      case CXCursor_LabelStmt:                          return SY(label-stmt);
+      case CXCursor_CompoundStmt:                       return SY(compound-stmt);
+      case CXCursor_CaseStmt:                           return SY(case-stmt);
+      case CXCursor_DefaultStmt:                        return SY(default-stmt);
+      case CXCursor_IfStmt:                             return SY(if-stmt);
+      case CXCursor_SwitchStmt:                         return SY(switch-stmt);
+      case CXCursor_WhileStmt:                          return SY(while-stmt);
+      case CXCursor_DoStmt:                             return SY(do-stmt);
+      case CXCursor_ForStmt:                            return SY(for-stmt);
+      case CXCursor_GotoStmt:                           return SY(goto-stmt);
+      case CXCursor_IndirectGotoStmt:                   return SY(indirect-goto-stmt);
+      case CXCursor_ContinueStmt:                       return SY(continue-stmt);
+      case CXCursor_BreakStmt:                          return SY(break-stmt);
+      case CXCursor_ReturnStmt:                         return SY(return-stmt);
+      case CXCursor_GCCAsmStmt:                         return SY(gccasm-stmt);
+      case CXCursor_ObjCAtTryStmt:                      return SY(objc-at-try-stmt);
+      case CXCursor_ObjCAtCatchStmt:                    return SY(objc-at-catch-stmt);
+      case CXCursor_ObjCAtFinallyStmt:                  return SY(objc-at-finally-stmt);
+      case CXCursor_ObjCAtThrowStmt:                    return SY(objc-at-throw-stmt);
+      case CXCursor_ObjCAtSynchronizedStmt:             return SY(objc-at-synchronized-stmt);
+      case CXCursor_ObjCAutoreleasePoolStmt:            return SY(objc-autorelease-pool-stmt);
+      case CXCursor_ObjCForCollectionStmt:              return SY(objc-for-collection-stmt);
+      case CXCursor_CXXCatchStmt:                       return SY(cxx-catch-stmt);
+      case CXCursor_CXXTryStmt:                         return SY(cxx-try-stmt);
+      case CXCursor_CXXForRangeStmt:                    return SY(cxx-for-range-stmt);
+      case CXCursor_SEHTryStmt:                         return SY(seh-try-stmt);
+      case CXCursor_SEHExceptStmt:                      return SY(seh-except-stmt);
+      case CXCursor_SEHFinallyStmt:                     return SY(seh-finally-stmt);
+      case CXCursor_MSAsmStmt:                          return SY(msasm-stmt);
+      case CXCursor_NullStmt:                           return SY(null-stmt);
+      case CXCursor_DeclStmt:                           return SY(decl-stmt);
+      case CXCursor_TranslationUnit:                    return SY(translation-unit);
+      case CXCursor_UnexposedAttr:                      return SY(unexposed-attr);
+      case CXCursor_IBActionAttr:                       return SY(ibaction-attr);
+      case CXCursor_IBOutletAttr:                       return SY(iboutlet-attr);
+      case CXCursor_IBOutletCollectionAttr:             return SY(iboutlet-collection-attr);
+      case CXCursor_CXXFinalAttr:                       return SY(cxx-final-attr);
+      case CXCursor_CXXOverrideAttr:                    return SY(cxx-override-attr);
+      case CXCursor_AnnotateAttr:                       return SY(annotate-attr);
+      case CXCursor_AsmLabelAttr:                       return SY(asm-label-attr);
+      case CXCursor_PreprocessingDirective:             return SY(preprocessing-directive);
+      case CXCursor_MacroDefinition:                    return SY(macro-definition);
+      case CXCursor_MacroExpansion:                     return SY(macro-expansion);
+      case CXCursor_InclusionDirective:                 return SY(inclusion-directive);
+      case CXCursor_ModuleImportDecl:                   return SY(module-import-decl);
+      default:                                          return SY(invalid);}}
+
+id cursorLinkage(int linkageKind){
     switch(linkageKind){
-      case CXLinkage_NoLinkage:      return ":no-linkage";
-      case CXLinkage_Internal:       return ":internal";
-      case CXLinkage_UniqueExternal: return ":unique-external";
-      case CXLinkage_External:       return ":external";
-      default:                       return ":invalid";}}
-
+      case CXLinkage_NoLinkage:      return KW(no-linkage);
+      case CXLinkage_Internal:       return KW(internal);
+      case CXLinkage_UniqueExternal: return KW(unique-external);
+      case CXLinkage_External:       return KW(external);
+      default:                       return KW(invalid);}}

-const char* cursorLanguageKind(int languageKind){
+id cursorLanguageKind(int languageKind){
     switch(languageKind){
-      case CXLanguage_Invalid:   return ":invalid";
-      case CXLanguage_C:         return ":c";
-      case CXLanguage_ObjC:      return ":objc";
-      case CXLanguage_CPlusPlus: return ":cxx";
-      default:                   return ":invalid";}}
+      case CXLanguage_Invalid:   return KW(invalid);
+      case CXLanguage_C:         return KW(c);
+      case CXLanguage_ObjC:      return KW(objc);
+      case CXLanguage_CPlusPlus: return KW(cxx);
+      default:                   return KW(invalid);}}

-
-const char* cursorAvailability(int availabilityKind){
+id cursorAvailability(int availabilityKind){
     switch(availabilityKind){
-      case CXAvailability_Available:     return ":available";
-      case CXAvailability_Deprecated:    return ":deprecated";
-      case CXAvailability_NotAvailable:  return ":not-available";
-      case CXAvailability_NotAccessible: return ":not-accessible";
-      default: return ":invalid";}}
-
-
-
-const char* cursorType(int typeKind){
+      case CXAvailability_Available:     return KW(available);
+      case CXAvailability_Deprecated:    return KW(deprecated);
+      case CXAvailability_NotAvailable:  return KW(not-available);
+      case CXAvailability_NotAccessible: return KW(not-accessible);
+      default: return KW(invalid);}}
+
+id tokenSymbol(int tokenKind){
+    switch(tokenKind){
+      case CXToken_Punctuation: return(SY(punctuation));
+      case CXToken_Keyword:     return(SY(keyword));
+      case CXToken_Identifier:  return(SY(identifier));
+      case CXToken_Literal:     return(SY(literal));
+      case CXToken_Comment:     return(SY(comment));
+      default: ERROR("Unknown token kind %d",tokenKind); return(nil);}}
+
+id typeSymbol(int typeKind){
     switch(typeKind){
-      case CXType_Invalid:                  return ":Invalid";
-      case CXType_Unexposed:                return ":Unexposed";
-      case CXType_Void:                     return ":Void";
-      case CXType_Bool:                     return ":Bool";
-      case CXType_Char_U:                   return ":Char-U";
-      case CXType_UChar:                    return ":unsigned-Char";
-      case CXType_Char16:                   return ":Char-16";
-      case CXType_Char32:                   return ":Char-32";
-      case CXType_UShort:                   return ":unsigned-Short";
-      case CXType_UInt:                     return ":unsigned-Int";
-      case CXType_ULong:                    return ":unsigned-Long";
-      case CXType_ULongLong:                return ":unsigned-Long-Long";
-      case CXType_UInt128:                  return ":unsigned-Int-128";
-      case CXType_Char_S:                   return ":Char-S";
-      case CXType_SChar:                    return ":Signed-Char";
-      case CXType_WChar:                    return ":Wide-Char";
-      case CXType_Short:                    return ":Short";
-      case CXType_Int:                      return ":Int";
-      case CXType_Long:                     return ":Long";
-      case CXType_LongLong:                 return ":Long-Long";
-      case CXType_Int128:                   return ":Int-128";
-      case CXType_Float:                    return ":Float";
-      case CXType_Double:                   return ":Double";
-      case CXType_LongDouble:               return ":Long-Double";
-      case CXType_NullPtr:                  return ":Null-Pointer";
-      case CXType_Overload:                 return ":Overload";
-      case CXType_Dependent:                return ":Dependent";
-      case CXType_ObjCId:                   return ":ObjC-Id";
-      case CXType_ObjCClass:                return ":ObjC-Class";
-      case CXType_ObjCSel:                  return ":ObjC-Selector";
-      case CXType_Complex:                  return ":Complex";
-      case CXType_Pointer:                  return ":Pointer";
-      case CXType_BlockPointer:             return ":Block-Pointer";
-      case CXType_LValueReference:          return ":left-Value-Reference";
-      case CXType_RValueReference:          return ":right-Value-Reference";
-      case CXType_Record:                   return ":Record";
-      case CXType_Enum:                     return ":Enum";
-      case CXType_Typedef:                  return ":Typedef";
-      case CXType_ObjCInterface:            return ":ObjC-Interface";
-      case CXType_ObjCObjectPointer:        return ":ObjC-Object-Pointer";
-      case CXType_FunctionNoProto:          return ":Function-No-Proto";
-      case CXType_FunctionProto:            return ":Function-Proto";
-      case CXType_ConstantArray:            return ":Constant-Array";
-      case CXType_Vector:                   return ":Vector";
-      default:                              return ":invalid"; }}
-
-
-const char* callingConvention(int cc){
+      case CXType_Invalid:                  return SY(Invalid);
+      case CXType_Unexposed:                return SY(Unexposed);
+      case CXType_Void:                     return SY(Void);
+      case CXType_Bool:                     return SY(Bool);
+      case CXType_Char_U:                   return SY(Char-U);
+      case CXType_UChar:                    return SY(unsigned-Char);
+      case CXType_Char16:                   return SY(Char-16);
+      case CXType_Char32:                   return SY(Char-32);
+      case CXType_UShort:                   return SY(unsigned-Short);
+      case CXType_UInt:                     return SY(unsigned-Int);
+      case CXType_ULong:                    return SY(unsigned-Long);
+      case CXType_ULongLong:                return SY(unsigned-Long-Long);
+      case CXType_UInt128:                  return SY(unsigned-Int-128);
+      case CXType_Char_S:                   return SY(Char-S);
+      case CXType_SChar:                    return SY(Signed-Char);
+      case CXType_WChar:                    return SY(Wide-Char);
+      case CXType_Short:                    return SY(Short);
+      case CXType_Int:                      return SY(Int);
+      case CXType_Long:                     return SY(Long);
+      case CXType_LongLong:                 return SY(Long-Long);
+      case CXType_Int128:                   return SY(Int-128);
+      case CXType_Float:                    return SY(c-Float);
+      case CXType_Double:                   return SY(Double);
+      case CXType_LongDouble:               return SY(Long-Double);
+      case CXType_NullPtr:                  return SY(Null-Pointer);
+      case CXType_Overload:                 return SY(Overload);
+      case CXType_Dependent:                return SY(Dependent);
+      case CXType_ObjCId:                   return SY(ObjC-Id);
+      case CXType_ObjCClass:                return SY(ObjC-Class);
+      case CXType_ObjCSel:                  return SY(ObjC-Selector);
+      case CXType_Complex:                  return SY(c-Complex);
+      case CXType_Pointer:                  return SY(Pointer);
+      case CXType_BlockPointer:             return SY(Block-Pointer);
+      case CXType_LValueReference:          return SY(left-Value-Reference);
+      case CXType_RValueReference:          return SY(right-Value-Reference);
+      case CXType_Record:                   return SY(Record);
+      case CXType_Enum:                     return SY(Enum);
+      case CXType_Typedef:                  return SY(Typedef);
+      case CXType_ObjCInterface:            return SY(ObjC-Interface);
+      case CXType_ObjCObjectPointer:        return SY(ObjC-Object-Pointer);
+      case CXType_FunctionNoProto:          return SY(Function-No-Proto);
+      case CXType_FunctionProto:            return SY(Function-Proto);
+      case CXType_ConstantArray:            return SY(Constant-Array);
+      case CXType_Vector:                   return SY(c-Vector);
+      default:                              return SY(invalid); }}
+
+id callingConvention(int cc){
     switch(cc){
-      case CXCallingConv_Default:           return ":Default";
-      case CXCallingConv_C:                 return ":C";
-      case CXCallingConv_X86StdCall:        return ":X86StdCall";
-      case CXCallingConv_X86FastCall:       return ":X86FastCall";
-      case CXCallingConv_X86ThisCall:       return ":X86ThisCall";
-      case CXCallingConv_X86Pascal:         return ":X86Pascal";
-      case CXCallingConv_AAPCS:             return ":AAPCS";
-      case CXCallingConv_AAPCS_VFP:         return ":AAPCS_VFP";
-      case CXCallingConv_PnaclCall:         return ":PnaclCall";
-          // case CXCallingConv_IntelOclBicc:      return ":IntelOclBicc";
-          // case CXCallingConv_Invalid:           return ":Invalid";
-      case CXCallingConv_Unexposed:         return ":Unexposed";
-      default:                              return ":invalid"; }}
-
-const char* accessSpecifier(int as){
+      case CXCallingConv_Default:           return KW(Default);
+      case CXCallingConv_C:                 return KW(C);
+      case CXCallingConv_X86StdCall:        return KW(X86StdCall);
+      case CXCallingConv_X86FastCall:       return KW(X86FastCall);
+      case CXCallingConv_X86ThisCall:       return KW(X86ThisCall);
+      case CXCallingConv_X86Pascal:         return KW(X86Pascal);
+      case CXCallingConv_AAPCS:             return KW(AAPCS);
+      case CXCallingConv_AAPCS_VFP:         return KW(AAPCS_VFP);
+      case CXCallingConv_PnaclCall:         return KW(PnaclCall);
+          // case CXCallingConv_IntelOclBicc:      return KW(IntelOclBicc);
+          // case CXCallingConv_Invalid:           return KW(Invalid);
+      case CXCallingConv_Unexposed:         return KW(Unexposed);
+      default:                              return KW(invalid); }}
+
+id accessSpecifier(int as){
     switch(as){
-      case CX_CXXInvalidAccessSpecifier: return ":invalid";
-      case CX_CXXPublic:                 return ":public";
-      case CX_CXXProtected:              return ":protected";
-      case CX_CXXPrivate:                return ":private";
-      default:                           return ":invalid";}}
-
-
-void newline(int margin){
-    printf("\n%*s",margin,"");}
+      case CX_CXXInvalidAccessSpecifier: return KW(invalid);
+      case CX_CXXPublic:                 return KW(public);
+      case CX_CXXProtected:              return KW(protected);
+      case CX_CXXPrivate:                return KW(private);
+      default:                           return KW(invalid);}}

-/* void print_platform_availability(CXPlatformAvailability availability){ */
-/*     printf("(plateform-availability :plateform \"%s\" :introduced \"%s\" :deprecated \"%s\" :obsoleted \"%s\" :unavailable %s :message \"%s\")",availability.Platform */
-/* } */

-
-id cxstring(CXString theCXString){
+id cxstring_dispose(CXString theCXString,int dispose){
     const char* cstring=clang_getCString(theCXString);
     id result=((nil==cstring)
-                    ?nil
-                    :string(cstring));
-    clang_disposeString(theCXString);
+               ?nil
+               :string(cstring));
+    if(dispose){
+        clang_disposeString(theCXString);}
     return(result);}

-void print_cxstring(CXString string){
-    const char* cstring=clang_getCString(string);
-    if(nil==cstring){
-        printf("nil");
-    }else{
-        printf("\"%s\"",cstring);
-    }
-    clang_disposeString(string);}
-
-
-void print_location(CXSourceLocation location){
+id cxstring(CXString theCXString){
+    return(cxstring_dispose(theCXString,1));}
+
+id cxversion(CXVersion version){
+    return(list(3,
+                integer(version.Major),
+                integer(version.Minor),
+                integer(version.Subminor)));}
+
+
+id platform_availability(CXCursor cxcursor){
+    int platformCount=clang_getCursorPlatformAvailability(cxcursor,0,0,0,0,0,0);
+    int always_deprecated=0;
+    int always_unavailable=0;
+    CXString deprecated_message;
+    CXString unavailable_message;
+    id platformAvailabilities=nil;
+    if(platformCount!=0){
+        CXPlatformAvailability* availability=memory_allocate(__FUNCTION__,sizeof(*availability),platformCount);
+        platformCount=clang_getCursorPlatformAvailability(cxcursor,
+                                                          &always_deprecated,
+                                                          &deprecated_message,
+                                                          &always_unavailable,
+                                                          &unavailable_message,
+                                                          availability,
+                                                          platformCount);
+        DOTIMES(i,platformCount,
+                {PUSH(list(13,
+                           SY(platform-availability),
+                           KW(platform),cxstring_dispose(availability[i].Platform,0),
+                           KW(introduced),cxversion(availability[i].Introduced),
+                           KW(deprecated),cxversion(availability[i].Deprecated),
+                           KW(obsoleted),cxversion(availability[i].Obsoleted),
+                           KW(unavailable),boolean(availability[i].Unavailable),
+                           KW(message),cxstring_dispose(availability[i].Message,0)),
+                      platformAvailabilities);
+                 clang_disposeCXPlatformAvailability(&(availability[i]));});}
+    if(not(always_deprecated) and not(always_unavailable) and (0==platformCount)){
+        return(nil);}
+    else{
+        return(list(11,
+                    SY(availability),
+                    KW(always-deprecated),boolean(always_deprecated),
+                    KW(always-deprecated-message),cxstring(deprecated_message),
+                    KW(always-unavailable),boolean(always_unavailable),
+                    KW(always-unavailable-message),cxstring(unavailable_message),
+                    KW(platforms),platformAvailabilities));}}
+
+id location(CXSourceLocation location){
     CXFile file;
     unsigned line;
     unsigned column;
     unsigned offset;
     clang_getSpellingLocation(location,&file,&line,&column,&offset);
-    printf("(location :file ");
-    if(nil==file){
-        printf("nil");
-    }else{
-        print_cxstring(clang_getFileName(file));
-    }
-    printf(" :line %u :column %u :offset %u)",line,column,offset);}
-
-
-void print_range(CXSourceRange range,int margin){
-    printf("(range :start ");
-    print_location(clang_getRangeStart(range));
-    newline(margin);printf("       :end   ");
-    print_location(clang_getRangeEnd(range));
-    printf(")");}
-
-
-id cursors=0; // maps CXCursor objects to integer objects.
-
-
-void print_flag(int margin,const char* name,bool flag){
-    newline(imin(60,margin));
-    printf(" %s %s",name,flag?"t":"nil");}
-
-
-void print_cursor(CXCursor cxcursor,int margin);
-
-
-void print_unexposed_decl(CXCursor cursor,int margin){
-}
-
-void print_struct_decl(CXCursor cursor,int margin){
-}
-
-void print_union_decl(CXCursor cursor,int margin){
-}
-
-void print_class_decl(CXCursor cursor,int margin){
-}
-
-void print_enum_decl(CXCursor cursor,int margin){
-}
-
-void print_field_decl(CXCursor cursor,int margin){
-}
-
-void print_enum_constant_decl(CXCursor cursor,int margin){
-}
-
-void print_function_decl(CXCursor cursor,int margin){
-}
-
-void print_var_decl(CXCursor cursor,int margin){
-}
-
-void print_parm_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_interface_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_category_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_protocol_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_property_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_ivar_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_instance_method_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_class_method_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_implementation_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_category_impl_decl(CXCursor cursor,int margin){
-}
-
-void print_typedef_decl(CXCursor cursor,int margin){
-}
-
-void print_cxx_method(CXCursor cursor,int margin){
-}
-
-void print_namespace(CXCursor cursor,int margin){
-}
-
-void print_linkage_spec(CXCursor cursor,int margin){
-}
-
-void print_constructor(CXCursor cursor,int margin){
-}
-
-void print_destructor(CXCursor cursor,int margin){
-}
-
-void print_conversion_function(CXCursor cursor,int margin){
-}
-
-void print_template_type_parameter(CXCursor cursor,int margin){
-}
-
-void print_non_type_template_parameter(CXCursor cursor,int margin){
-}
-
-void print_template_template_parameter(CXCursor cursor,int margin){
-}
-
-void print_function_template(CXCursor cursor,int margin){
-}
-
-void print_class_template(CXCursor cursor,int margin){
-}
-
-void print_class_template_partial_specialization(CXCursor cursor,int margin){
-}
-
-void print_namespace_alias(CXCursor cursor,int margin){
-}
-
-void print_using_directive(CXCursor cursor,int margin){
-}
-
-void print_using_declaration(CXCursor cursor,int margin){
-}
-
-void print_type_alias_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_synthesize_decl(CXCursor cursor,int margin){
-}
-
-void print_objc_dynamic_decl(CXCursor cursor,int margin){
-}
-
-void print_cxx_access_specifier(CXCursor cursor,int margin){
-}
-
-void print_objc_super_class_ref(CXCursor cursor,int margin){
-}
-
-void print_objc_protocol_ref(CXCursor cursor,int margin){
-}
-
-void print_objc_class_ref(CXCursor cursor,int margin){
-}
-
-void print_type_ref(CXCursor cursor,int margin){
-}
-
-void print_cxx_base_specifier(CXCursor cursor,int margin){
-}
-
-void print_template_ref(CXCursor cursor,int margin){
-}
-
-void print_namespace_ref(CXCursor cursor,int margin){
-}
-
-void print_member_ref(CXCursor cursor,int margin){
-}
+    return(list(9,SY(location),
+                KW(file),(null(file)?nil:cxstring(clang_getFileName(file))),
+                KW(line),integer(line),
+                KW(column),integer(column),
+                KW(offset),integer(offset)));}

-void print_label_ref(CXCursor cursor,int margin){
-}
+id range(CXSourceRange range){
+    return(list(5,SY(range),
+                KW(start),location(clang_getRangeStart(range)),
+                KW(end),location(clang_getRangeEnd(range))));}

-void print_overloaded_decl_ref(CXCursor cursor,int margin){
-}

-void print_variable_ref(CXCursor cursor,int margin){
-}

-void print_invalid_file(CXCursor cursor,int margin){
-}
-
-void print_no_decl_found(CXCursor cursor,int margin){
-}
-
-void print_not_implemented(CXCursor cursor,int margin){
-}
-
-void print_invalid_code(CXCursor cursor,int margin){
-}
-
-void print_unexposed_expr(CXCursor cursor,int margin){
-}
-
-void print_decl_ref_expr(CXCursor cursor,int margin){
-}
-
-void print_member_ref_expr(CXCursor cursor,int margin){
-}
-
-void print_call_expr(CXCursor cursor,int margin){
-}
-
-void print_objc_message_expr(CXCursor cursor,int margin){
-}
-
-void print_block_expr(CXCursor cursor,int margin){
-}
-
-void print_integer_literal(CXCursor cursor,int margin){
-}
-
-void print_floating_literal(CXCursor cursor,int margin){
-}
-
-void print_imaginary_literal(CXCursor cursor,int margin){
-}
-
-void print_cxstring_literal(CXCursor cursor,int margin){
-}
-
-void print_character_literal(CXCursor cursor,int margin){
-}
-
-void print_paren_expr(CXCursor cursor,int margin){
-}
-
-void print_unary_operator(CXCursor cursor,int margin){
-}
-
-void print_array_subscript_expr(CXCursor cursor,int margin){
-}
-
-void print_binary_operator(CXCursor cursor,int margin){
-}
-
-void print_compound_assign_operator(CXCursor cursor,int margin){
-}
-
-void print_conditional_operator(CXCursor cursor,int margin){
-}
-
-void print_cstyle_cast_expr(CXCursor cursor,int margin){
-}
-
-void print_compound_literal_expr(CXCursor cursor,int margin){
-}
-
-void print_init_list_expr(CXCursor cursor,int margin){
-}
-
-void print_addr_label_expr(CXCursor cursor,int margin){
-}
-
-void print_stmt_expr(CXCursor cursor,int margin){
-}
-
-void print_generic_selection_expr(CXCursor cursor,int margin){
-}
-
-void print_gnunull_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_static_cast_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_dynamic_cast_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_reinterpret_cast_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_const_cast_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_functional_cast_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_typeid_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_bool_literal_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_null_ptr_literal_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_this_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_throw_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_new_expr(CXCursor cursor,int margin){
-}
-
-void print_cxx_delete_expr(CXCursor cursor,int margin){
-}
-
-void print_unary_expr(CXCursor cursor,int margin){
-}
-
-void print_objc_string_literal(CXCursor cursor,int margin){
-}
-
-void print_objc_encode_expr(CXCursor cursor,int margin){
-}
-
-void print_objc_selector_expr(CXCursor cursor,int margin){
-}
-
-void print_objc_protocol_expr(CXCursor cursor,int margin){
-}
-
-void print_objc_bridged_cast_expr(CXCursor cursor,int margin){
-}
-
-void print_pack_expansion_expr(CXCursor cursor,int margin){
-}
-
-void print_size_of_pack_expr(CXCursor cursor,int margin){
-}
-
-void print_lambda_expr(CXCursor cursor,int margin){
-}
-
-void print_objc_bool_literal_expr(CXCursor cursor,int margin){
-}
-
-void print_unexposed_stmt(CXCursor cursor,int margin){
-}
-
-void print_label_stmt(CXCursor cursor,int margin){
-}
-
-void print_compound_stmt(CXCursor cursor,int margin){
-}
-
-void print_case_stmt(CXCursor cursor,int margin){
-}
-
-void print_default_stmt(CXCursor cursor,int margin){
-}
-
-void print_if_stmt(CXCursor cursor,int margin){
-}
-
-void print_switch_stmt(CXCursor cursor,int margin){
-}
-
-void print_while_stmt(CXCursor cursor,int margin){
-}
-
-void print_do_stmt(CXCursor cursor,int margin){
-}
-
-void print_for_stmt(CXCursor cursor,int margin){
-}
-
-void print_goto_stmt(CXCursor cursor,int margin){
-}
-
-void print_indirect_goto_stmt(CXCursor cursor,int margin){
-}
-
-void print_continue_stmt(CXCursor cursor,int margin){
-}
-
-void print_break_stmt(CXCursor cursor,int margin){
-}
-
-void print_return_stmt(CXCursor cursor,int margin){
-}
-
-void print_gccasm_stmt(CXCursor cursor,int margin){
-}
-
-void print_objc_at_try_stmt(CXCursor cursor,int margin){
-}
-
-void print_objc_at_catch_stmt(CXCursor cursor,int margin){
-}
-
-void print_objc_at_finally_stmt(CXCursor cursor,int margin){
-}
-
-void print_objc_at_throw_stmt(CXCursor cursor,int margin){
-}
-
-void print_objc_at_synchronized_stmt(CXCursor cursor,int margin){
-}
-
-void print_objc_autorelease_pool_stmt(CXCursor cursor,int margin){
-}
-
-void print_objc_for_collection_stmt(CXCursor cursor,int margin){
-}
-
-void print_cxx_catch_stmt(CXCursor cursor,int margin){
-}
-
-void print_cxx_try_stmt(CXCursor cursor,int margin){
-}
-
-void print_cxx_for_range_stmt(CXCursor cursor,int margin){
-}
-
-void print_seh_try_stmt(CXCursor cursor,int margin){
-}
-
-void print_seh_except_stmt(CXCursor cursor,int margin){
-}
-
-void print_seh_finally_stmt(CXCursor cursor,int margin){
-}
-
-void print_msasm_stmt(CXCursor cursor,int margin){
-}
-
-void print_null_stmt(CXCursor cursor,int margin){
-}
-
-void print_decl_stmt(CXCursor cursor,int margin){
-}
-
-void print_translation_unit(CXCursor cursor,int margin){
-}
-
-void print_unexposed_attr(CXCursor cursor,int margin){
-}
-
-void print_ibaction_attr(CXCursor cursor,int margin){
-}
-
-void print_iboutlet_attr(CXCursor cursor,int margin){
-}
-
-void print_iboutlet_collection_attr(CXCursor cursor,int margin){
-}
-
-void print_cxx_final_attr(CXCursor cursor,int margin){
-}
-
-void print_cxx_override_attr(CXCursor cursor,int margin){
-}
-
-void print_annotate_attr(CXCursor cursor,int margin){
-}
-
-void print_asm_label_attr(CXCursor cursor,int margin){
-}
-
-void print_preprocessing_directive(CXCursor cursor,int margin){
-}
-
-void print_macro_definition(CXCursor cursor,int margin){
-}
-
-void print_macro_expansion(CXCursor cursor,int margin){
-}
-
-void print_inclusion_directive(CXCursor cursor,int margin){
-}
-
-void print_module_import_decl(CXCursor cursor,int margin){
-}
-
-void print_invalid(CXCursor cursor,int margin){
-}
-
-
-
-
-typedef void(*printer)(CXCursor,int);
-
-printer cursor_printer(int cursorKind){
-    switch(cursorKind){
-      case CXCursor_UnexposedDecl:                      return print_unexposed_decl;
-      case CXCursor_StructDecl:                         return print_struct_decl;
-      case CXCursor_UnionDecl:                          return print_union_decl;
-      case CXCursor_ClassDecl:                          return print_class_decl;
-      case CXCursor_EnumDecl:                           return print_enum_decl;
-      case CXCursor_FieldDecl:                          return print_field_decl;
-      case CXCursor_EnumConstantDecl:                   return print_enum_constant_decl;
-      case CXCursor_FunctionDecl:                       return print_function_decl;
-      case CXCursor_VarDecl:                            return print_var_decl;
-      case CXCursor_ParmDecl:                           return print_parm_decl;
-      case CXCursor_ObjCInterfaceDecl:                  return print_objc_interface_decl;
-      case CXCursor_ObjCCategoryDecl:                   return print_objc_category_decl;
-      case CXCursor_ObjCProtocolDecl:                   return print_objc_protocol_decl;
-      case CXCursor_ObjCPropertyDecl:                   return print_objc_property_decl;
-      case CXCursor_ObjCIvarDecl:                       return print_objc_ivar_decl;
-      case CXCursor_ObjCInstanceMethodDecl:             return print_objc_instance_method_decl;
-      case CXCursor_ObjCClassMethodDecl:                return print_objc_class_method_decl;
-      case CXCursor_ObjCImplementationDecl:             return print_objc_implementation_decl;
-      case CXCursor_ObjCCategoryImplDecl:               return print_objc_category_impl_decl;
-      case CXCursor_TypedefDecl:                        return print_typedef_decl;
-      case CXCursor_CXXMethod:                          return print_cxx_method;
-      case CXCursor_Namespace:                          return print_namespace;
-      case CXCursor_LinkageSpec:                        return print_linkage_spec;
-      case CXCursor_Constructor:                        return print_constructor;
-      case CXCursor_Destructor:                         return print_destructor;
-      case CXCursor_ConversionFunction:                 return print_conversion_function;
-      case CXCursor_TemplateTypeParameter:              return print_template_type_parameter;
-      case CXCursor_NonTypeTemplateParameter:           return print_non_type_template_parameter;
-      case CXCursor_TemplateTemplateParameter:          return print_template_template_parameter;
-      case CXCursor_FunctionTemplate:                   return print_function_template;
-      case CXCursor_ClassTemplate:                      return print_class_template;
-      case CXCursor_ClassTemplatePartialSpecialization: return print_class_template_partial_specialization;
-      case CXCursor_NamespaceAlias:                     return print_namespace_alias;
-      case CXCursor_UsingDirective:                     return print_using_directive;
-      case CXCursor_UsingDeclaration:                   return print_using_declaration;
-      case CXCursor_TypeAliasDecl:                      return print_type_alias_decl;
-      case CXCursor_ObjCSynthesizeDecl:                 return print_objc_synthesize_decl;
-      case CXCursor_ObjCDynamicDecl:                    return print_objc_dynamic_decl;
-      case CXCursor_CXXAccessSpecifier:                 return print_cxx_access_specifier;
-      case CXCursor_ObjCSuperClassRef:                  return print_objc_super_class_ref;
-      case CXCursor_ObjCProtocolRef:                    return print_objc_protocol_ref;
-      case CXCursor_ObjCClassRef:                       return print_objc_class_ref;
-      case CXCursor_TypeRef:                            return print_type_ref;
-      case CXCursor_CXXBaseSpecifier:                   return print_cxx_base_specifier;
-      case CXCursor_TemplateRef:                        return print_template_ref;
-      case CXCursor_NamespaceRef:                       return print_namespace_ref;
-      case CXCursor_MemberRef:                          return print_member_ref;
-      case CXCursor_LabelRef:                           return print_label_ref;
-      case CXCursor_OverloadedDeclRef:                  return print_overloaded_decl_ref;
-      case CXCursor_VariableRef:                        return print_variable_ref;
-      case CXCursor_InvalidFile:                        return print_invalid_file;
-      case CXCursor_NoDeclFound:                        return print_no_decl_found;
-      case CXCursor_NotImplemented:                     return print_not_implemented;
-      case CXCursor_InvalidCode:                        return print_invalid_code;
-      case CXCursor_UnexposedExpr:                      return print_unexposed_expr;
-      case CXCursor_DeclRefExpr:                        return print_decl_ref_expr;
-      case CXCursor_MemberRefExpr:                      return print_member_ref_expr;
-      case CXCursor_CallExpr:                           return print_call_expr;
-      case CXCursor_ObjCMessageExpr:                    return print_objc_message_expr;
-      case CXCursor_BlockExpr:                          return print_block_expr;
-      case CXCursor_IntegerLiteral:                     return print_integer_literal;
-      case CXCursor_FloatingLiteral:                    return print_floating_literal;
-      case CXCursor_ImaginaryLiteral:                   return print_imaginary_literal;
-      case CXCursor_StringLiteral:                      return print_cxstring_literal;
-      case CXCursor_CharacterLiteral:                   return print_character_literal;
-      case CXCursor_ParenExpr:                          return print_paren_expr;
-      case CXCursor_UnaryOperator:                      return print_unary_operator;
-      case CXCursor_ArraySubscriptExpr:                 return print_array_subscript_expr;
-      case CXCursor_BinaryOperator:                     return print_binary_operator;
-      case CXCursor_CompoundAssignOperator:             return print_compound_assign_operator;
-      case CXCursor_ConditionalOperator:                return print_conditional_operator;
-      case CXCursor_CStyleCastExpr:                     return print_cstyle_cast_expr;
-      case CXCursor_CompoundLiteralExpr:                return print_compound_literal_expr;
-      case CXCursor_InitListExpr:                       return print_init_list_expr;
-      case CXCursor_AddrLabelExpr:                      return print_addr_label_expr;
-      case CXCursor_StmtExpr:                           return print_stmt_expr;
-      case CXCursor_GenericSelectionExpr:               return print_generic_selection_expr;
-      case CXCursor_GNUNullExpr:                        return print_gnunull_expr;
-      case CXCursor_CXXStaticCastExpr:                  return print_cxx_static_cast_expr;
-      case CXCursor_CXXDynamicCastExpr:                 return print_cxx_dynamic_cast_expr;
-      case CXCursor_CXXReinterpretCastExpr:             return print_cxx_reinterpret_cast_expr;
-      case CXCursor_CXXConstCastExpr:                   return print_cxx_const_cast_expr;
-      case CXCursor_CXXFunctionalCastExpr:              return print_cxx_functional_cast_expr;
-      case CXCursor_CXXTypeidExpr:                      return print_cxx_typeid_expr;
-      case CXCursor_CXXBoolLiteralExpr:                 return print_cxx_bool_literal_expr;
-      case CXCursor_CXXNullPtrLiteralExpr:              return print_cxx_null_ptr_literal_expr;
-      case CXCursor_CXXThisExpr:                        return print_cxx_this_expr;
-      case CXCursor_CXXThrowExpr:                       return print_cxx_throw_expr;
-      case CXCursor_CXXNewExpr:                         return print_cxx_new_expr;
-      case CXCursor_CXXDeleteExpr:                      return print_cxx_delete_expr;
-      case CXCursor_UnaryExpr:                          return print_unary_expr;
-      case CXCursor_ObjCStringLiteral:                  return print_objc_string_literal;
-      case CXCursor_ObjCEncodeExpr:                     return print_objc_encode_expr;
-      case CXCursor_ObjCSelectorExpr:                   return print_objc_selector_expr;
-      case CXCursor_ObjCProtocolExpr:                   return print_objc_protocol_expr;
-      case CXCursor_ObjCBridgedCastExpr:                return print_objc_bridged_cast_expr;
-      case CXCursor_PackExpansionExpr:                  return print_pack_expansion_expr;
-      case CXCursor_SizeOfPackExpr:                     return print_size_of_pack_expr;
-      case CXCursor_LambdaExpr:                         return print_lambda_expr;
-      case CXCursor_ObjCBoolLiteralExpr:                return print_objc_bool_literal_expr;
-      case CXCursor_UnexposedStmt:                      return print_unexposed_stmt;
-      case CXCursor_LabelStmt:                          return print_label_stmt;
-      case CXCursor_CompoundStmt:                       return print_compound_stmt;
-      case CXCursor_CaseStmt:                           return print_case_stmt;
-      case CXCursor_DefaultStmt:                        return print_default_stmt;
-      case CXCursor_IfStmt:                             return print_if_stmt;
-      case CXCursor_SwitchStmt:                         return print_switch_stmt;
-      case CXCursor_WhileStmt:                          return print_while_stmt;
-      case CXCursor_DoStmt:                             return print_do_stmt;
-      case CXCursor_ForStmt:                            return print_for_stmt;
-      case CXCursor_GotoStmt:                           return print_goto_stmt;
-      case CXCursor_IndirectGotoStmt:                   return print_indirect_goto_stmt;
-      case CXCursor_ContinueStmt:                       return print_continue_stmt;
-      case CXCursor_BreakStmt:                          return print_break_stmt;
-      case CXCursor_ReturnStmt:                         return print_return_stmt;
-      case CXCursor_GCCAsmStmt:                         return print_gccasm_stmt;
-      case CXCursor_ObjCAtTryStmt:                      return print_objc_at_try_stmt;
-      case CXCursor_ObjCAtCatchStmt:                    return print_objc_at_catch_stmt;
-      case CXCursor_ObjCAtFinallyStmt:                  return print_objc_at_finally_stmt;
-      case CXCursor_ObjCAtThrowStmt:                    return print_objc_at_throw_stmt;
-      case CXCursor_ObjCAtSynchronizedStmt:             return print_objc_at_synchronized_stmt;
-      case CXCursor_ObjCAutoreleasePoolStmt:            return print_objc_autorelease_pool_stmt;
-      case CXCursor_ObjCForCollectionStmt:              return print_objc_for_collection_stmt;
-      case CXCursor_CXXCatchStmt:                       return print_cxx_catch_stmt;
-      case CXCursor_CXXTryStmt:                         return print_cxx_try_stmt;
-      case CXCursor_CXXForRangeStmt:                    return print_cxx_for_range_stmt;
-      case CXCursor_SEHTryStmt:                         return print_seh_try_stmt;
-      case CXCursor_SEHExceptStmt:                      return print_seh_except_stmt;
-      case CXCursor_SEHFinallyStmt:                     return print_seh_finally_stmt;
-      case CXCursor_MSAsmStmt:                          return print_msasm_stmt;
-      case CXCursor_NullStmt:                           return print_null_stmt;
-      case CXCursor_DeclStmt:                           return print_decl_stmt;
-      case CXCursor_TranslationUnit:                    return print_translation_unit;
-      case CXCursor_UnexposedAttr:                      return print_unexposed_attr;
-      case CXCursor_IBActionAttr:                       return print_ibaction_attr;
-      case CXCursor_IBOutletAttr:                       return print_iboutlet_attr;
-      case CXCursor_IBOutletCollectionAttr:             return print_iboutlet_collection_attr;
-      case CXCursor_CXXFinalAttr:                       return print_cxx_final_attr;
-      case CXCursor_CXXOverrideAttr:                    return print_cxx_override_attr;
-      case CXCursor_AnnotateAttr:                       return print_annotate_attr;
-      case CXCursor_AsmLabelAttr:                       return print_asm_label_attr;
-      case CXCursor_PreprocessingDirective:             return print_preprocessing_directive;
-      case CXCursor_MacroDefinition:                    return print_macro_definition;
-      case CXCursor_MacroExpansion:                     return print_macro_expansion;
-      case CXCursor_InclusionDirective:                 return print_inclusion_directive;
-      case CXCursor_ModuleImportDecl:                   return print_module_import_decl;
-      default:                                          return print_invalid;}}
-
-
-
-
-
-
-
-
-void reset_visited_flag(id key,id value,void* data){
-    setcar(second(value),integer(0));}
-
-void reset_visited_hashtable(id visited){
-    hashtable_map(visited,reset_visited_flag,0);}
-
-
-
-typedef void (*visit_once_cursors_function)(id ident_number,id label,id cxcursor,id parent,void* function_closure);
 typedef struct {
-    id                          visited; // maps cursors to (#n# visited-0/1 …)
-    visit_once_cursors_function prefix;
-    visit_once_cursors_function function;
-    visit_once_cursors_function suffix;
-    void*                       function_closure;
-} visit_once_cursors_closure;
-
-enum CXChildVisitResult visit_once_cursors(CXCursor cxcursor,CXCursor parent,CXClientData client_data){
-    /*
-    Calls the closure `function' for each arc labelled by `label' going
-    from `parent' to some cursor `cxcursor'.
-    */
-    visit_once_cursors_closure* closure=client_data;
-    id                          visited=closure->visited;
-    visit_once_cursors_function function=closure->function;
-    void*                       function_closure=closure->function_closure;
-
-    id p=cursor(parent);
-    id c=cursor(cxcursor);
-    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(cxcursor));
-    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(unbox_cursor(c)));
-    id n=hashtable_get(visited,c);
-    id ident_number=first(n);
-    id child=string(":child");
-    closure->prefix(ident_number,child,c,p,function_closure);
-    if(null(n)){
-        id entry=list(2,integer(hashtable_count(visited)),integer(0));
-        hashtable_set(visited,c,entry);
-
-        CXTranslationUnit tu=clang_Cursor_getTranslationUnit(cxcursor);
-        CXCursor tucursor=clang_getTranslationUnitCursor(tu);
-        if(not(clang_Cursor_isNull(tucursor))){
-            id cc=cursor(tucursor);
-            function(first(hashtable_get(visited,cc)),string(":translation-unit"),cc,c,function_closure);}
-
-        CXCursor separent=clang_getCursorSemanticParent(cxcursor);
-        if(not(clang_Cursor_isNull(separent))){
-            id cc=cursor(separent);
-            function(first(hashtable_get(visited,cc)),string(":semantic-parent"),cc,c,function_closure);}
-
-        CXCursor leparent=clang_getCursorLexicalParent(cxcursor);
-        if(not(clang_Cursor_isNull(leparent))){
-            id cc=cursor(leparent);
-            function(first(hashtable_get(visited,cc)),string(":lexical-parent"),cc,c,function_closure);}
-
-        // clang_getOverriddenCursors(cxcursor,&overridden,&num_overridden);
-        // clang_disposeOverriddenCursors(overridden);
-
-
-        /* CXType type=clang_getCursorType(cxcursor); */
-        /* if(CXType_Invalid!=type.kind){ */
-        /*     newline(margin); printf(" :type %s",cursorType(type.kind));} */
-        /*  */
-        /* CXType underType=clang_getTypedefDeclUnderlyingType(cxcursor); */
-        /* if(CXType_Invalid!=type.kind){ */
-        /*     newline(margin); printf(" :underlying-type %s",cursorType(underType.kind));} */
-        /*  */
-        /* CXType enumType=clang_getEnumDeclIntegerType(cxcursor); */
-        /* if(CXType_Invalid!=type.kind){ */
-        /*     newline(margin); printf(" :enum-type %s",cursorType(enumType.kind));} */
-
-        int numArguments=clang_Cursor_getNumArguments(cxcursor);
-        if(0<=numArguments){
-            for(int i=0;i<numArguments;i++){
-                id cc=cursor(clang_Cursor_getArgument(cxcursor,i));
-                function(first(hashtable_get(visited,cc)),string(":argument"),cc,c,function_closure);}}
-
-        unsigned numOver=clang_getNumOverloadedDecls(cxcursor);
-        if(0<numOver){
-            for(int i=0;i<numOver;i++){
-                id cc=cursor(clang_getOverloadedDecl(cxcursor,i));
-                function(first(hashtable_get(visited,cc)),string(":overloaded-declaration"),cc,c,function_closure);}}
-
-        CXCursor definition=clang_getCursorDefinition(cxcursor);
-        if(not(clang_Cursor_isNull(definition))){
-            id cc=cursor(definition);
-            function(first(hashtable_get(visited,cc)),string(":definition"),cc,c,function_closure);}
-
-        CXCursor canonical=clang_getCanonicalCursor(cxcursor);
-        if(not(clang_Cursor_isNull(canonical))){
-            id cc=cursor(canonical);
-            function(first(hashtable_get(visited,cc)),string(":canonical"),cc,c,function_closure);}
-
-        clang_visitChildren(cxcursor,visit_once_cursors,client_data);}
-    closure->suffix(ident_number,child,c,p,function_closure);
-    return CXChildVisit_Continue;}
-
-
-
-
+    enum CXChildVisitResult result;
+    id cursors;
+} collect_cursor_visitor_closure;
+
+enum CXChildVisitResult collect_cursor_visitor(CXCursor cxcursor,CXCursor parent,CXClientData client_data){
+    collect_cursor_visitor_closure* closure=client_data;
+    PUSH(cursor(cxcursor),closure->cursors);
+    return(closure->result);}
+
+id cursor_children(id cursor){
+    collect_cursor_visitor_closure closure;
+    closure.result=CXChildVisit_Continue; // not recursive.
+    closure.cursors=nil;
+    clang_visitChildren(unbox_cursor(cursor),collect_cursor_visitor,&closure);
+    return(cons(SY(list),nreverse(closure.cursors)));}
+
+
+#define NCONCF(PLACE,LIST) PLACE=nconc(2,PLACE,LIST)
+#define NCONCF2(PLACE,KEY,VALUE) PLACE=nconc(2,PLACE,list(2,KEY,VALUE))
+
+id type_sexp(id tipe){
+    CXType cxtype=unbox_type(tipe);
+    int kind=cxtype.kind;
+    id result=list(3,typeSymbol(kind),
+                   KW(kind-spelling),cxstring(clang_getTypeKindSpelling(kind)));
+    if(clang_isConstQualifiedType(cxtype)){
+        NCONCF2(result,KW(const),t);}
+    if(clang_isVolatileQualifiedType(cxtype)){
+        NCONCF2(result,KW(volatile),t);}
+    if(clang_isRestrictQualifiedType(cxtype)){
+        NCONCF2(result,KW(restrict),t);}
+    if(clang_isPODType(cxtype)){
+        NCONCF2(result,KW(pod-type),t);}
+    CXType canonicalType=clang_getCanonicalType(cxtype);
+    if(CXType_Invalid!=canonicalType.kind){
+        NCONCF2(result,KW(canonical-type),type(canonicalType));}
+    CXCursor declaration=clang_getTypeDeclaration(cxtype);
+    if(not(clang_Cursor_isNull(declaration))){
+        NCONCF2(result,KW(declaration),cursor(declaration));}
+    CXType elementType=clang_getElementType(cxtype);
+    if(CXType_Invalid!=elementType.kind){
+        NCONCF2(result,KW(element-type),type(elementType));}
+    long long numElems=clang_getNumElements(cxtype);
+    if(0<=numElems){
+        NCONCF2(result,KW(number-of-elements),integer(numElems));}
+    CXType arrayElementType=clang_getArrayElementType(cxtype);
+    if(CXType_Invalid!=arrayElementType.kind){
+        NCONCF2(result,KW(array-element-type),type(arrayElementType));}
+    long long arraySize=clang_getArraySize(cxtype);
+    if(0<=arraySize){
+        NCONCF2(result,KW(array-size),integer(arraySize));}
+    CXType pointee=clang_getPointeeType(cxtype);
+    if(CXType_Invalid!=pointee.kind){
+        NCONCF2(result,KW(pointee),type(pointee));}
+    enum CXCallingConv callingConv=clang_getFunctionTypeCallingConv(cxtype);
+    if(CXCallingConv_Invalid!=callingConv){
+        NCONCF2(result,KW(calling-convention),callingConvention(callingConv));}
+    CXType resultType=clang_getResultType(cxtype);
+    if(CXType_Invalid!=resultType.kind){
+        NCONCF2(result,KW(result-type),type(resultType));}
+    int numArgs=clang_getNumArgTypes(cxtype);
+    if(0<=numArgs){
+        id arguments=nil;
+        DOTIMES(i,numArgs,
+                { PUSH(type(clang_getArgType(cxtype,i)),arguments); });
+        NCONCF2(result,KW(arguments),cons(SY(list),nreverse(arguments)));}
+    if(clang_isFunctionTypeVariadic(cxtype)){
+        NCONCF2(result,KW(variadic),t);}
+    return(result);}

+id token_sexp(id token){
+    return(nil);}

-/* typedef void (*visit_once_cursors_function)(id ident_number,id label,id cxcursor,id parent,void* function_closure); */
-/* typedef struct { */
-/*     id                          visited; // maps cursors to (#n# visited-0/1 …) */
-/*     visit_once_cursors_function prefix; */
-/*     visit_once_cursors_function function; */
-/*     visit_once_cursors_function suffix; */
-/*     void*                       function_closure; */
-/* } visit_once_cursors_closure; */
+id translation_unit_sexp(id tu){
+    return(nil);}

-typedef struct {
-    visit_once_cursors_closure vocc;
-    int margin;
-    bool first;
-} print_cursor_visitor_closure;
-
-void print_cursor_visitor_prefix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
-}
-
-void print_cursor_visitor_infix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
-}
-
-void print_cursor_visitor_suffix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
-}
-
-/* { */
-/* print_cursor_visitor_closure closure; */
-/* closure.vocc.visited=cursors; */
-/* closure.vocc.prefix=print_cursor_visitor_prefix; */
-/* closure.vocc.function=print_cursor_visitor_infix; */
-/* closure.vocc.suffix=print_cursor_visitor_suffix; */
-/* closure.vocc.function_closure=&closure; */
-/* closure.margin=0; */
-/* closure.first=false; */
-/* } */
-
-
-/* enum CXChildVisitResult print_cursor_visitor(CXCursor cursor,CXCursor parent,CXClientData client_data){ */
-/*     margin_closure* mc=client_data; */
-/*     if(mc->first){ */
-/*         mc->first=false; */
-/*     }else{ */
-/*         newline(mc->margin); */
-/*     } */
-/*     print_cursor(cursor,mc->margin); */
-/*     return(CXChildVisit_Continue);}  */
-
-
-
-void print_slots(CXCursor cxcursor,int kind,int margin){
-    print_flag(margin,":is-declaration",clang_isDeclaration(kind));
-    print_flag(margin,":is-reference",clang_isReference(kind));
-    print_flag(margin,":is-expression",clang_isExpression(kind));
-    print_flag(margin,":is-statement",clang_isStatement(kind));
-    print_flag(margin,":is-attribute",clang_isAttribute(kind));
-    print_flag(margin,":is-invaild",clang_isInvalid(kind));
-    print_flag(margin,":is-translation-unit",clang_isTranslationUnit(kind));
-    print_flag(margin,":is-preprocessing",clang_isPreprocessing(kind));
-    print_flag(margin,":is-unexposed",clang_isUnexposed(kind));
-    newline(margin);printf(" :linkage %s",cursorLinkage(clang_getCursorLinkage(cxcursor)));
-
-    /* clang_getCursorPlatformAvailability(CXCursor cursor, */
-    /*                                     int *always_deprecated, */
-    /*                                     CXString *deprecated_message, */
-    /*                                     int *always_unavailable, */
-    /*                                     CXString *unavailable_message, */
-    /*                                     CXPlatformAvailability *availability, */
-    /*                                     int availability_size) */
-    /* newline(margin);printf(" :availability %s",cursorAvailability(clang_getCursorAvailability(cxcursor))); */
-
-    /* clang_disposeCXPlatformAvailability(CXPlatformAvailability *availability); */
-
-    newline(margin);printf(" :language %s",cursorLanguageKind(clang_getCursorLanguage(cxcursor)));
-
-    if(not(null(cursors))){
-
-        CXTranslationUnit tu=clang_Cursor_getTranslationUnit(cxcursor);
+id cursor_sexp(id object){
+    CXCursor cxcursor=unbox_cursor(object);
+    if(clang_Cursor_isNull(cxcursor)){
+        return(nil);}
+    int kind=clang_getCursorKind(cxcursor);
+    if((CXCursor_FirstInvalid<=kind) and (kind<=CXCursor_LastInvalid)){
+        return(cons(cursorSymbol(kind),nil));}
+    id result=list(29,cursorSymbol(kind),
+                   KW(spelling),cxstring(clang_getCursorSpelling(cxcursor)),
+                   KW(usr),cxstring(clang_getCursorUSR(cxcursor)),
+                   KW(is-declaration),boolean(clang_isDeclaration(kind)),
+                   KW(is-reference),boolean(clang_isReference(kind)),
+                   KW(is-expression),boolean(clang_isExpression(kind)),
+                   KW(is-statement),boolean(clang_isStatement(kind)),
+                   KW(is-attribute),boolean(clang_isAttribute(kind)),
+                   KW(is-invalid),boolean(clang_isInvalid(kind)),
+                   KW(is-translation-unit),boolean(clang_isTranslationUnit(kind)),
+                   KW(is-preprocessing),boolean(clang_isPreprocessing(kind)),
+                   KW(is-unexposed),boolean(clang_isUnexposed(kind)),
+                   KW(linkage),cursorLinkage(clang_getCursorLinkage(cxcursor)),
+                   KW(platform-availability),platform_availability(cxcursor),
+                   KW(language),cursorLanguageKind(clang_getCursorLanguage(cxcursor)));
+    CXTranslationUnit tu=clang_Cursor_getTranslationUnit(cxcursor);
+    if(not(null(tu))){
         CXCursor tucursor=clang_getTranslationUnitCursor(tu);
-        newline(margin);
-        printf(" :translation-unit ");
-        print_cursor(tucursor,margin+19);
-
-        CXCursor separent=clang_getCursorSemanticParent(cxcursor);
-        newline(margin);
-        printf(" :semantic-parent ");
-        print_cursor(separent,margin+18);
-
-        CXCursor leparent=clang_getCursorLexicalParent(cxcursor);
-        newline(margin);
-        printf(" :lexical-parent ");
-        print_cursor(leparent,margin+17);
-    }
+        if(not(clang_Cursor_isNull(tucursor))){
+            NCONCF2(result,KW(translation-unit),cursor(tucursor));}}
+    CXCursor separent=clang_getCursorSemanticParent(cxcursor);
+    if(not(clang_Cursor_isNull(separent))){
+        NCONCF2(result,KW(semantic-parent),cursor(separent));}
+    CXCursor leparent=clang_getCursorLexicalParent(cxcursor);
+    if(not(clang_Cursor_isNull(leparent))){
+        NCONCF2(result,KW(lexical-parent),cursor(leparent));}
     // clang_getOverriddenCursors(cxcursor,&overridden,&num_overridden);
     // clang_disposeOverriddenCursors(overridden);
     CXFile includedFile=clang_getIncludedFile(cxcursor);
     if(includedFile){
-        newline(margin);
-        printf(" :included-file ");
-        print_cxstring(clang_getFileName(includedFile));
-    }
-
-
-    newline(margin); printf(" :location ");
-    print_location(clang_getCursorLocation(cxcursor));
-    newline(margin); printf(" :range ");
-    print_range(clang_getCursorExtent(cxcursor),margin+8);
-
-    // clang_getCanonicalType(CXType T)
-
-    CXType type=clang_getCursorType(cxcursor);
-    if(CXType_Invalid!=type.kind){
-        newline(margin); printf(" :type %s",cursorType(type.kind));}
-
+        NCONCF2(result,KW(included-file),cxstring(clang_getFileName(includedFile)));}
+    NCONCF(result,list(4,
+                       KW(location),location(clang_getCursorLocation(cxcursor)),
+                       KW(range),range(clang_getCursorExtent(cxcursor))));
+    if(clang_isDeclaration(kind)){
+        NCONCF2(result,KW(objc-type-encoding),cxstring(clang_getDeclObjCTypeEncoding(cxcursor)));}
+    CXType tipe=clang_getCursorType(cxcursor);
+    if(CXType_Invalid!=tipe.kind){
+        NCONCF(result,list(2,KW(type),type(tipe)));}
     CXType underType=clang_getTypedefDeclUnderlyingType(cxcursor);
-    if(CXType_Invalid!=type.kind){
-        newline(margin); printf(" :underlying-type %s",cursorType(underType.kind));}
-
+    if(CXType_Invalid!=underType.kind){
+        NCONCF(result,list(2,KW(underlying-type),type(underType)));}
     CXType enumType=clang_getEnumDeclIntegerType(cxcursor);
-    if(CXType_Invalid!=type.kind){
-        newline(margin); printf(" :enum-type %s",cursorType(enumType.kind));}
-
-
-    long long enumConstant=clang_getEnumConstantDeclValue(cxcursor);
-    if(CXType_Invalid!=type.kind){
-        newline(margin); printf(" :enum-constant %lld",enumConstant);}
-
-    unsigned long long uEnumConstant=clang_getEnumConstantDeclUnsignedValue(cxcursor);
-    if(CXType_Invalid!=type.kind){
-        newline(margin); printf(" :unsigned-enum-constant %llu",uEnumConstant);}
-
+    if(CXType_Invalid!=enumType.kind){
+        NCONCF(result,list(2,KW(enum-type),type(enumType)));
+        switch(enumType.kind){
+          case CXType_Char_U:
+          case CXType_UChar:
+          case CXType_UShort:
+          case CXType_UInt:
+          case CXType_ULong:
+          case CXType_ULongLong:
+          case CXType_UInt128:{
+              unsigned long long uEnumConstant=clang_getEnumConstantDeclUnsignedValue(cxcursor);
+              NCONCF(result,list(2,KW(unsigned-enum-constant),integer(uEnumConstant)));
+              break;}
+          default:{
+              long long enumConstant=clang_getEnumConstantDeclValue(cxcursor);
+              NCONCF2(result,KW(enum-constant),integer(enumConstant));
+              break;}}}
+    // Not declared:
     /* int fieldBitWidth=clang_getFieldDeclBitWidth(cxcursor); */
     /* if(0<=fieldBitWidth){ */
-    /*    newline(margin); printf(" :field-bit-width %d",fieldBitWidth);} */
-
+    /*     NCONCF2(result,KW(field-bit-width),integer(fieldBitWidth));} */
+    CXType outletType=clang_getIBOutletCollectionType(cxcursor);
+    if(CXType_Invalid!=outletType.kind){
+        NCONCF2(result,KW(outletType),type(outletType));}
+    CXType resultType=clang_getCursorResultType(cxcursor);
+    if(CXType_Invalid!=resultType.kind){
+        NCONCF2(result,KW(result-type),type(resultType));}
     int numArguments=clang_Cursor_getNumArguments(cxcursor);
     if(0<=numArguments){
-       newline(margin); printf(" :number-of-arguments %d",numArguments);
-       newline(margin); printf(" :arguments (");
-       for(int i=0;i<numArguments;i++){
-           CXCursor arg=clang_Cursor_getArgument(cxcursor,i);
-           if(0<i){newline(margin+13);}
-           print_cursor(arg,margin+13);}
-       printf(")");}
-
-    int as=clang_getCXXAccessSpecifier(cxcursor);
-    if(CX_CXXInvalidAccessSpecifier!=as){
-        newline(margin); printf(" :access-specifier %s",accessSpecifier(as));}
-
+        id args=nil;
+        for(int i=0;i<numArguments;INCF(i)){
+            PUSH(cursor(clang_Cursor_getArgument(cxcursor,i)),args);}
+        NCONCF(result,list(2,KW(arguments),cons(SY(list),nreverse(args))));}
     unsigned numOver=clang_getNumOverloadedDecls(cxcursor);
-    for(unsigned i=0;i<numOver;i++){
-       newline(margin); printf(" :number-of-overloaded-declarations %d",numOver);
-       newline(margin); printf(" :overloaded-declarations (");
-       for(int i=0;i<numOver;i++){
-           CXCursor arg=clang_getOverloadedDecl(cxcursor,i);
-           if(0<i){newline(margin+27);}
-           print_cursor(arg,margin+27);}
-       printf(")");}
-
-    // CXType clang_getIBOutletCollectionType(CXCursor);
-
+    if(0<numOver){
+        id overdecls=nil;
+        for(unsigned i=0;i<numOver;INCF(i)){
+            PUSH(cursor(clang_getOverloadedDecl(cxcursor,i)),overdecls);}
+        NCONCF2(result,KW(overloaded-declarations),cons(SY(list),overdecls));}
     // CXString clang_getCursorUSR(CXCursor);
     // CXString clang_constructUSR_ObjCClass(const char *class_name);
     // CXString clang_constructUSR_ObjCCategory(const char *class_name,const char *category_name);
     // CXString clang_constructUSR_ObjCProtocol(const char *protocol_name);
     // CXString clang_constructUSR_ObjCIvar(const char *name,CXString classUSR);
     // CXString clang_constructUSR_ObjCMethod(const char *name,unsigned isInstanceMethod,CXString classUSR);
-
-
-    // clang_getCursorReferenced() to determine whether a
-    // particular cursor refers to another entity.
-
+    CXCursor referenced=clang_getCursorReferenced(cxcursor);
+    if(not(clang_Cursor_isNull(referenced))){
+        NCONCF(result,list(2,KW(referenced),cursor(referenced)));}
+    NCONCF(result,list(2,KW(is-definition),boolean(clang_isCursorDefinition(cxcursor))));
     CXCursor definition=clang_getCursorDefinition(cxcursor);
     if(not(clang_Cursor_isNull(definition))){
-        newline(margin);printf(" :definition ");
-        print_cursor(definition,margin+13);}
-
-    print_flag(margin,":is-definition",clang_isCursorDefinition(cxcursor));
-
+        NCONCF(result,list(2,KW(definition),cursor(definition)));}
     CXCursor canonical=clang_getCanonicalCursor(cxcursor);
     if(not(clang_Cursor_isNull(canonical))){
-        newline(margin);printf(" :canonical ");
-        print_cursor(canonical,margin+13);}
-
-    newline(margin);
-    printf(" :children (");
-    /* margin_closure mc; */
-    /* mc.first=true; */
-    /* mc.margin=margin+12; */
-    /* clang_visitChildren(cxcursor,print_cursor_visitor,&mc); */
-    printf(")");
-
-    cursor_printer(kind)(cxcursor,margin+1);}
-
-
-void print_cursor(CXCursor cxcursor,int margin){
-    if(clang_Cursor_isNull(cxcursor)){
-        printf("nil");
-    }else{
-        id pair=hashtable_get(cursors,cursor(cxcursor));
-        if(null(pair)){
-            int kind=clang_getCursorKind(cxcursor);
-            printf("(%s",cursorSymbol(kind));
-            print_slots(cxcursor,kind,margin+1);
-            printf(")");
-        }else if(integerp(second(pair)) and (1==unbox_integer(second(pair)))){
-            printf("#%d#",unbox_integer(car(pair)));
-        }else{
-            int kind=clang_getCursorKind(cxcursor);
-            printf("#%d=(%s",unbox_integer(first(pair)),cursorSymbol(kind));
-            setcar(second(pair),integer(1));
-            print_slots(cxcursor,kind,margin+4);//TODO: width of #nn=
-            printf(")");}}}
-
-
-void print_registered_cursor(id cursor,id pair,void* data){
-    printf("\n#%d=",unbox_integer(car(pair)));
-    print_cursor(unbox_cursor(cursor),0);}
-
+        NCONCF(result,list(2,KW(canonical),cursor(canonical)));}
+    NCONCF(result,list(2,KW(children),cursor_children(cursor(cxcursor))));
+    if(CXCursor_CXXAccessSpecifier==kind){
+        if(clang_isVirtualBase(cxcursor)){
+            NCONCF2(result,KW(virtual-base),t);}}
+    if((CXCursor_CXXBaseSpecifier==kind) or (CXCursor_CXXAccessSpecifier==kind)){
+        NCONCF2(result,KW(access-specifier),accessSpecifier(clang_getCXXAccessSpecifier(cxcursor)));}
+    return(result);}

+id cxobjects_in_sexp(id sexp){
+    switch(type_of(sexp)){
+      case ot_CXCursor: // fall thru
+      case ot_CXType:
+      case ot_CXToken:
+      case ot_CXTranslationUnit:
+          return(cons(sexp,nil));
+      case ot_cons:
+          return(nconc(2,
+                       cxobjects_in_sexp(car(sexp)),
+                       cxobjects_in_sexp(cdr(sexp))));
+      case ot_vector:
+          if(ot_t==vector_element_type(sexp)){
+              id result=nil;
+              DOTIMES(i,length(sexp),
+                      { NCONCF(result,cxobjects_in_sexp(vector_get(sexp,i))); });
+              return(result);}
+          else{
+              return(nil);}
+      default:
+          return(nil);}}
+
+id compute_cxobjects_sexp(id cxobject,id table){
+    id sexp=nil;
+    switch(type_of(cxobject)){
+      case ot_CXCursor:          sexp=cursor_sexp(cxobject);           break;
+      case ot_CXType:            sexp=type_sexp(cxobject);             break;
+      case ot_CXToken:           sexp=token_sexp(cxobject);            break;
+      case ot_CXTranslationUnit: sexp=translation_unit_sexp(cxobject); break;
+      default: ERROR("Unexpected object of type %s, instead of a CX object.",
+                     type_name(type_of(cxobject)));}
+    hashtable_set(table,cxobject,list(2,integer(hashtable_count(table)),sexp));
+    DOLIST(child,cxobjects_in_sexp(sexp),
+           {if(not(hashtable_get(table,child))){
+                   compute_cxobjects_sexp(child,table);}});
+    return(table);}
+
+id cxobject_sexps(id root){
+    // returns a hashtable mapping cursors to lists: (ident sexp).
+    return(compute_cxobjects_sexp(root,make_hashtable(10000)));}


-typedef struct {
-    visit_once_cursors_closure vocc;
-    id linkedCursors;
-    id current;
-} collect_cursors_visitor_closure;
-
-void collect_cursor_visitor_prefix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
-    collect_cursors_visitor_closure* closure=function_closure;
-    closure->current=nil;}
-
-void collect_cursor_visitor_infix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
-    collect_cursors_visitor_closure* closure=function_closure;
-    PUSH2(label,cxcursor,closure->current);}
-
-void collect_cursor_visitor_suffix(id ident_number,id label,id cxcursor,id parent,void* function_closure){
-    collect_cursors_visitor_closure* closure=function_closure;
-    PUSH(cxcursor,closure->current);
-    PUSH(closure->current,closure->linkedCursors);}
-
-
-enum CXChildVisitResult visit_cursor_collect_children(CXCursor cxcursor,CXCursor parent,CXClientData client_data){
-    // Collects the linked and children CXCursors.
-    visit_once_cursors_closure* closure=client_data;
-    id visited=closure->visited;
-    id linkedCursors=nil;
-
-    id c=box(ot_CXCursor,cxcursor);
-    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(cxcursor));
-    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(unbox_cursor(c)));
-    id n=hashtable_get(visited,c);
-    if(null(n)){
-        id entry=list(3,integer(hashtable_count(visited)),integer(0),nil);
-        hashtable_set(visited,c,entry);
-
-        CXTranslationUnit tu=clang_Cursor_getTranslationUnit(cxcursor);
-        CXCursor tucursor=clang_getTranslationUnitCursor(tu);
-        if(not(clang_Cursor_isNull(tucursor))){
-            PUSH2(string(":translation-unit"),cursor(tucursor),linkedCursors);}
-
-        CXCursor separent=clang_getCursorSemanticParent(cxcursor);
-        if(not(clang_Cursor_isNull(separent))){
-            PUSH2(string(":semantic-parent"),cursor(separent),linkedCursors);}
-
-        CXCursor leparent=clang_getCursorLexicalParent(cxcursor);
-        if(not(clang_Cursor_isNull(leparent))){
-            PUSH2(string(":lexical-parent"),cursor(leparent),linkedCursors);}
-
-        // clang_getOverriddenCursors(cxcursor,&overridden,&num_overridden);
-        // clang_disposeOverriddenCursors(overridden);
-
-
-        /* CXType type=clang_getCursorType(cxcursor); */
-        /* if(CXType_Invalid!=type.kind){ */
-        /*     newline(margin); printf(" :type %s",cursorType(type.kind));} */
-        /*  */
-        /* CXType underType=clang_getTypedefDeclUnderlyingType(cxcursor); */
-        /* if(CXType_Invalid!=type.kind){ */
-        /*     newline(margin); printf(" :underlying-type %s",cursorType(underType.kind));} */
-        /*  */
-        /* CXType enumType=clang_getEnumDeclIntegerType(cxcursor); */
-        /* if(CXType_Invalid!=type.kind){ */
-        /*     newline(margin); printf(" :enum-type %s",cursorType(enumType.kind));} */
-
-
-
-        int numArguments=clang_Cursor_getNumArguments(cxcursor);
-        if(0<=numArguments){
-            id arguments=nil;
-            for(int i=0;i<numArguments;i++){
-                PUSH(cursor(clang_Cursor_getArgument(cxcursor,i)),arguments);}
-            PUSH2(string(":arguments"),arguments,linkedCursors);}
-
-        unsigned numOver=clang_getNumOverloadedDecls(cxcursor);
-        if(0<numOver){
-            id odecls=nil;
-            for(int i=0;i<numOver;i++){
-                PUSH(cursor(clang_getOverloadedDecl(cxcursor,i)),odecls);}
-            PUSH2(string(":overloaded-declarations"),odecls,linkedCursors);}
-
-        CXCursor definition=clang_getCursorDefinition(cxcursor);
-        if(not(clang_Cursor_isNull(definition))){
-            PUSH2(string(":definition"),cursor(definition),linkedCursors);}
-
-        CXCursor canonical=clang_getCanonicalCursor(cxcursor);
-        if(not(clang_Cursor_isNull(canonical))){
-            PUSH2(string(":canonical"),cursor(canonical),linkedCursors);}
+void test_all(void);

-
-        /* visit_once_cursors_closure children_closure; */
-        /* children_closure.visited=visited; */
-        /* children_closure.linkedCursors=nil; */
-        /* clang_visitChildren(cxcursor,visit_cursor_collect_children,&children_closure); */
-        /* PUSH2(string(":children"),children_closure.linkedCursors,linkedCursors); */
-        /*  */
-        /* closure->linkedCursors=linkedCursors; */
-        setcar(nthcdr(2,entry),linkedCursors);}
-    return CXChildVisit_Continue;}

+id replace_cxobject_references(id sexp,id table){
+    switch(type_of(sexp)){
+      case ot_CXCursor:
+          return(list(2,SY(cxcursor),first(hashtable_get(table,sexp))));
+      case ot_CXType:
+          return(list(2,SY(cxtype),first(hashtable_get(table,sexp))));
+      case ot_CXToken:
+          return(list(2,SY(cxtoken),first(hashtable_get(table,sexp))));
+      case ot_CXTranslationUnit:
+          return(list(2,SY(cxtranslationunit),first(hashtable_get(table,sexp))));
+      case ot_cons:
+          return(cons(replace_cxobject_references(car(sexp),table),
+                      replace_cxobject_references(cdr(sexp),table)));
+      case ot_vector:
+          if(ot_t==vector_element_type(sexp)){
+              int len=length(sexp);
+              id result=make_vector(ot_t,len,len,0);
+              DOTIMES(i,len,{vector_set(result,i,replace_cxobject_references(vector_get(sexp,i),table));});
+              return(result);}
+          else{
+              return(sexp);}
+      default: return(sexp);}}
+
+void print_cursor_sexp(id key,id value,void* data){
+    id table=data;
+    print(replace_cxobject_references(value,table),nil);}

+void add_token_to_cursor(id key,id value,void* data){
+    id tucu;
+    CXSourceRange srange=clang_getCursorExtent(unbox_cursor(key));
+    if(not(clang_Range_isNull(srange))){
+
+    }}

-// PUSH2(string(":usr"),cxstring(clang_getCursorUSR(cxcursor)),cxdata);
-
-// CXType clang_getIBOutletCollectionType(CXCursor);
-
-//
-// CXString clang_constructUSR_ObjCClass(const char *class_name);
-// CXString clang_constructUSR_ObjCCategory(const char *class_name,const char *category_name);
-// CXString clang_constructUSR_ObjCProtocol(const char *protocol_name);
-// CXString clang_constructUSR_ObjCIvar(const char *name,CXString classUSR);
-// CXString clang_constructUSR_ObjCMethod(const char *name,unsigned isInstanceMethod,CXString classUSR);
-
-
-// clang_getCursorReferenced() to determine whether a
-// particular cursor refers to another entity.
-
-
-
-/* void register_cursors(hashtable* cursors,CXCursor rootCursor){ */
-/*     visit_cursor_closure closure; */
-/*     closure.visited=cursors; */
-/*     closure.linkedCursors=nil; */
-/*     visit_cursor_collect_children(rootCursor,clang_getNullCursor(),&closure);} */
-/*  */
-/* typedef struct{ */
-/*     bool present; */
-/*     int counter; */
-/*     CXCursor cxcursor; */
-/* } present_closure; */
-/*  */
-/* void record_cursor_present(id key,id value,void* data){ */
-/*     present_closure* closure=data; */
-/*     assert(ot_CXCursor==type_of(key)); */
-/*     INCF(closure->counter); */
-/*     bool areEqual=clang_equalCursors(unbox_cursor(key),closure->cxcursor); */
-/*     /\* printf("\n%s\n",areEqual?"EQUAL":"-"); *\/ */
-/*     /\* printf("key %5d %5d %20p %20p %20p\n",key->value.cursor.kind,key->value.cursor.xdata,key->value.cursor.data[0],key->value.cursor.data[1],key->value.cursor.data[2]); *\/ */
-/*     /\* printf("cur %5d %5d %20p %20p %20p\n",closure->cxcursor.kind,closure->cxcursor.xdata,closure->cxcursor.data[0],closure->cxcursor.data[1],closure->cxcursor.data[2]); *\/ */
-/*     if(clang_equalCursors(unbox_cursor(key),closure->cxcursor)){ */
-/*         assert(clang_hashCursor(unbox_cursor(key))==clang_hashCursor(closure->cxcursor)); */
-/*         closure->present=true;}} */
-/*  */
-/* void check_cursor_present(hashtable* cursors,CXCursor cxcursor){ */
-/*     present_closure closure; */
-/*     closure.present=false; */
-/*     closure.counter=0; */
-/*     closure.cxcursor=cxcursor; */
-/*     assert(0<hashtable_count(cursors)); */
-/*     hashtable_map(cursors,record_cursor_present,&closure); */
-/*     /\* printf("counter=%d\n",closure.counter); *\/ */
-/*     assert(0<closure.counter); */
-/*     assert(closure.present);} */


-void test_all(void);


 int main(int argc,const char* const* argv){
+    initialize();
+    print_circle=t;
     const char* pname=argv[0];
     id args=argv_to_list(argv);
     POP(args);
@@ -2476,6 +2333,9 @@ int main(int argc,const char* const* argv){
         test_all();
         if(null(args)){
             exit(0);}}
+    else if(equal(first(args),string("--help"))){
+        printf("%s usage\n",pname);
+        printf("%s --help | --test | sourcefile.c {clang options}\n",pname);}
     if(null(args)){
         ERROR("Command %s is missing a source file argument.",pname);
         return(1);}
@@ -2484,22 +2344,19 @@ int main(int argc,const char* const* argv){
     const char* const* subArgv=list_to_argv(append(2,includes,args));
     int subArgc=argv_count(subArgv);
     CXIndex idx=clang_createIndex(0,1);
-    cursors=make_hashtable(10000);
     CXTranslationUnit tu=clang_createTranslationUnitFromSourceFile(idx,sourceFile,subArgc,subArgv,0,0);
     if(0==tu){
-        fprintf(stderr,"%s: cannot create the translation unit.",pname);
-        return(1);}
+        ERROR("%s: cannot create the translation unit.",pname);}
     CXCursor tucursor=clang_getTranslationUnitCursor(tu);
-    // register_cursors(cursors,tucursor);
-    // check_cursor_present(cursors,tucursor);
-    /* hashtable_map(cursors,print_registered_cursor,0); */
-    /* printf("\n"); */
-
-    // print_cursor(clang_getTranslationUnitCursor(tu),0);
-
-    printf("\n");
+    id tucu=cursor(tucursor);
+    id table=cxobject_sexps(tucu);
+    princ(string(";; -*- mode:lisp;coding:iso-8859-1 -*-"),nil); terpri(nil);
+    prin1(list(2,SY(cxcursor),first(hashtable_get(table,tucu))),nil);
+    hashtable_map(table,print_cursor_sexp,table);
+    terpri(nil);
+    terpri(nil);
+    fflush(stdout);
     clang_disposeTranslationUnit(tu);
-
     return(0);}


@@ -2520,170 +2377,186 @@ int test_primes[]={
     839, 853, 857, 859, 863, 877, 881, 883, 887, 907, 911, 919, 929, 937,
     941, 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, 1019, 1021};

-#define testing(BODY)                                                   \
+
+int test_count=0;
+int test_success=0;
+int test_failure=0;
+
+#define TEST_BEGIN()                                                    \
     do{                                                                 \
+        INCF(test_count);                                               \
         printf("%-40s ",__FUNCTION__);                                  \
         fflush(stdout);                                                 \
-        { BODY }                                                        \
-          printf(" [OK]\n");                                            \
-          fflush(stdout);                                               \
-    } while(0)
+    }while(0)

+void SUCCESS(const char* fname){
+    INCF(test_success);
+    printf("\r%-40s [OK]\n",fname);}

-void test_compute_primes_to(void){
-    testing({
-                 int count=sizeof(test_primes)/sizeof(test_primes[0]);
-                 id primes=compute_primes_to(1024);
-                 assert(vector_length(primes)==count);
-                 for(int i=0;i<count;i++){
-                     assert(vector_get_int(primes,i)==test_primes[i]);}
-             });}
+void FAILURE(const char* fname){
+    INCF(test_failure);
+    printf("\r%-40s [KO]\n",fname);}

+void TOTALS(const char* fname){
+    DECF(test_count);
+    printf("\r%-40s     %4d success",fname,test_success);
+    printf("\n%-40s     %4d failure",fname,test_failure);
+    printf("\n%-40s     %4d total",fname,test_count);
+    printf("\n%-40s [%s]\n",fname,(0==test_failure)?"OK":"KO");}

-void test_ceiling_to_nearest_prime(void){
-    testing({
-                 int count=sizeof(test_primes)/sizeof(test_primes[0]);
-                 for(int i=1;i<count;i++){
-                     int n=test_primes[i]-1;
-                     int ceiling=ceiling_to_nearest_prime(n);
-                     unless_assert(ceiling==test_primes[i],fprintf(stderr,"n=%d, expected=%d, got=%d\n",n,test_primes[i],ceiling););}
-             });}
+#define TEST_END(HOW)                                                   \
+    do{                                                                 \
+       HOW(__FUNCTION__);                                               \
+       fflush(stdout);                                                  \
+    }while(0)

+void test_compute_primes_to(void){
+    TEST_BEGIN();
+    int count=sizeof(test_primes)/sizeof(test_primes[0]);
+    id primes=compute_primes_to(1024);
+    assert(vector_length(primes)==count);
+    for(int i=0;i<count;INCF(i)){
+        assert(vector_get_int(primes,i)==test_primes[i]);}
+    TEST_END(SUCCESS);}

+void test_ceiling_to_nearest_prime(void){
+    TEST_BEGIN();
+    int count=sizeof(test_primes)/sizeof(test_primes[0]);
+    for(int i=1;i<count;INCF(i)){
+        int n=test_primes[i]-1;
+        int ceiling=ceiling_to_nearest_prime(n);
+        unless_assert(ceiling==test_primes[i],fprintf(stderr,"n=%d, expected=%d, got=%d\n",n,test_primes[i],ceiling););}
+    TEST_END(SUCCESS);}
+
 void test_box(void){
-    testing({
-                 CXCursor c=clang_getNullCursor();
-                 id bc=box(ot_CXCursor,c);
-                 assert(ot_CXCursor==type_of(bc));
-                 assert(clang_Cursor_isNull(bc->value.cursor));
+    TEST_BEGIN();
+    CXCursor c=clang_getNullCursor();
+    id bc=box(ot_CXCursor,c);
+    assert(ot_CXCursor==type_of(bc));
+    assert(clang_Cursor_isNull(bc->value.cursor));

-                 id bi=box(ot_int,42);
-                 assert(ot_int==type_of(bi));
-                 assert(42==bi->value.integer);
-
-                 id bx=box(ot_char,'a');
-                 assert(ot_char==type_of(bx));
-                 assert('a'==bx->value.character);
-
-                 cons_t* k=make_cons_t(bi,bx);
-                 id bk=box(ot_cons,k);
-                 assert(ot_cons==type_of(bk));
-                 assert(k==bk->value.cons);
-
-                 vector_t* v=unbox_vector(make_vector(ot_int,4,0,0));
-                 id bv=box(ot_vector,v);
-                 assert(ot_vector==type_of(bv));
-                 assert(v==bv->value.vector);
+    id bi=box(ot_int,42);
+    assert(ot_int==type_of(bi));
+    assert(42==bi->value.integer);
+
+    id bx=box(ot_char,'a');
+    assert(ot_char==type_of(bx));
+    assert('a'==bx->value.character);
+
+    cons_t* k=make_cons_t(bi,bx);
+    id bk=box(ot_cons,k);
+    assert(ot_cons==type_of(bk));
+    assert(k==bk->value.cons);
+
+    vector_t* v=unbox_vector(make_vector(ot_int,4,0,0));
+    id bv=box(ot_vector,v);
+    assert(ot_vector==type_of(bv));
+    assert(v==bv->value.vector);

-                 hashtable* h=unbox_hashtable(make_hashtable(42));
-                 id bh=box(ot_hashtable,h);
-                 assert(ot_hashtable==type_of(bh));
-                 assert(h==bh->value.hashtable);
-             });}
-
-
+    hashtable_t* h=unbox_hashtable(make_hashtable(42));
+    id bh=box(ot_hashtable,h);
+    assert(ot_hashtable==type_of(bh));
+    assert(h==bh->value.hashtable);
+    TEST_END(SUCCESS);}

 void test_cons(void){
-    testing({
-                 assert(null(nil));
-
-                 id c=cons(integer(42),nil);
-                 assert(ot_cons==type_of(c));
-                 assert(ot_int==type_of(car(c)));
-                 assert(42==unbox_integer(car(c)));
-                 assert(null(cdr(c)));
-
-                 setcdr(c,character('B'));
-                 assert(ot_cons==type_of(c));
-                 assert(ot_int==type_of(car(c)));
-                 assert(42==unbox_integer(car(c)));
-                 assert(ot_char==type_of(cdr(c)));
-                 assert('B'==unbox_character(cdr(c)));
-
-                 id nc=cons(nil,nil);
-                 setcar(c,nc);
-                 assert(ot_cons==type_of(c));
-                 assert(nc==car(c));
-                 assert(ot_char==type_of(cdr(c)));
-                 assert('B'==unbox_character(cdr(c)));
-
-             });}
-
+    TEST_BEGIN();
+    assert(null(nil));
+    // cons
+    id c=cons(integer(42),nil);
+    assert(ot_cons==type_of(c));
+    assert(ot_int==type_of(car(c)));
+    assert(42==unbox_integer(car(c)));
+    assert(null(cdr(c)));
+    // setcdr
+    setcdr(c,character('B'));
+    assert(ot_cons==type_of(c));
+    assert(ot_int==type_of(car(c)));
+    assert(42==unbox_integer(car(c)));
+    assert(ot_char==type_of(cdr(c)));
+    assert('B'==unbox_character(cdr(c)));
+    // setcar
+    id nc=cons(nil,nil);
+    setcar(c,nc);
+    assert(ot_cons==type_of(c));
+    assert(nc==car(c));
+    assert(ot_char==type_of(cdr(c)));
+    assert('B'==unbox_character(cdr(c)));
+    TEST_END(SUCCESS);}

 void test_list(void){
-    testing({
-                 id l=list(0);
-                 assert(null(l));
-
-                 l=list(1,integer(42));
-                 assert(consp(l));
-                 assert(equal(integer(42),car(l)));
-                 assert(null(cdr(l)));
-
-                 l=list(2,integer(33),integer(42));
-                 assert(consp(l));
-                 assert(equal(integer(33),car(l)));
-                 assert(equal(integer(42),car(cdr(l))));
-                 assert(null(cdr(cdr(l))));
-
-                 l=list(3,integer(24),integer(33),integer(42));
-                 assert(consp(l));
-                 assert(equal(integer(24),car(l)));
-                 assert(equal(integer(33),car(cdr(l))));
-                 assert(equal(integer(42),car(cdr(cdr(l)))));
-                 assert(null(cdr(cdr(cdr(l)))));
-             });}
-
+    TEST_BEGIN();
+    // list 0
+    id l=list(0);
+    assert(null(l));
+    // list 1
+    l=list(1,integer(42));
+    assert(consp(l));
+    assert(equal(integer(42),car(l)));
+    assert(null(cdr(l)));
+    // list 2
+    l=list(2,integer(33),integer(42));
+    assert(consp(l));
+    assert(equal(integer(33),car(l)));
+    assert(equal(integer(42),car(cdr(l))));
+    assert(null(cdr(cdr(l))));
+    // list 3
+    l=list(3,integer(24),integer(33),integer(42));
+    assert(consp(l));
+    assert(equal(integer(24),car(l)));
+    assert(equal(integer(33),car(cdr(l))));
+    assert(equal(integer(42),car(cdr(cdr(l)))));
+    assert(null(cdr(cdr(cdr(l)))));
+    TEST_END(SUCCESS);}

 void test_reverse(void){
-    testing({
-                 id l=list(0);
-                 id r=reverse(l);
-                 assert(null(r));
-
-                 l=list(1,integer(42));
-                 r=reverse(l);
-                 assert(consp(r));
-                 assert(equal(integer(42),car(r)));
-                 assert(null(cdr(r)));
-                 assert(equal(l,r));
-
-                 l=list(2,integer(33),integer(42));
-                 r=reverse(l);
-                 assert(consp(r));
-                 assert(equal(integer(42),car(r)));
-                 assert(equal(integer(33),car(cdr(r))));
-                 assert(null(cdr(cdr(r))));
-
-                 l=list(3,integer(24),integer(33),integer(42));
-                 r=reverse(l);
-                 assert(consp(r));
-                 assert(equal(integer(42),car(r)));
-                 assert(equal(integer(33),car(cdr(r))));
-                 assert(equal(integer(24),car(cdr(cdr(r)))));
-                 assert(null(cdr(cdr(cdr(r)))));
-             });}
-
-
+    TEST_BEGIN();
+    // list 0
+    id l=list(0);
+    id r=reverse(l);
+    assert(null(r));
+    // list 1
+    l=list(1,integer(42));
+    r=reverse(l);
+    assert(consp(r));
+    assert(equal(integer(42),car(r)));
+    assert(null(cdr(r)));
+    assert(equal(l,r));
+    // list 2
+    l=list(2,integer(33),integer(42));
+    r=reverse(l);
+    assert(consp(r));
+    assert(equal(integer(42),car(r)));
+    assert(equal(integer(33),car(cdr(r))));
+    assert(null(cdr(cdr(r))));
+    // list 3
+    l=list(3,integer(24),integer(33),integer(42));
+    r=reverse(l);
+    assert(consp(r));
+    assert(equal(integer(42),car(r)));
+    assert(equal(integer(33),car(cdr(r))));
+    assert(equal(integer(24),car(cdr(cdr(r)))));
+    assert(null(cdr(cdr(cdr(r)))));
+    TEST_END(SUCCESS);}
+
 void test_revappend(void){
-    testing({
-                 id l=list(0);
-                 id t=list(2,integer(3),integer(4));
-                 id r=revappend(l,t);
-                 assert(equal(r,t));
-
-                 l=list(2,integer(2),integer(1));
-                 r=revappend(l,t);
-                 assert(consp(r));
-                 assert(equal(r,list(4,integer(1),integer(2),integer(3),integer(4))));
-
-                 l=list(3,integer(24),integer(33),integer(42));
-                 r=revappend(l,nil);
-                 assert(equal(r,reverse(l)));
-             });}
-
-
-
+    TEST_BEGIN();
+    // list 0,2
+    id l=list(0);
+    id z=list(2,integer(3),integer(4));
+    id r=revappend(l,z);
+    assert(equal(r,z));
+    // list 2,2
+    l=list(2,integer(2),integer(1));
+    r=revappend(l,z);
+    assert(consp(r));
+    assert(equal(r,list(4,integer(1),integer(2),integer(3),integer(4))));
+    // list 3,0
+    l=list(3,integer(24),integer(33),integer(42));
+    r=revappend(l,nil);
+    assert(equal(r,reverse(l)));
+    TEST_END(SUCCESS);}
+
 void dump_hashtable(id table){
     fprintf(stderr,"size             = %d\n",hashtable_size(table));
     fprintf(stderr,"count            = %d\n",hashtable_count(table));
@@ -2691,64 +2564,60 @@ void dump_hashtable(id table){
     fprintf(stderr,"rehash_threshold = %f\n",hashtable_rehash_threshold(table));}

 void test_hashtable(void){
-    testing({
-                 id table=make_hashtable(3);
-                 assert(0==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-             });}
-
+    TEST_BEGIN();
+    id table=make_hashtable(3);
+    assert(0==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    TEST_END(SUCCESS);}
+
 void test_hashtable_set_grow(void){
-    testing({
-                 id table=make_hashtable(3);
-                 assert(0==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-
-                 hashtable_set(table,integer(65),character('A'));
-                 assert(1==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-                 assert(equal(character('A'),hashtable_get(table,integer(65))));
-
-                 hashtable_set(table,integer(66),character('B'));
-                 assert(2==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-                 assert(equal(character('B'),hashtable_get(table,integer(66))));
-
-                 hashtable_set(table,integer(67),character('C'));
-                 assert(3==hashtable_count(table));
-                 assert(5==hashtable_size(table));
-                 assert(equal(character('C'),hashtable_get(table,integer(67))));
-
-             });}
-
+    TEST_BEGIN();
+    id table=make_hashtable(3);
+    assert(0==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    // hash 1
+    hashtable_set(table,integer(65),character('A'));
+    assert(1==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    assert(equal(character('A'),hashtable_get(table,integer(65))));
+    // hash 2
+    hashtable_set(table,integer(66),character('B'));
+    assert(2==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    assert(equal(character('B'),hashtable_get(table,integer(66))));
+    // hash 3
+    hashtable_set(table,integer(67),character('C'));
+    assert(3==hashtable_count(table));
+    assert(5==hashtable_size(table));
+    assert(equal(character('C'),hashtable_get(table,integer(67))));
+    TEST_END(SUCCESS);}

 void test_hashtable_reset(void){
-    testing({
-                 id table=make_hashtable(3);
-                 assert(0==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-
-                 hashtable_set(table,integer(65),character('A'));
-                 assert(1==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-                 assert(equal(character('A'),hashtable_get(table,integer(65))));
-
-                 hashtable_set(table,integer(66),character('B'));
-                 assert(2==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-                 assert(equal(character('B'),hashtable_get(table,integer(66))));
-
-                 hashtable_set(table,integer(65),character('Z'));
-                 assert(2==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-                 assert(equal(character('Z'),hashtable_get(table,integer(65))));
-
-                 hashtable_set(table,integer(66),character('Y'));
-                 assert(2==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-                 assert(equal(character('Y'),hashtable_get(table,integer(66))));
-
-             });}
-
+    TEST_BEGIN();
+    id table=make_hashtable(3);
+    assert(0==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    // hash 1
+    hashtable_set(table,integer(65),character('A'));
+    assert(1==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    assert(equal(character('A'),hashtable_get(table,integer(65))));
+    // hash 2
+    hashtable_set(table,integer(66),character('B'));
+    assert(2==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    assert(equal(character('B'),hashtable_get(table,integer(66))));
+    // hash 3
+    hashtable_set(table,integer(65),character('Z'));
+    assert(2==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    assert(equal(character('Z'),hashtable_get(table,integer(65))));
+    // hash 4
+    hashtable_set(table,integer(66),character('Y'));
+    assert(2==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    assert(equal(character('Y'),hashtable_get(table,integer(66))));
+    TEST_END(SUCCESS);}

 void test_hashtable_map_function(id key,id value,void* data){
     char* hits=data;
@@ -2758,23 +2627,21 @@ void test_hashtable_map_function(id key,id value,void* data){
     hits[unbox_integer(key)]=unbox_character(value);}

 void test_hashtable_map(void){
-    testing({
-                 id table=make_hashtable(3);
-                 assert(0==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-
-                 for(int i=65;i<95;i++){
-                     hashtable_set(table,integer(i),character(i));}
-                 char hits[128]={0};
-                 hashtable_map(table,test_hashtable_map_function,hits);
-                 for(int i=0;i<128;i++){
-                     if((i<65) or (95<=i)){
-                         assert(0==hits[i]);
-                     }else{
-                         assert(i==hits[i]);
-                     }}});}
-
-
+    TEST_BEGIN();
+    id table=make_hashtable(3);
+    assert(0==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    for(int i=65;i<95;INCF(i)){
+        hashtable_set(table,integer(i),character(i));}
+    char hits[128]={0};
+    hashtable_map(table,test_hashtable_map_function,hits);
+    for(int i=0;i<128;INCF(i)){
+        if((i<65) or (95<=i)){
+            assert(0==hits[i]);}
+        else{
+            assert(i==hits[i]);}}
+    TEST_END(SUCCESS);}
+
 void test_hashtable_remove_function(id key,id value,void* data){
     id table=data;
     assert(ot_int==type_of(key));
@@ -2789,38 +2656,284 @@ void test_hashtable_fail_function(id key,id value,void* data){
     assert(false);}

 void test_hashtable_remove(void){
-    testing({
-                 id table=make_hashtable(3);
-                 assert(0==hashtable_count(table));
-                 assert(3==hashtable_size(table));
-
-                 for(int i=65;i<95;i++){
-                     hashtable_set(table,integer(i),character(i));}
-
-                 int size=hashtable_size(table);
-                 hashtable_map(table,test_hashtable_remove_function,table);
-                 assert(hashtable_size(table)==size);
-                 assert(hashtable_count(table)==0);
-                 hashtable_map(table,test_hashtable_fail_function,0);});}
-
+    TEST_BEGIN();
+    id table=make_hashtable(3);
+    assert(0==hashtable_count(table));
+    assert(3==hashtable_size(table));
+    for(int i=65;i<95;INCF(i)){
+        hashtable_set(table,integer(i),character(i));}
+    int size=hashtable_size(table);
+    hashtable_map(table,test_hashtable_remove_function,table);
+    assert(hashtable_size(table)==size);
+    assert(hashtable_count(table)==0);
+    hashtable_map(table,test_hashtable_fail_function,0);
+    TEST_END(SUCCESS);}
+
+void test_equal(void){
+    TEST_BEGIN();
+    id a=integer(42);
+    id b=integer(42);
+    id c=integer(0);
+    id k=cons(integer(1),integer(2));
+    id l=cons(integer(1),integer(2));
+    id m=cons(integer(42),integer(0));
+    id u=vector(5,car(k),cdr(k),a,b,c);
+    id v=vector(5,car(k),cdr(k),a,b,c);
+    id w=vector(5,a,b,c,a,b);
+    id x=vector(6,a,b,c,a,b,c);
+    id h=make_hashtable(7);
+    hashtable_set(h,a,a);
+    hashtable_set(h,c,b);
+    id p=make_hashtable(3);
+    hashtable_set(h,a,t);
+    hashtable_set(h,c,t);
+    id q=make_hashtable(7);
+    hashtable_set(h,a,t);
+    hashtable_set(h,b,t);
+
+         /* (let* ((o '(nil a b c k l m u v w x h p q)) */
+         /*        (a 42) */
+         /*        (b 42) */
+         /*        (c 0) */
+         /*        (k (cons 1 2)) */
+         /*        (l (cons 1 2)) */
+         /*        (m (cons 42 0)) */
+         /*        (u (vector (car k) (cdr k) a b c)) */
+         /*        (v (vector (car k) (cdr k) a b c)) */
+         /*        (w (vector a b c a b)) */
+         /*        (x (vector a b c a b c)) */
+         /*        (h (make-hash-table)) */
+         /*        (p (make-hash-table)) */
+         /*        (q (make-hash-table))) */
+         /*   (declare (special a b c k l m u v w x h p q)) */
+         /*   (setf (gethash a h) a */
+         /*         (gethash c h) b */
+         /*         (gethash a p) t */
+         /*         (gethash c p) t */
+         /*         (gethash a q) t */
+         /*         (gethash b q) t) */
+         /*   (format t "*~(~)/~%") */
+         /*   (dolist (v1 o) */
+         /*     (dolist (v2 o) */
+         /*       (if (equal (symbol-value v1) (symbol-value v2)) */
+         /*           (format t"assert(equal(~a,~a));~%" v1 v2) */
+         /*           (format t "assert(not(equal(~a,~a)));~%" v2 v1))))) */
+
+    assert(equal(nil,nil));
+    assert(not(equal(a,nil)));
+    assert(not(equal(b,nil)));
+    assert(not(equal(c,nil)));
+    assert(not(equal(k,nil)));
+    assert(not(equal(l,nil)));
+    assert(not(equal(m,nil)));
+    assert(not(equal(u,nil)));
+    assert(not(equal(v,nil)));
+    assert(not(equal(w,nil)));
+    assert(not(equal(x,nil)));
+    assert(not(equal(h,nil)));
+    assert(not(equal(p,nil)));
+    assert(not(equal(q,nil)));
+    assert(not(equal(nil,a)));
+    assert(equal(a,a));
+    assert(equal(a,b));
+    assert(not(equal(c,a)));
+    assert(not(equal(k,a)));
+    assert(not(equal(l,a)));
+    assert(not(equal(m,a)));
+    assert(not(equal(u,a)));
+    assert(not(equal(v,a)));
+    assert(not(equal(w,a)));
+    assert(not(equal(x,a)));
+    assert(not(equal(h,a)));
+    assert(not(equal(p,a)));
+    assert(not(equal(q,a)));
+    assert(not(equal(nil,b)));
+    assert(equal(b,a));
+    assert(equal(b,b));
+    assert(not(equal(c,b)));
+    assert(not(equal(k,b)));
+    assert(not(equal(l,b)));
+    assert(not(equal(m,b)));
+    assert(not(equal(u,b)));
+    assert(not(equal(v,b)));
+    assert(not(equal(w,b)));
+    assert(not(equal(x,b)));
+    assert(not(equal(h,b)));
+    assert(not(equal(p,b)));
+    assert(not(equal(q,b)));
+    assert(not(equal(nil,c)));
+    assert(not(equal(a,c)));
+    assert(not(equal(b,c)));
+    assert(equal(c,c));
+    assert(not(equal(k,c)));
+    assert(not(equal(l,c)));
+    assert(not(equal(m,c)));
+    assert(not(equal(u,c)));
+    assert(not(equal(v,c)));
+    assert(not(equal(w,c)));
+    assert(not(equal(x,c)));
+    assert(not(equal(h,c)));
+    assert(not(equal(p,c)));
+    assert(not(equal(q,c)));
+    assert(not(equal(nil,k)));
+    assert(not(equal(a,k)));
+    assert(not(equal(b,k)));
+    assert(not(equal(c,k)));
+    assert(equal(k,k));
+    assert(equal(k,l));
+    assert(not(equal(m,k)));
+    assert(not(equal(u,k)));
+    assert(not(equal(v,k)));
+    assert(not(equal(w,k)));
+    assert(not(equal(x,k)));
+    assert(not(equal(h,k)));
+    assert(not(equal(p,k)));
+    assert(not(equal(q,k)));
+    assert(not(equal(nil,l)));
+    assert(not(equal(a,l)));
+    assert(not(equal(b,l)));
+    assert(not(equal(c,l)));
+    assert(equal(l,k));
+    assert(equal(l,l));
+    assert(not(equal(m,l)));
+    assert(not(equal(u,l)));
+    assert(not(equal(v,l)));
+    assert(not(equal(w,l)));
+    assert(not(equal(x,l)));
+    assert(not(equal(h,l)));
+    assert(not(equal(p,l)));
+    assert(not(equal(q,l)));
+    assert(not(equal(nil,m)));
+    assert(not(equal(a,m)));
+    assert(not(equal(b,m)));
+    assert(not(equal(c,m)));
+    assert(not(equal(k,m)));
+    assert(not(equal(l,m)));
+    assert(equal(m,m));
+    assert(not(equal(u,m)));
+    assert(not(equal(v,m)));
+    assert(not(equal(w,m)));
+    assert(not(equal(x,m)));
+    assert(not(equal(h,m)));
+    assert(not(equal(p,m)));
+    assert(not(equal(q,m)));
+    assert(not(equal(nil,u)));
+    assert(not(equal(a,u)));
+    assert(not(equal(b,u)));
+    assert(not(equal(c,u)));
+    assert(not(equal(k,u)));
+    assert(not(equal(l,u)));
+    assert(not(equal(m,u)));
+    assert(equal(u,u));
+    assert(not(equal(v,u)));
+    assert(not(equal(w,u)));
+    assert(not(equal(x,u)));
+    assert(not(equal(h,u)));
+    assert(not(equal(p,u)));
+    assert(not(equal(q,u)));
+    assert(not(equal(nil,v)));
+    assert(not(equal(a,v)));
+    assert(not(equal(b,v)));
+    assert(not(equal(c,v)));
+    assert(not(equal(k,v)));
+    assert(not(equal(l,v)));
+    assert(not(equal(m,v)));
+    assert(not(equal(u,v)));
+    assert(equal(v,v));
+    assert(not(equal(w,v)));
+    assert(not(equal(x,v)));
+    assert(not(equal(h,v)));
+    assert(not(equal(p,v)));
+    assert(not(equal(q,v)));
+    assert(not(equal(nil,w)));
+    assert(not(equal(a,w)));
+    assert(not(equal(b,w)));
+    assert(not(equal(c,w)));
+    assert(not(equal(k,w)));
+    assert(not(equal(l,w)));
+    assert(not(equal(m,w)));
+    assert(not(equal(u,w)));
+    assert(not(equal(v,w)));
+    assert(equal(w,w));
+    assert(not(equal(x,w)));
+    assert(not(equal(h,w)));
+    assert(not(equal(p,w)));
+    assert(not(equal(q,w)));
+    assert(not(equal(nil,x)));
+    assert(not(equal(a,x)));
+    assert(not(equal(b,x)));
+    assert(not(equal(c,x)));
+    assert(not(equal(k,x)));
+    assert(not(equal(l,x)));
+    assert(not(equal(m,x)));
+    assert(not(equal(u,x)));
+    assert(not(equal(v,x)));
+    assert(not(equal(w,x)));
+    assert(equal(x,x));
+    assert(not(equal(h,x)));
+    assert(not(equal(p,x)));
+    assert(not(equal(q,x)));
+    assert(not(equal(nil,h)));
+    assert(not(equal(a,h)));
+    assert(not(equal(b,h)));
+    assert(not(equal(c,h)));
+    assert(not(equal(k,h)));
+    assert(not(equal(l,h)));
+    assert(not(equal(m,h)));
+    assert(not(equal(u,h)));
+    assert(not(equal(v,h)));
+    assert(not(equal(w,h)));
+    assert(not(equal(x,h)));
+    assert(equal(h,h));
+    assert(not(equal(p,h)));
+    assert(not(equal(q,h)));
+    assert(not(equal(nil,p)));
+    assert(not(equal(a,p)));
+    assert(not(equal(b,p)));
+    assert(not(equal(c,p)));
+    assert(not(equal(k,p)));
+    assert(not(equal(l,p)));
+    assert(not(equal(m,p)));
+    assert(not(equal(u,p)));
+    assert(not(equal(v,p)));
+    assert(not(equal(w,p)));
+    assert(not(equal(x,p)));
+    assert(not(equal(h,p)));
+    assert(equal(p,p));
+    assert(not(equal(q,p)));
+    assert(not(equal(nil,q)));
+    assert(not(equal(a,q)));
+    assert(not(equal(b,q)));
+    assert(not(equal(c,q)));
+    assert(not(equal(k,q)));
+    assert(not(equal(l,q)));
+    assert(not(equal(m,q)));
+    assert(not(equal(u,q)));
+    assert(not(equal(v,q)));
+    assert(not(equal(w,q)));
+    assert(not(equal(x,q)));
+    assert(not(equal(h,q)));
+    assert(not(equal(p,q)));
+    assert(equal(q,q));
+
+    TEST_END(SUCCESS);}

 void test_all(void){
-    testing({
-                 fprintf(stderr," ...\n");
-                 test_compute_primes_to();
-                 test_ceiling_to_nearest_prime();
-                 test_box();
-                 test_cons();
-                 test_list();
-                 test_reverse();
-                 test_revappend();
-                 test_hashtable();
-                 test_hashtable_set_grow();
-                 test_hashtable_reset();
-                 test_hashtable_map();
-                 test_hashtable_remove();
-                 fprintf(stderr,"%-40s ",__FUNCTION__);
-             });}
-
+    TEST_BEGIN();
+    fprintf(stderr," ...\n");
+    test_compute_primes_to();
+    test_ceiling_to_nearest_prime();
+    test_box();
+    test_cons();
+    test_list();
+    test_reverse();
+    test_revappend();
+    test_hashtable();
+    test_hashtable_set_grow();
+    test_hashtable_reset();
+    test_hashtable_map();
+    test_hashtable_remove();
+    test_equal();
+    TEST_END(TOTALS);}

 //// THE END ////
ViewGit