Implemented visit_cursor_collect_children and a few list processing functions.

Pascal J. Bourguignon [2013-02-01 01:02]
Implemented visit_cursor_collect_children and a few list processing functions.
Filename
ast.c
diff --git a/ast.c b/ast.c
index cce0bd4..ea47429 100644
--- a/ast.c
+++ b/ast.c
@@ -9,14 +9,19 @@


 typedef enum {false=0,true=1} bool;
-#define INCF(x) (++(x))
-#define DECF(x) (--(x))

+#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) \
+    ({ (LIST_PLACE)=cons((ELEMENT),(LIST_PLACE)); })
+#define POP_INTERN(RESVAR,LIST_PLACE) \
+    ({ object* RESVAR=car(LIST_PLACE); (LIST_PLACE)=cdr(LIST_PLACE); RESVAR; })
+#define POP(LIST_PLACE) \
+    POP_INTERN(CONCAT(result_,__LINE__),LIST_PLACE)

-void* nil=0;
-
-bool null(void* object){
-    return(0==object);}
+#define PUSH2(k,v,plist) ({PUSH(v,plist);PUSH(k,plist);})


 #define ASSERT_INTERNAL(EXPRESSION)                                     \
@@ -58,6 +63,13 @@ void* memory_allocate(const char* fname,int element_size,int element_count){



+
+void* nil=0;
+
+bool null(void* object){
+    return(0==object);}
+
+
 typedef enum {
     ot_nil=0,
     ot_t,
@@ -139,6 +151,9 @@ object* box(object_type type,...){
     return(o);}


+bool cursorp(object* x){
+    return(not(null(x)) and (ot_CXCursor==type_of(x)));}
+
 object* cursor(CXCursor value){
     return(box(ot_CXCursor,value));}

@@ -148,6 +163,9 @@ CXCursor cursor_value(object* o){
     return(o->value.cursor);}


+bool integerp(object* x){
+    return(not(null(x)) and (ot_int==type_of(x)));}
+
 object* integer(int value){
     return(box(ot_int,value));}

@@ -157,6 +175,9 @@ int integer_value(object* o){
     return(o->value.integer);}


+bool characterp(object* x){
+    return(not(null(x)) and (ot_char==type_of(x)));}
+
 object* character(char value){
     return(box(ot_char,value));}

@@ -178,6 +199,14 @@ kons* make_kons(object* a,object* d){
     cell->cdr=d;
     return(cell);}

+bool consp(object* a){
+    return(not(null(a)) and (ot_cons==type_of(a)));}
+
+kons* cons_value(object* o){
+    assert(nil!=o);
+    assert(ot_cons==type_of(o));
+    return(o->value.cons);}
+
 object* cons(object* a,object* d){
     return(box(ot_cons,make_kons(a,d)));}

@@ -201,7 +230,149 @@ object* setcdr(object* cell,object* d){
     else if(ot_cons==cell->type){ cell->value.cons->cdr=d; return(d); }
     else{ error_type(__FUNCTION__,ot_cons,cell->type); return(nil); }}

-
+object* caar   (object* cell){return(car(car(cell)));}
+object* cadr   (object* cell){return(car(cdr(cell)));}
+object* cdar   (object* cell){return(cdr(car(cell)));}
+object* cddr   (object* cell){return(cdr(cdr(cell)));}
+
+object* caaar  (object* cell){return(car(car(car(cell))));}
+object* cadar  (object* cell){return(car(cdr(car(cell))));}
+object* cdaar  (object* cell){return(cdr(car(car(cell))));}
+object* cddar  (object* cell){return(cdr(cdr(car(cell))));}
+
+object* caadr  (object* cell){return(car(car(cdr(cell))));}
+object* caddr  (object* cell){return(car(cdr(cdr(cell))));}
+object* cdadr  (object* cell){return(cdr(car(cdr(cell))));}
+object* cdddr  (object* cell){return(cdr(cdr(cdr(cell))));}
+
+object* first  (object* list){return(car(list));}
+object* rest   (object* list){return(cdr(list));}
+object* second (object* list){return(car(cdr(list)));}
+object* third  (object* list){return(car(cdr(cdr(list))));}
+object* fourth (object* list){return(car(cdr(cdr(cdr(list)))));}
+object* fifth  (object* list){return(car(cdr(cdr(cdr(cdr(list))))));}
+object* sixth  (object* list){return(car(cdr(cdr(cdr(cdr(cdr(list)))))));}
+object* seventh(object* list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(list))))))));}
+object* eighth (object* list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list)))))))));}
+object* nineth (object* list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list))))))))));}
+object* tenth  (object* list){return(car(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(cdr(list)))))))))));}
+
+object* last   (object* list){
+    while(cdr(list)){
+        list=cdr(list);}
+    return(list);}
+
+object* nth(int n,object* list){
+    while((0<n) and list){
+        list=cdr(list);}
+    return(car(list));}
+
+object* nthcdr(int n,object* list){
+    while((0<n) and list){
+        list=cdr(list);}
+    return(list);}
+
+
+int length(object* list){
+    int n=0;
+    while(consp(list)){
+        list=cdr(list);
+        n++;}
+    return(n);}
+
+object* list(int n,...){
+    switch(n){
+      case 0:
+          return(nil);
+      default:{
+          va_list ap;
+          va_start(ap,n);
+          object* result=cons(va_arg(ap,object*),nil);
+          object* tail=result;
+          for(int i=1;i<n;i++){
+              setcdr(tail,cons(va_arg(ap,object*),nil));
+              tail=cdr(tail);}
+          va_end(ap);
+          return(result);}}}
+
+object* prepend(int n,...){
+    // list*
+    switch(n){
+      case 0:
+          return(nil);
+      case 1:{
+          va_list ap;
+          va_start(ap,n);
+          object* result=va_arg(ap,object*);
+          va_end(ap);
+          return(result);}
+      default:{
+          va_list ap;
+          va_start(ap,n);
+          object* result=cons(va_arg(ap,object*),nil);
+          object* tail=result;
+          for(int i=2;i<n;i++){
+              setcdr(tail,cons(va_arg(ap,object*),nil));
+              tail=cdr(tail);}
+          va_end(ap);
+          setcdr(tail,va_arg(ap,object*));
+          return(result);}}}
+
+object* reverse_accumulator(object* list,object* reversed){
+    return(null(list)
+           ?reversed
+           :reverse_accumulator(cdr(list),cons(car(list),reversed)));}
+
+object* reverse(object* list){
+    return(reverse_accumulator(list,nil));}
+
+object* revappend(object* list,object* tail){
+    return(reverse_accumulator(list,tail));}
+
+object* nreconc(object* list,object* tail){
+    while(not(null(list))){
+        object* next=cdr(list);
+        setcdr(list,tail);
+        tail=list;
+        list=next;}
+    return(tail);}
+
+object* nreverse(object* list){
+    return(nreconc(list,nil));}
+
+object* copy_list(object* list){
+    if(null(list)){
+        return(nil);
+    }else{
+        object* result=cons(car(list),nil);
+        object* tail=result;
+        list=cdr(list);
+        while(not(null(list))){
+            setcdr(tail,cons(car(list),nil));
+            tail=cdr(tail);
+            list=cdr(list);}
+        return(result);}}
+
+object* append(int n,...){
+    switch(n){
+      case 0: return(nil);
+      case 1:{
+          va_list ap;
+          va_start(ap,n);
+          object* result=va_arg(ap,object*);
+          va_end(ap);
+          return(result);}
+      default:{
+          va_list ap;
+          va_start(ap,n);
+          object* result=cons(nil,nil);
+          object* tail=result;
+          for(int i=1;i<n;i++){
+              setcdr(tail,copy_list(va_arg(ap,object*)));
+              tail=last(tail);}
+          setcdr(tail,va_arg(ap,object*));
+          va_end(ap);
+          return(cdr(result));}}}


 typedef struct vector {
@@ -211,6 +382,14 @@ typedef struct vector {
     char* data;
 } vector;

+bool vectorp(object* x){
+    return(not(null(x)) and (ot_vector==type_of(x)));}
+
+vector* vector_value(object* o){
+    assert(nil!=o);
+    assert(ot_vector==type_of(o));
+    return(o->value.vector);}
+
 vector* vector_set_data(vector* v,int index,const void* data);

 vector* make_vector(object_type element_type,int size,int fill_pointer,const void* initial_element){
@@ -306,6 +485,16 @@ object* vector_get(vector* v,int index){
     return(result);}


+bool stringp(object* x){
+    return(not(null(x)) and (ot_vector==type_of(x))
+           and (ot_char==vector_element_type(vector_value(x))));}
+
+object* string(const char* text){
+    int len=strlen(text);
+    vector* v=make_vector(ot_char,len,len,0);
+    for(int i=0;i<len;i++){
+        vector_set_char(v,i,text[i]);}
+    return(box(ot_vector,v));}

 bool string_equal(vector* a,vector* b){
     if((vector_element_type(a)!=vector_element_type(b))
@@ -351,6 +540,7 @@ bool equal(object* a,object* b){
         return(false);}}


+
 typedef struct hashtable {
     int count;
     int size;
@@ -359,6 +549,14 @@ typedef struct hashtable {
     object** entries;
 } hashtable;

+bool hashtablep(object* x){
+    return(not(null(x)) and (ot_hashtable==type_of(x)));}
+
+hashtable* hashtable_value(object* o){
+    assert(nil!=o);
+    assert(ot_hashtable==type_of(o));
+    return(o->value.hashtable);}
+
 int hashtable_count(hashtable* table){
     assert(nil!=table);
     return(table->count);}
@@ -904,6 +1102,14 @@ void newline(int margin){
 /* } */


+object* cxstring(CXString theCXString){
+    const char* cstring=clang_getCString(theCXString);
+    object* result=((nil==cstring)
+                    ?nil
+                    :string(cstring));
+    clang_disposeString(theCXString);
+    return(result);}
+
 void print_string(CXString string){
     const char* cstring=clang_getCString(string);
     if(nil==cstring){
@@ -1564,6 +1770,7 @@ enum CXChildVisitResult print_cursor_visitor(CXCursor cursor,CXCursor parent,CXC
     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));
@@ -1728,27 +1935,125 @@ void print_cursor(CXCursor cxcursor,int margin){
             print_slots(cxcursor,kind,margin+4);//TODO: width of #nn=
             printf(")");}}}

+
 void print_registered_cursor(object* cursor,object* pair,void* data){
     printf("\n#%d=",integer_value(car(pair)));
     print_cursor(cursor_value(cursor),0);}


-enum CXChildVisitResult register_visitor(CXCursor cursor,CXCursor parent,CXClientData client_data){
-    hashtable* table=client_data;
-    object* c=box(ot_CXCursor,cursor);
-    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(cursor));
+
+
+typedef struct {
+    // IN:
+    hashtable* visited; // maps cursors to (#n# visited-0/1 linkedCursors)
+    // OUT:
+    object*    linkedCursors;
+} visit_cursor_closure;
+
+
+enum CXChildVisitResult visit_cursor_collect_children(CXCursor cxcursor,CXCursor parent,CXClientData client_data){
+    // Collects the linked and children CXCursors.
+    visit_cursor_closure* closure=client_data;
+    hashtable* visited=closure->visited;
+    object* linkedCursors=nil;
+
+    object* c=box(ot_CXCursor,cxcursor);
+    assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(cxcursor));
     assert(clang_hashCursor(c->value.cursor)==clang_hashCursor(cursor_value(c)));
-    object* n=hashtable_get(table,c);
-    if(nil==n){
-        hashtable_set(table,c,cons(integer(hashtable_count(table)),integer(0)));
-        return(CXChildVisit_Recurse);
-    }else{
-        return(CXChildVisit_Continue);}}
+    object* n=hashtable_get(visited,c);
+    if(null(n)){
+        object* entry=list(3,integer(hashtable_count(visited)),integer(0),nil);
+        hashtable_set(visited,c,entry);

-void register_cursors(hashtable* cursors,CXCursor rootCursor){
-    register_visitor(rootCursor,clang_getNullCursor(),cursors);
-    clang_visitChildren(rootCursor,register_visitor,cursors);}
+        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){
+            object* 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){
+            object* 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);}
+
+
+        visit_cursor_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;}
+
+
+
+// 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=make_hashtable(10000);
+    closure.linkedCursors=nil;
+    visit_cursor_collect_children(rootCursor,clang_getNullCursor(),&closure);
+}

 typedef struct{
     bool present;
@@ -1898,6 +2203,7 @@ void test_box(void){
              });}


+
 void test_cons(void){
     testing({
                  assert(null(nil));
@@ -1924,6 +2230,81 @@ void test_cons(void){

              });}

+
+void test_list(void){
+    testing({
+                 object* 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)))));
+             });}
+
+
+void test_reverse(void){
+    testing({
+                 object* l=list(0);
+                 object* 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)))));
+             });}
+
+
+void test_revappend(void){
+    testing({
+                 object* l=list(0);
+                 object* t=list(2,integer(3),integer(4));
+                 object* 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)));
+             });}
+
+
+
 void dump_hashtable(hashtable* table){
     fprintf(stderr,"size             = %d\n",hashtable_size(table));
     fprintf(stderr,"count            = %d\n",hashtable_count(table));
@@ -2051,6 +2432,9 @@ void test_all(void){
                  test_ceiling_to_nearest_prime();
                  test_box();
                  test_cons();
+                 test_list();
+                 test_reverse();
+                 test_revappend();
                  test_hashtable();
                  test_hashtable_set_grow();
                  test_hashtable_reset();
ViewGit