├── .note ├── README ├── clp-pvm ├── README ├── c │ ├── c-acc.c │ ├── c-ary.c │ ├── c-frt.c │ ├── c-hdf.c │ ├── c-lnd.c │ ├── c-msc.c │ ├── c-pvm.c │ ├── clips-sc-main.c │ ├── clipsmain.c │ ├── hdf-agent.c │ ├── mi.c │ ├── mk │ │ ├── make-db │ │ ├── make-hdfpvm │ │ ├── make-pvm │ │ ├── make.hdfpvm │ │ ├── make.hdfxpvm │ │ ├── make.orig │ │ ├── make.pvm │ │ ├── make.pypvm │ │ ├── make.pyx │ │ ├── make.pyxpvm │ │ ├── make.xpvm │ │ ├── makefile.gcc │ │ └── makefile.x │ ├── ts-agent.c │ └── tsd-agent.c └── clp │ ├── array.clp │ ├── eval.clp │ ├── lib.clp │ ├── mf.clp │ ├── misc-fnc.clp │ ├── param-lib.clp │ ├── param.clp │ ├── proj.clp │ ├── pvm.clp │ ├── rul.clp │ ├── sub.clp │ ├── task.clp │ └── util.clp ├── csd.auth.gr ├── .note ├── .note~ ├── R-DEVICE │ ├── aggregates.clp │ ├── arp-only.bat │ ├── arp.bat │ ├── auxiliary-functions.clp │ ├── class-functions.clp │ ├── classes.clp │ ├── export.clp │ ├── import.clp │ ├── load-rdf.clp │ ├── main.clp │ ├── manual.pdf │ ├── oo-querying.clp │ ├── r-device.bat │ ├── rdf-auxiliary.clp │ ├── rdf.clp │ ├── restore-classes.clp │ ├── second-order.clp │ ├── stratification.clp │ ├── test │ │ ├── content.rdf │ │ ├── dc.rdf │ │ ├── dcq.rdf │ │ ├── dcterms.rdf │ │ ├── dctype.rdf │ │ ├── dmoz.rdf │ │ ├── question0.clp │ │ ├── question1.clp │ │ ├── question2.clp │ │ ├── question3.clp │ │ ├── question4.clp │ │ ├── question5.clp │ │ ├── question6.clp │ │ ├── question7.clp │ │ ├── question8.clp │ │ ├── run-test.bat │ │ └── structure.rdf │ ├── translation-rules.clp │ ├── translation.CLP │ ├── triple-transformation.clp │ └── types.clp └── o-device │ ├── .note │ ├── LICENSE.txt │ ├── NOTICE.txt │ ├── config.bat │ ├── create-classes.clp │ ├── create-objects.clp │ ├── create-templates.clp │ ├── description.txt │ ├── exec.bat │ ├── functions.clp │ ├── global.clp │ ├── how-to-use.txt │ ├── j2cf.jar │ ├── order.clp │ ├── prepare.bat │ ├── readme.txt │ ├── release_notes.txt │ ├── rule-generator.clp │ ├── vocabulary-abbr.clp │ └── vocabulary.clp ├── f.clp ├── jutl.clp ├── pins2km.sed ├── pontdi2km.sed ├── u.clp └── utils.clp /.note: -------------------------------------------------------------------------------- 1 | do NOT use pins2km nor km-tax considering malecoli cl-kb then lisa.sf.net 2 | cl-kb just has pprj&xml file, but can export the pont&pins but just sys-slots vs. full hierarchy 3 | change pprj type to pont/pins looses the same info; assume it was the experimental-xml file,might be able to convert this 4 | 5 | Look at r-device code again, when I can, as a way to get triples out &more?; though protege has mult save-as/transform opts 6 | Found it after the o-device code; it still loads, might try o code next; could be useful, but would still like2get back2lisp 7 | 8 | using agraph&gruff and asking for connections might be nice 9 | 10 | ;still prolog-tab &km-tax if it worked better 11 | also 12 | pins2km .sed 13 | small fix to sed, can handle some more files, but use clean input 14 | it turns out that doing an agrep to get a subset of instances can break some(long?)lines 15 | 100+M files take @least on the order of the time(longer) that clips takes to load ;not sure abt lisa 16 | 17 | ;aside i've always wanted a fwd chainer on agraph, more like lispworks knowledge-based product 18 | 19 | find-ins-str was written&commited on another machine, but didn't show up; have to check on this 20 | 21 | save*ins2 can be useful to restrict what to load, and for greping seperated files 22 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Some collected CLIPS code, more to come 2 | -------------------------------------------------------------------------------- /clp-pvm/README: -------------------------------------------------------------------------------- 1 | I haven't looked at this in years, &should of put it on the clips list then. 2 | It has been long forgotten/tossed, so hopefully someone will want to revivie it. 3 | I've been meaning to clean up similar code in Lisp, &see if generic ffi's are easier than clips's. 4 | Not sure of ownership/etc, other than it was made w/public funds(by me)&forgotten. 5 | -------------------------------------------------------------------------------- /clp-pvm/c/c-acc.c: -------------------------------------------------------------------------------- 1 | /*misc functions to be included in the clips main file, M. Bobak, ANL*/ 2 | 3 | #define ISMETH(m,ts,ac) (!strcasecmp((m),(ts)) && ((ac)+2)==get_ac()) 4 | /*---------------------------------------------------------INCLUDES*/ 5 | /*---------------------------------------------------------general*/ 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | /*---------------------------------------------------------extern C*/ 14 | #ifdef __cplusplus 15 | extern "C" { 16 | #endif 17 | /*---------------------------------------------------------clips*/ 18 | #include "clips.h" /*has Rtn*fncs, so fnc can get args from clips*/ 19 | #include "setup.h" 20 | #include "sysdep.h" 21 | #include "extnfunc.h" 22 | #include "commline.h" 23 | #define PTIF2 (void (*)(VOID_ARG)) 24 | /*---------------------------------------------------------*/ 25 | #include "symbol.h" 26 | #include "router.h" 27 | #include "engine.h" 28 | #include "argacces.h" 29 | #include "prntutil.h" 30 | /*---------------------------------------------------------*/ 31 | #ifdef __cplusplus 32 | } 33 | #endif 34 | /*---------------------------------------------------------clipsmain*/ 35 | /*#include "incl/clipsmain.c"*/ 36 | /*the idea is to not have to store it in clips,*/ 37 | /*=======================================================--CLIPS access fncs*/ 38 | /*might want to break out the fncs that don't have wrappers 39 | so they can be included by any file that does have wrappers 40 | and wants to use them (not necc if all incl in 1 big file) 41 | (better to link in wrapper files seperately though)*/ 42 | /*would be nice to have fncs to set/get vals from mf-s*/ 43 | /*=======================================================--internal fncs*/ 44 | /*---------------------------------------------------------ADDSYMB*/ 45 | /*if want this from CLIPS use sym-cat*/ 46 | VOID *AddSymb(char *str) 47 | { 48 | char *t; 49 | VOID *ret; 50 | t=strdup(str); 51 | ret=AddSymbol(t); 52 | free(t); 53 | return(ret); 54 | } 55 | /*---------------------------------------------------------*/ 56 | /*--------------------------------------------------------wrapper for Rtn-fncs*/ 57 | /*---------------------------------------------------------GET_STR*/ 58 | char *get_str(int n,char *m) /*a shorthand for returning a string*/ 59 | { sprintf(m,"%s",(char *)RtnLexeme(n)); return(m); } 60 | /*---------------------------------------------------------GET_CHAR*/ 61 | char get_char(int n) 62 | { 63 | char tmpstr[22]; 64 | sprintf(tmpstr,"%s",(char *)RtnLexeme(n)); return(m); 65 | return(tmpstr[0]); 66 | } 67 | /*----------------------------------------------------------*/ 68 | float get_ac() { return( RtnArgCount());} 69 | /*----------------------------------------------------------*/ 70 | /*a shorthand for returning a float,int (inline sometime)*/ 71 | /*---------------------------------------------------------GET_FLOAT*/ 72 | float get_float(int n) { return((float)RtnDouble(n)); } 73 | double get_double(int n){ return( RtnDouble(n)); } 74 | /*---------------------------------------------------------GET_INT*/ 75 | int get_int(int n) { return( (int)RtnLong(n)); } 76 | long get_long(int n) { return( RtnLong(n)); } 77 | /*might have these use RtnUnknown like in get_ptr*/ 78 | /*---------------------------------------------------------GET_INT_ARRAY*/ 79 | void get_int_array(int start, int *array) 80 | { 81 | int i; 82 | for(i=start; i=n) return(*fp=(float)RtnDouble(n)); else return(0.0); } 93 | double get_double_if(int n,double *dp){ 94 | if(get_ac()>=n) return(*dp= RtnDouble(n)); else return(0.0); } 95 | /*---------------------------------------------------------GET_INT*/ 96 | int get_int_if(int n,int *ip) { 97 | if(get_ac()>=n) return(*ip=(int)RtnLong(n)); else return(0); } 98 | long get_long_if(int n,long *lp) { 99 | if(get_ac()>=n) return(*lp= RtnLong(n)); else return(0); } 100 | /*----------------------------------------------------------GET_PTR*/ 101 | VOID *get_ptr(int num) 102 | { 103 | DATA_OBJECT tmp; 104 | VOID *ret=(VOID *)NULL; 105 | long i; 106 | RtnUnknown(num,&tmp); 107 | switch(GetType(tmp)) 108 | { 109 | case INTEGER: 110 | i=DOToLong(tmp); 111 | if(i<999) printf("[bad int for ptr = %d]\n",i); 112 | else ret = (VOID *)i; 113 | break; 114 | case EXTERNAL_ADDRESS: ret = (VOID *)DOToPointer(tmp); break; 115 | case SYMBOL: 116 | case INSTANCE_NAME: 117 | printf("will take ins ptr and use DirectGetSlot(ins,sn,&tmp)\n"); 118 | /* case INSTANCE: */ 119 | break; 120 | } 121 | return(ret); 122 | } 123 | /*----------------------------------------------------------wrap unk returns*/ 124 | /*like AddSymb, but for numbers, &symb*/ 125 | /*----------------------------------------------------------set_float*/ 126 | VOID set_float(DATA_OBJECT_PTR ptr,float f) 127 | { 128 | SetpType(ptr,FLOAT); 129 | SetpValue(ptr,AddDouble((double)f)); 130 | return; 131 | } 132 | /*----------------------------------------------------------set_double*/ 133 | VOID set_double(DATA_OBJECT_PTR ptr,double f) 134 | { 135 | SetpType(ptr,FLOAT); 136 | SetpValue(ptr,AddDouble(f)); 137 | return; 138 | } 139 | /*----------------------------------------------------------set_int*/ 140 | VOID set_int(DATA_OBJECT_PTR ptr,int i) 141 | { 142 | SetpType(ptr,INTEGER); 143 | SetpValue(ptr,AddLong((long)i)); 144 | return; 145 | } 146 | /*----------------------------------------------------------set_long*/ 147 | VOID set_long(DATA_OBJECT_PTR ptr,long i) 148 | { 149 | SetpType(ptr,INTEGER); 150 | SetpValue(ptr,AddLong(i)); 151 | return; 152 | } 153 | /*----------------------------------------------------------set_symb*/ 154 | VOID set_symb(DATA_OBJECT_PTR ptr,char *s) 155 | { /*might want a tmp str like w/ addsymb (just using addsymb now)*/ 156 | SetpType(ptr,SYMBOL); 157 | SetpValue(ptr,AddSymb(s)); 158 | return; 159 | } 160 | /*----------------------------------------------------------*/ 161 | /*---------------------------------------------------------*/ 162 | /*tpn_to-mf could almost be used as a subfnc*/ 163 | /*---------------------------------------------------------*/ 164 | /*---------------------------------------------------------EOF*/ 165 | -------------------------------------------------------------------------------- /clp-pvm/c/c-frt.c: -------------------------------------------------------------------------------- 1 | #define PTIF (int (*)(VOID_ARG)) 2 | #define VPTIF (void (*)(VOID_ARG)) 3 | /* DefineFunction2("DF2"",'i',PTIF DF2,"DF2","45iskuss"); */ 4 | int 5 | DF2() 6 | { 7 | char c1, chr1[9] ,str1[99] ,str2[99] ,str3[99]; 8 | /*PTIF fncptr; at the worst might have to give the return type &do a switch*/ 9 | int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/ 10 | fncptr = PTIF get_ptr(3); 11 | if((int)fncptr < 999) printf("[fncptr=%d]",(int)fncptr); /*return(0);*/ 12 | sprintf(str1,"%s",(char *)RtnLexeme(1)); 13 | sprintf(chr1,"%s",(char *)RtnLexeme(2)); 14 | sprintf(str2,"%s",(char *)RtnLexeme(4)); 15 | c1= chr1[0]; 16 | printf("[DefineFunction2 for:%s with type=%c]\n",str1,c1); 17 | if(RtnArgCount()>4) 18 | { 19 | sprintf(str3,"%s",(char *)RtnLexeme(5)); 20 | DefineFunction2(str1,c1,PTIF fncptr,str2,str3); 21 | } 22 | else DefineFunction(str1,c1,PTIF fncptr,str2); 23 | return(1); 24 | } 25 | /*if this could be done interactively then a compiled model could print out 26 | a batch file that would desribe all the fnc(in C) directly as clips fncs 27 | -it might still be a good idea to have instances to call the fncs 28 | it would at least save putting ifs in, allowing for direct calling*/ 29 | /*problem is turning the cmndline version of the fnc into the fnc ptr 30 | don't think it will work. the only way is if all the possible functions 31 | where compiled in extern&all, in a big switch -then there is the opt 32 | to make it a clips deffunction or if something is linked in use that 33 | ---could be done on arg types.. or vararg wrappers to Cfncs---??*/ 34 | 35 | /*could have any obj files print out the fnc ptrs in a SUBROUTINE inst 36 | then DF2 could be called with this #, as part of a handler call 37 | -this might even be able to done w/ fortran code w/out having to use f2c*/ 38 | /*start including val_ptr slots in the subroutines and try DF2 w/ this #*/ 39 | 40 | /*can at least use these fnc ptrs for some basic in C array ops*/ 41 | 42 | /*Don't need to use DF2, can just call using the ptr to the fnc/sub & 43 | all the ptrs to the args, (all wrapped in a fnc/sub clips inst)*/ 44 | 45 | /* DefineFunction2("cf0i"",'i',PTIF cf0i,"cf0i","11ii"); */ 46 | int 47 | cf0i() 48 | { 49 | int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/ 50 | int i; 51 | fncptr = PTIF get_ptr(1); 52 | printf("[cf0i:calling %d]\n",(int)fncptr); 53 | i=fncptr(); 54 | return(i); 55 | } 56 | /* DefineFunction2("cf0v"",'i',PTIF cf0v,"cf0v","11ii"); */ 57 | int 58 | cf0v() 59 | { 60 | void (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/ 61 | fncptr = VPTIF get_ptr(1); 62 | printf("[cf0v:calling %d]\n",(int)fncptr); 63 | fncptr(); 64 | return(1); 65 | } 66 | /*will want a version that can handle a arbitrary number of arg ptrs*/ 67 | 68 | /* (DF2 "tst" i tst "tst" "11ik"); */ 69 | /* (DF2 "srrf" i # "srrf" "00i"); */ 70 | int tst() { 71 | char str1[99]; 72 | sprintf(str1,"%s",(char *)RtnLexeme(1)); 73 | printf("[test fnc tst can print out:%s]\n",str1); 74 | return(1); 75 | } 76 | 77 | extern int ftst_(); 78 | 79 | int ctst() 80 | { 81 | printf("(ftst of FUNC (val_ptr %d))",(int)ftst_); 82 | fflush(stdout); 83 | } 84 | 85 | /* DefineFunction2("ftst",'i',PTIF ftst_,"ftst","00i"); */ 86 | /* DefineFunction2("ctst",'i',PTIF ctst,"ctst","00i"); */ 87 | /*----------------------------------------------------------------EOF*/ 88 | -------------------------------------------------------------------------------- /clp-pvm/c/c-hdf.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MBcode/CLIPSmsc/05a813b3993104fb8ea82700bd1cec85a2949e6d/clp-pvm/c/c-hdf.c -------------------------------------------------------------------------------- /clp-pvm/c/c-lnd.c: -------------------------------------------------------------------------------- 1 | /*clips glenda (Linda using PVM) fncs MTB*/ 2 | /* #include "../gts/gluser.c" 3 | might compile like gts?*/ 4 | #include 5 | #include 6 | #include "glenda.h" 7 | 8 | #if defined(__cplusplus) 9 | extern "C" { 10 | #endif 11 | extern int gl_out(char*,...); 12 | extern int gl_in(char*,...); 13 | extern int gl_inp(char*,...); 14 | extern int gl_rd(char*,...); 15 | extern int gl_rdp(char*,...); 16 | #if defined(__cplusplus) 17 | } 18 | #endif 19 | 20 | /*-----------------------------------------------------------------*/ 21 | /*DefineFunction2("tpn_n_out",'i',PTIF tpn_n_out,"tpn_n_out","45ikuikk"); */ 22 | /*args: type,ptr to memory, 23 | # of elts to put into OR max# to take out of the tuple space, tuple name 24 | and one of 5 commands: out=O in=I inp=i rd=R rdp=r*/ 25 | /*return: #of elts actually recieved/sent*/ 26 | /*VOID tpn_n_out(DATA_OBJECT_PTR rp) be able to return a mf 27 | if ever want to send >1 array in a tuple*/ 28 | int tpn_n_c() 29 | { 30 | int num=1,*pi,rnum; 31 | float *pf; 32 | double *pd; 33 | char tstr[49],type,t1[2],cmnd; 34 | t1[1]='\0'; 35 | /*get the type of the array*/ 36 | sprintf(tstr,"%s",(char *)RtnLexeme(1)); 37 | type = tolower(tstr[0]); 38 | if(type!='i' && type!='f' && type!='d' && type!='b') 39 | { 40 | printf("[1st arg=type:i or f or d]"); 41 | return(-1); 42 | } 43 | /*figure out which command is being executed*/ 44 | if(RtnArgCount()>4) 45 | { 46 | sprintf(tstr,"%s",(char *)RtnLexeme(5)); 47 | if(!strncasecmp(tstr,"out",3)) cmnd='O'; 48 | else if(!strncasecmp(tstr,"inp",3)) cmnd='i'; 49 | else if(!strncasecmp(tstr,"in",2)) cmnd='I'; 50 | else if(!strncasecmp(tstr,"rdp",3)) cmnd='r'; 51 | else if(!strncasecmp(tstr,"rd",2)) cmnd='R'; 52 | else cmnd='O'; 53 | } 54 | else cmnd='O'; 55 | /*get the name of the tupel*/ 56 | sprintf(tstr,"%s",(char *)RtnLexeme(4)); 57 | 58 | /*get the number to put out or take in*/ 59 | if(RtnArgCount() > 2) num=(int)RtnLong(3); 60 | 61 | printf("[tpn_n_c:%c for %s with %d elts]",cmnd,tstr,num); 62 | 63 | switch(type) 64 | { 65 | case 'i': pi = (int *)get_ptr(2); 66 | printf("[pi=%d]",(int)pi); 67 | switch(cmnd) 68 | { 69 | case 'O': gl_out(tstr,A_INT,num,pi,NULL); rnum=num; break; 70 | case 'I': gl_in(tstr,A_INT,num,pi,&rnum,NULL); break; 71 | case 'i': gl_inp(tstr,A_INT,num,pi,&rnum,NULL); break; 72 | case 'R': gl_rd(tstr,A_INT,num,pi,&rnum,NULL); break; 73 | case 'r': gl_rdp(tstr,A_INT,num,pi,&rnum,NULL); break; 74 | } 75 | break; 76 | case 'f': pf = (float *)get_ptr(2); 77 | printf("[pf=%d]",(int)pf); 78 | switch(cmnd) 79 | { 80 | case 'O': gl_out(tstr,A_FLOAT,num,pf,NULL); rnum=num; break; 81 | case 'I': gl_in(tstr,A_FLOAT,num,pf,&rnum,NULL); break; 82 | case 'i': gl_inp(tstr,A_FLOAT,num,pf,&rnum,NULL); break; 83 | case 'R': gl_rd(tstr,A_FLOAT,num,pf,&rnum,NULL); break; 84 | case 'r': gl_rdp(tstr,A_FLOAT,num,pf,&rnum,NULL); break; 85 | } 86 | break; 87 | case 'd': pd = (double *)get_ptr(2); 88 | printf("[pd=%d]",(int)pd); 89 | switch(cmnd) 90 | { 91 | case 'O': gl_out(tstr,A_DOUBLE,num,pd,NULL); rnum=num; break; 92 | case 'I': gl_in(tstr,A_DOUBLE,num,pd,&rnum,NULL); break; 93 | case 'i': gl_inp(tstr,A_DOUBLE,num,pd,&rnum,NULL); break; 94 | case 'R': gl_rd(tstr,A_DOUBLE,num,pd,&rnum,NULL); break; 95 | case 'r': gl_rdp(tstr,A_DOUBLE,num,pd,&rnum,NULL); break; 96 | } 97 | break; 98 | } 99 | return(rnum); 100 | } 101 | /*presently this only puts 1 array into the tuple-space 102 | so for now, every array will have to go w/ a different tuple*/ 103 | /*-----------------------------------------------------------------*/ 104 | /*-------------------------------------------------------------------EOF--*/ 105 | -------------------------------------------------------------------------------- /clp-pvm/c/c-msc.c: -------------------------------------------------------------------------------- 1 | /*misc functions to be included in the clips main file, M. Bobak, ANL*/ 2 | 3 | #define ISMETH(m,ts,ac) (!strcasecmp((m),(ts)) && ((ac)+2)==get_ac()) 4 | /*---------------------------------------------------------INCLUDES*/ 5 | /*---------------------------------------------------------general*/ 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | /*---------------------------------------------------------extern C*/ 14 | #ifdef __cplusplus 15 | extern "C" { 16 | #endif 17 | /*---------------------------------------------------------clips*/ 18 | #include "clips.h" /*has Rtn*fncs, so fnc can get args from clips*/ 19 | #include "setup.h" 20 | #include "sysdep.h" 21 | #include "extnfunc.h" 22 | #include "commline.h" 23 | #define PTIF2 (void (*)(VOID_ARG)) 24 | /*---------------------------------------------------------*/ 25 | #include "symbol.h" 26 | #include "router.h" 27 | #include "engine.h" 28 | #include "argacces.h" 29 | #include "prntutil.h" 30 | /*---------------------------------------------------------*/ 31 | #ifdef __cplusplus 32 | } 33 | #endif 34 | /*---------------------------------------------------------clipsmain*/ 35 | /*#include "incl/clipsmain.c"*/ 36 | /*the idea is to not have to store it in clips,*/ 37 | /*---------------------------------------------------------TYPELEN*/ 38 | /*DefineFunction2("typelen",'i',PTIF typelen,"typelen","11kk"); */ 39 | int typelen() 40 | { 41 | int r; 42 | char c,type[14]; 43 | sprintf(type,"%s",(char *)RtnLexeme(1)); /*type = *RtnLexeme(2);*/ 44 | c = type[0]; 45 | switch(tolower(c)) 46 | { 47 | case 'b' : r = 1; break; 48 | case 'i' : r = sizeof(int); break; 49 | case 'f' : r = sizeof(float); break; 50 | case 'd' : r = sizeof(double); break; 51 | case 'l' : r = sizeof(long); break; 52 | default : r = sizeof(float); break; 53 | } 54 | return(r); 55 | } 56 | /*=======================================================--CLIPS fncs*/ 57 | /*might want to break out the fncs that don't have wrappers 58 | so they can be included by any file that does have wrappers 59 | and wants to use them (not necc if all incl in 1 big file) 60 | (better to link in wrapper files seperately though)*/ 61 | /*would be nice to have fncs to set/get vals from mf-s*/ 62 | /*=======================================================--internal fncs*/ 63 | /*----------------------------------------------------------PTR_TO_INT*/ 64 | /*DefineFunction2("ptr_to_int",'l',PTIF ptr_to_int,"ptr_to_int","11uu");*/ 65 | /*args: 1 ptr (accesible from get_ptr)*/ 66 | /*ret: the long int version of the ptr(so does anything if started as a long)*/ 67 | long ptr_to_int() 68 | { 69 | return((long)get_ptr(1)); 70 | } 71 | /*---------------------------------------------------------*/ 72 | /*=======================================================-- clips fncs*/ 73 | /*---------------------------------------------------------ADDRUNFNC*/ 74 | /*DefineFunction2("addrunfnc",'i',PTIF addrunfnc,"addrunfnc","25iss"); */ 75 | /*engine.h: LOCALE BOOLEAN AddRunFunction(char *,VOID (*)(void),int);*/ 76 | /*eg. (addrunfnc "nrecv_route" "nrecv_route" 1)*/ 77 | int addrunfnc() 78 | { 79 | char str[99],fnc[99]; 80 | int priority=1,start=0,remove=0,cnt; 81 | cnt= RtnArgCount(); 82 | sprintf(str,"%s",(char *)RtnLexeme(1)); 83 | sprintf(fnc,"%s",(char *)RtnLexeme(2)); 84 | if(cnt>2) priority = (int)RtnLong(3); 85 | if(cnt>3) start = (int)RtnLong(4); 86 | if(cnt>4) remove = (int)RtnLong(5); 87 | if(!remove) 88 | { 89 | /* if(start==1) return(AddRunStartFunction(str,PTIF fnc,priority));*/ 90 | /* else if(start==2) return(AddRunStopFunction(str,PTIF fnc,priority));*/ 91 | /* else */ 92 | /*bad argument 2 type for AddRunFunction(): int (*)() ( void (*)() expected)*/ 93 | return(AddRunFunction(str,PTIF2 fnc,priority)); 94 | } else 95 | { 96 | /* if(start==1) return(RemoveRunStartFunction(str));*/ 97 | /* else if(start==2) return(RemoveRunStopFunction(str));*/ 98 | /* else */ 99 | return(RemoveRunFunction(str)); 100 | } 101 | } 102 | /*=======================================================--utility fncs*/ 103 | /*str-cat sym-cat sub-string str-index upcase lowcase p155*/ 104 | /*---------------------------------------------------------STR-CMP*/ 105 | /*DefineFunction2("str-cmp",'i',PTIF str-cmp,"str-cmp","24iss"); */ 106 | int str_cmp() 107 | { 108 | int cnt,len=0; 109 | char s1[44],s2[44]; 110 | sprintf(s1,"%s",(char *)RtnLexeme(1)); 111 | sprintf(s2,"%s",(char *)RtnLexeme(2)); 112 | cnt= RtnArgCount(); 113 | if(cnt>2) 114 | { 115 | len = (int)RtnLong(3); 116 | if(len>0) 117 | { 118 | if(cnt>3) return(strncasecmp(s1,s2,len)); 119 | else return(strncmp(s1,s2,len)); 120 | } else 121 | { 122 | if(cnt>3) return(strcasecmp(s1,s2)); 123 | else return(strcmp(s1,s2)); 124 | } 125 | } else return(strcmp(s1,s2)); 126 | } /*there is already a str-compare*/ 127 | /*---------------------------------------------------------ATOI*/ 128 | /*DefineFunction2("atoi",'i',PTIF catoi,"catoi","11s"); */ 129 | int catoi() 130 | { 131 | char s1[44]; 132 | sprintf(s1,"%s",(char *)RtnLexeme(1)); 133 | return(atoi(s1)); 134 | } 135 | /*---------------------------------------------------------ATOF*/ 136 | /*DefineFunction2("atof",'f',PTIF catof,"catof","11s"); */ 137 | float catof() 138 | { 139 | char s1[44]; 140 | sprintf(s1,"%s",(char *)RtnLexeme(1)); 141 | return(atof(s1)); 142 | } 143 | /*moved memeory fncs to c-ary.c*/ 144 | /*---------------------------------------------------------*/ 145 | /*---------------------------------------------------------EOF*/ 146 | -------------------------------------------------------------------------------- /clp-pvm/c/clips-sc-main.c: -------------------------------------------------------------------------------- 1 | /*--this is the main loop for clips, to be included 2 | //-this is the version that has libscheme embedded in it 3 | //M. Bobak, ANL 4 | //---------------------------------------------------------*/ 5 | /*******************************************************/ 6 | /* "C" Language Integrated Production System */ 7 | /* A Product Of The */ 8 | /* Software Technology Branch */ 9 | /* NASA - Johnson Space Center */ 10 | /* CLIPS Version 6.00 05/12/93 */ 11 | /* MAIN MODULE */ 12 | /*******************************************************/ 13 | /*************************************************************/ 14 | /* Principal Programmer: Gary D. Riley */ 15 | /* Contributing Programmer(s): */ 16 | /* Bob Orchard (NRCC - Nat'l Research Council of Canada)*/ 17 | /* (Fuzzy reasoning extensions) */ 18 | /* (certainty factors for facts and rules) */ 19 | /* Mike Bobak (PVM extentions) */ 20 | /*************************************************************/ 21 | #if FUZZY_DEFTEMPLATES 22 | #include "fuzzyutl.h" 23 | #include "fuzzymod.h" 24 | #endif 25 | /*---------------------------------------------------------just added fuzzymod*/ 26 | /***********************************************************/ 27 | /* RerouteStdin: Reroutes stdin to read initially from the */ 28 | /* file specified on the command line with -r option. */ 29 | /***********************************************************/ 30 | globle VOID RerouteStdin2(int argc, char** argv) /*int argc; char *argv[];*/ 31 | { 32 | int i; 33 | /* If no arguments return */ 34 | if (argc < 3) { return; } 35 | /* If argv was not passed then forget it */ 36 | if (argv == NULL) return; 37 | 38 | for (i = 1 ; i < argc ; i++) 39 | { 40 | if (strcmp(argv[i],"-r") == 0) 41 | { 42 | if (i > (argc-1)) 43 | { 44 | PrintErrorID("SYSDEP",1,CLIPS_FALSE); 45 | PrintCLIPS(WERROR,"No string found for -r option\n"); 46 | return; 47 | } 48 | else 49 | { 50 | printf("Doing a: RouteCommand(%s)\n",argv[++i]); fflush(stdout); 51 | RouteCommand(argv[i]); 52 | } 53 | } 54 | } 55 | } 56 | /*--------------------------------------------------------- 57 | //RUN: Starts execution of rules. Rules fire until agenda is empty or 58 | // the number of rule firings limit specified by the first argument 59 | // is reached (infinity if unspecified). 60 | // A fuzzyCLIPS extension assigns a special meaning to the rule limit 61 | // value -2 and values less than -2. For -2 the inference cycle will 62 | // continue forever (or until a break, control-C, is encountered). 63 | // Even when the agenda is empty the cycle will continue and any 64 | // functions added to the runtime list will be executed. If the 65 | // value is less than -2 then the cycle will continue until |limit| 66 | // rules have been fired even if the agenda becomes empty at some time. 67 | //(run []) 68 | //---------------------------------------------------------*/ 69 | 70 | #include "scheme.h" 71 | 72 | /*---------------------------------------------------------*/ 73 | int sc-eval() 74 | { 75 | obj = scheme_read (scheme_stdin_port); /*how to read 1st*/ 76 | if (obj == scheme_eof) 77 | { 78 | printf ("\n; done\n"); 79 | exit (0); 80 | } 81 | obj = SCHEME_CATCH_ERROR(scheme_eval (obj, global_env),0); 82 | if (obj) 83 | { 84 | scheme_write (obj, scheme_stdout_port); /*then how to get as clips obj*/ 85 | printf ("\n"); 86 | } 87 | } 88 | /*---------------------------------------------------------*/ 89 | #if defined(__cplusplus) 90 | extern "C" { 91 | #endif 92 | 93 | #if ANSI_COMPILER 94 | int main(int,char *[]); 95 | VOID UserFunctions(void); 96 | #else 97 | int main(); 98 | VOID UserFunctions(); 99 | #endif 100 | 101 | #if defined(__cplusplus) 102 | } 103 | #endif 104 | /***************************************************************/ 105 | /* MAIN: Start execution of CLIPS. This function must be */ 106 | /* redefined in order to embed CLIPS within another program. */ 107 | /* Example of redefined main: */ 108 | /* main() */ 109 | /* { */ 110 | /* InitializeCLIPS(); */ 111 | /* . */ 112 | /* . */ 113 | /* ProcessData(); */ 114 | /* RunCLIPS(-1); */ 115 | /* EvaluateData(); */ 116 | /* . */ 117 | /* . */ 118 | /* FinalResults(); */ 119 | /* } */ 120 | /***************************************************************/ 121 | #if defined(__cplusplus) 122 | int main (int argc, char *argv[]) 123 | #else 124 | int main(argc,argv) 125 | int argc; 126 | char *argv[] ; 127 | #endif /* defined(__cplusplus) */ 128 | { 129 | Scheme_Env *global_env; 130 | Scheme_Object *obj, *in_port; 131 | int i; 132 | /*FILE *fp; blow of loading files from command line for now*/ 133 | 134 | global_env = scheme_basic_env (); 135 | 136 | InitializeCLIPS(); 137 | RerouteStdin(argc,argv); /*handles batch files (done in CommandLoop)*/ 138 | /* RerouteStdin2(argc,argv); //my version -r "any command to route" (done now) 139 | // the new lib has the -r option in RerouteStdin */ 140 | CommandLoop(); 141 | return(-1); 142 | } 143 | /*************************************************************/ 144 | /* UserFunctions: The function which informs CLIPS of any */ 145 | /* user defined functions. In the default case, there are */ 146 | /* no user defined functions. To define functions, either */ 147 | /* this function must be replaced by a function with the */ 148 | /* same name within this file, or this function can be */ 149 | /* deleted from this file and included in another file. */ 150 | /* User defined functions may be included in this file or */ 151 | /* other files. */ 152 | /* Example of redefined UserFunctions: */ 153 | /* UserFunctions() */ 154 | /* { */ 155 | /* DefineFunction("fun1",'i',fun1,"fun1"); */ 156 | /* DefineFunction("other",'f',other,"other"); */ 157 | /* } */ 158 | /*************************************************************/ 159 | -------------------------------------------------------------------------------- /clp-pvm/c/clipsmain.c: -------------------------------------------------------------------------------- 1 | /*--this is the main loop for clips, to be included 2 | //M. Bobak, ANL 3 | //---------------------------------------------------------*/ 4 | /*******************************************************/ 5 | /* "C" Language Integrated Production System */ 6 | /* A Product Of The */ 7 | /* Software Technology Branch */ 8 | /* NASA - Johnson Space Center */ 9 | /* CLIPS Version 6.00 05/12/93 */ 10 | /* MAIN MODULE */ 11 | /*******************************************************/ 12 | /*************************************************************/ 13 | /* Principal Programmer: Gary D. Riley */ 14 | /* Contributing Programmer(s): */ 15 | /* Bob Orchard (NRCC - Nat'l Research Council of Canada)*/ 16 | /* (Fuzzy reasoning extensions) */ 17 | /* (certainty factors for facts and rules) */ 18 | /* Mike Bobak (PVM extentions) */ 19 | /*************************************************************/ 20 | #if FUZZY_DEFTEMPLATES 21 | #include "fuzzyutl.h" 22 | #include "fuzzymod.h" 23 | #endif 24 | /*---------------------------------------------------------just added fuzzymod*/ 25 | /***********************************************************/ 26 | /* RerouteStdin: Reroutes stdin to read initially from the */ 27 | /* file specified on the command line with -r option. */ 28 | /***********************************************************/ 29 | globle VOID RerouteStdin2(int argc, char** argv) /*int argc; char *argv[];*/ 30 | { 31 | int i; 32 | /* If no arguments return */ 33 | if (argc < 3) { return; } 34 | /* If argv was not passed then forget it */ 35 | if (argv == NULL) return; 36 | 37 | for (i = 1 ; i < argc ; i++) 38 | { 39 | if (strcmp(argv[i],"-r") == 0) 40 | { 41 | if (i > (argc-1)) 42 | { 43 | PrintErrorID("SYSDEP",1,CLIPS_FALSE); 44 | PrintCLIPS(WERROR,"No string found for -r option\n"); 45 | return; 46 | } 47 | else 48 | { 49 | printf("Doing a: RouteCommand(%s)\n",argv[++i]); fflush(stdout); 50 | RouteCommand(argv[i]); 51 | } 52 | } 53 | } 54 | } 55 | /*--------------------------------------------------------- 56 | //RUN: Starts execution of rules. Rules fire until agenda is empty or 57 | // the number of rule firings limit specified by the first argument 58 | // is reached (infinity if unspecified). 59 | // A fuzzyCLIPS extension assigns a special meaning to the rule limit 60 | // value -2 and values less than -2. For -2 the inference cycle will 61 | // continue forever (or until a break, control-C, is encountered). 62 | // Even when the agenda is empty the cycle will continue and any 63 | // functions added to the runtime list will be executed. If the 64 | // value is less than -2 then the cycle will continue until |limit| 65 | // rules have been fired even if the agenda becomes empty at some time. 66 | //(run []) 67 | //---------------------------------------------------------*/ 68 | #if defined(__cplusplus) 69 | extern "C" { 70 | #endif 71 | 72 | #if ANSI_COMPILER 73 | int main(int,char *[]); 74 | VOID UserFunctions(void); 75 | #else 76 | int main(); 77 | VOID UserFunctions(); 78 | #endif 79 | 80 | #if defined(__cplusplus) 81 | } 82 | #endif 83 | /***************************************************************/ 84 | /* MAIN: Start execution of CLIPS. This function must be */ 85 | /* redefined in order to embed CLIPS within another program. */ 86 | /* Example of redefined main: */ 87 | /* main() */ 88 | /* { */ 89 | /* InitializeCLIPS(); */ 90 | /* . */ 91 | /* . */ 92 | /* ProcessData(); */ 93 | /* RunCLIPS(-1); */ 94 | /* EvaluateData(); */ 95 | /* . */ 96 | /* . */ 97 | /* FinalResults(); */ 98 | /* } */ 99 | /***************************************************************/ 100 | #if defined(__cplusplus) 101 | int main (int argc, char *argv[]) 102 | #else 103 | int main(argc,argv) 104 | int argc; 105 | char *argv[] ; 106 | #endif /* defined(__cplusplus) */ 107 | { 108 | InitializeCLIPS(); 109 | RerouteStdin(argc,argv); /*handles batch files (done in CommandLoop)*/ 110 | /* RerouteStdin2(argc,argv); //my version -r "any command to route" (done now) 111 | // the new lib has the -r option in RerouteStdin */ 112 | CommandLoop(); 113 | return(-1); 114 | } 115 | /*************************************************************/ 116 | /* UserFunctions: The function which informs CLIPS of any */ 117 | /* user defined functions. In the default case, there are */ 118 | /* no user defined functions. To define functions, either */ 119 | /* this function must be replaced by a function with the */ 120 | /* same name within this file, or this function can be */ 121 | /* deleted from this file and included in another file. */ 122 | /* User defined functions may be included in this file or */ 123 | /* other files. */ 124 | /* Example of redefined UserFunctions: */ 125 | /* UserFunctions() */ 126 | /* { */ 127 | /* DefineFunction("fun1",'i',fun1,"fun1"); */ 128 | /* DefineFunction("other",'f',other,"other"); */ 129 | /* } */ 130 | /*************************************************************/ 131 | -------------------------------------------------------------------------------- /clp-pvm/c/hdf-agent.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------------- 2 | /* FuzzyClips w/ PVM (Model)/'Agent' code includes: 3 | // "C" Language Integrated Production System, CLIPS Version 6.02 4 | // Gary D. Riley, Software Technology Branch of NASA-Johnson Space Center 5 | // Fuzzy reasoning extensions w/ certainty factors for facts and rules 6 | // Bob Orchard, NRCC - Nat'l Research Council of Canada 7 | // PVM (Parallel Virtual Machine) communication extentions, Mike Bobak, ANL 8 | /----------------------------------------------------------------------------*/ 9 | /* Use: ts-agt -r "(load util.clp)" -r "(load pvm.clp)" 10 | or ts-agt -r "(batch b)" where the file b has the above commands*/ 11 | /* To include model specific code, add lines like those in pvm[ud]fncs.c */ 12 | 13 | /*c-misc-fncs.c c-pvm-fncs.c c-misc-defs.c c-pvm-defs.c ts-agent.c*/ 14 | 15 | #include "c-misc-fncs.c" 16 | #include "c-pvm-fncs.c" 17 | #include "c-hdf.c" 18 | #include "clipsmain.c" 19 | 20 | /*---------------------------------------------------------------USERFUNCTIONS*/ 21 | VOID UserFunctions() 22 | { 23 | #include "c-misc-defs.c" 24 | #include "c-pvm-defs.c" 25 | 26 | DefineFunction2("hdf_data",'i',PTIF hdf_data,"hdf_data","4*ikkxi"); 27 | DefineFunction2("hdf_nt",'i',PTIF hdf_nt,"hdf_nt","01kk"); 28 | DefineFunction2("hdf_dims",'i',PTIF hdf_dims,"hdf_dims","2*iki"); 29 | DefineFunction2("hdf_clear",'i',PTIF hdf_clear,"hdf_clear","00i"); 30 | DefineFunction2("hdf_strs",'i',PTIF hdf_strs,"hdf_strs","14iikkk"); 31 | DefineFunction2("hdf_dimscale",'i',PTIF hdf_dimscale,"hdf_dimscale","13ii"); 32 | DefineFunction2("hdf_setlengths",'i',PTIF hdf_setlengths,"hdf_setlengths","44iiiii"); 33 | DefineFunction2("hdf_range",'i',PTIF hdf_range,"hdf_range","02nnn"); 34 | DefineFunction2("hdf_cal",'i',PTIF hdf_cal,"hdf_cal","05nnnnni"); 35 | 36 | } 37 | /*----------------------------------------------------------------EOF*/ 38 | -------------------------------------------------------------------------------- /clp-pvm/c/mi.c: -------------------------------------------------------------------------------- 1 | MakeInstance("(gensym) of THECLASS") 2 | > MakeInstance(" of THECLASS") 3 | > 4 | > 5 | >Give a syntax errors for the make-instance function. Is there a way to create 6 | >instances from C without knowing the name beforehand? 7 | 8 | This was an oversight in CLIPS 6.0.2 and will be fixed later. In the 9 | meantime, use the following workaround: 10 | 11 | #include "miscfun.h" 12 | 13 | char myBuffer[80]; 14 | 15 | sprintf(myBuffer,"%s of THECLASS",ValueToString(GenSymStarFunction())); 16 | MakeInstance(myBuffer); 17 | 18 | 19 | Brian Donnell 20 | NASA/JSC 21 | -------------------------------------------------------------------------------- /clp-pvm/c/mk/make-pvm: -------------------------------------------------------------------------------- 1 | # Object files for the CLIPS engine 2 | ENGINEOBJS = watch.o utility.o userdata.o tmpltutl.o tmpltrhs.o \ 3 | tmpltpsr.o tmpltlhs.o tmpltfun.o tmpltdef.o tmpltcmp.o tmpltbsc.o \ 4 | tmpltbin.o textpro.o sysdep.o symbol.o symblcmp.o symblbin.o strngrtr.o \ 5 | strngfun.o sortfun.o scanner.o rulepsr.o rulelhs.o ruledlt.o ruledef.o \ 6 | rulecstr.o rulecom.o rulecmp.o rulebsc.o rulebld.o rulebin.o router.o \ 7 | retract.o reteutil.o reorder.o proflfun.o prntutil.o prdctfun.o prcdrpsr.o \ 8 | prcdrfun.o prccode.o pprint.o pattern.o parsefun.o objrtmch.o objrtgen.o \ 9 | objrtfnx.o objrtcmp.o objrtbld.o objrtbin.o objcmp.o objbin.o multifun.o \ 10 | multifld.o msgpsr.o msgpass.o msgfun.o msgcom.o modulutl.o modulpsr.o \ 11 | moduldef.o modulcmp.o modulbsc.o modulbin.o miscfun.o memalloc.o \ 12 | lgcldpnd.o iofun.o insqypsr.o insquery.o inspsr.o insmult.o insmoddp.o \ 13 | insmngr.o insfun.o insfile.o inscom.o inherpsr.o incrrset.o immthpsr.o \ 14 | globlpsr.o globldef.o globlcom.o globlcmp.o globlbsc.o globlbin.o \ 15 | genrcpsr.o genrcfun.o genrcexe.o genrccom.o genrccmp.o genrcbin.o \ 16 | generate.o filertr.o filecom.o factrhs.o factrete.o factprt.o factmngr.o \ 17 | factmch.o factlhs.o facthsh.o factgen.o factfun.o factcom.o factcmp.o \ 18 | factbld.o factbin.o extnfunc.o exprnpsr.o exprnops.o exprnbin.o expressn.o \ 19 | evaluatn.o envrnmnt.o engine.o emathfun.o edterm.o edstruct.o edmisc.o \ 20 | edmain.o edbasic.o drive.o dfinscmp.o dfinsbin.o dffnxpsr.o dffnxfun.o \ 21 | dffnxexe.o dffnxcmp.o dffnxbin.o dffctpsr.o dffctdef.o dffctcmp.o \ 22 | dffctbsc.o dffctbin.o developr.o defins.o default.o cstrnutl.o cstrnpsr.o \ 23 | cstrnops.o cstrncmp.o cstrnchk.o cstrnbin.o cstrcpsr.o cstrccom.o \ 24 | cstrcbin.o crstrtgy.o constrnt.o constrct.o conscomp.o commline.o \ 25 | clsltpsr.o classpsr.o classini.o classinf.o classfun.o classexm.o \ 26 | classcom.o bsave.o bmathfun.o bload.o argacces.o analysis.o agenda.o 27 | ENGINELIBS = -lm 28 | 29 | # Objects for the XWindows interface 30 | XWINDOWSOBJS = xclips.o xclipstext.o xedit.o xmain.o xmenu.o \ 31 | xmenu_exec.o xmenu_file.o xmenu_opt.o xmenu_watch.o xmenu_wind.o 32 | XWINDOWSLIBS = -L/usr/X11R6/lib -I/usr/X11R6/include -lXaw -lXmu -lXt -lXext -lX11 -L./ -lclips 33 | 34 | # Objects for the command line interface 35 | #COMMANDLINEOBJS = main.o 36 | COMMANDLINEOBJS = c-main.o 37 | CMDLIBS = -ltermcap -L./ -lclips 38 | 39 | # Programs that may be produced 40 | PROGS = clips${exeext} xclips${exeext} 41 | ENGINE = libclips.so 42 | 43 | .c.o : 44 | gcc -c -Wall -Wundef -Wpointer-arith -Wshadow -Wcast-qual \ 45 | -Wcast-align -Winline -Wmissing-declarations -Wredundant-decls \ 46 | -Woverloaded-virtual -Wmissing-prototypes -Wnested-externs \ 47 | -Wstrict-prototypes -Waggregate-return -Wno-implicit $(CFLAGS) $< 48 | 49 | all: clips xclips 50 | 51 | clips : $(ENGINE) $(COMMANDLINEOBJS) 52 | gcc $(CMDLIBS) -o clips${exeext} $(COMMANDLINEOBJS) 53 | 54 | xclips : $(ENGINE) $(XWINDOWSOBJS) 55 | gcc $(XWINDOWSLIBS) -o xclips${exeext} $(XWINDOWSOBJS) 56 | 57 | $(ENGINE) : $(ENGINEOBJS) 58 | gcc $(ENGINELIBS) -shared -o libclips.so $(ENGINEOBJS) 59 | 60 | clean : 61 | @rm -f $(ENGINEOBJS) $(COMMANDLINEOBJS) $(XWINDOWSOBJS) $(PROGS) $(ENGINE) 62 | 63 | install : 64 | install -d -m 755 $(DESTDIR)/$(PREFIX)/bin 65 | install -m 755 clips${exeext} $(DESTDIR)/$(PREFIX)/bin/clips${exeext} 66 | install -d -m 755 $(DESTDIR)/$(PREFIX)/lib/clips 67 | install -m 755 $(ENGINE) $(DESTDIR)/$(PREFIX)/lib/$(ENGINE) 68 | install -m 644 ../doc/clips.hlp $(DESTDIR)/$(PREFIX)/lib/clips/clips.hlp 69 | 70 | setup.h : 71 | sed -e "s:XXX_HELP_FILE:$(PREFIX)/lib/clips/clips.hlp:g" setup.h.in > setup.h 72 | -------------------------------------------------------------------------------- /clp-pvm/c/mk/make.orig: -------------------------------------------------------------------------------- 1 | #XXX: fix these. DO they need slashes? 2 | DESTDIR= 3 | PREFIX=/usr/local 4 | 5 | all : 6 | cd src && make DESTDIR=$(DESTDIR) PREFIX=$(PREFIX) all 7 | 8 | clean : 9 | cd src && make DESTDIR=$(DESTDIR) PREFIX=$(PREFIX) clean 10 | 11 | install : 12 | cd src && make DESTDIR=$(DESTDIR) PREFIX=$(PREFIX) install 13 | -------------------------------------------------------------------------------- /clp-pvm/c/ts-agent.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------------- 2 | /* FuzzyClips w/ PVM (Model)/'Agent' code includes: 3 | // "C" Language Integrated Production System, CLIPS Version 6.02 4 | // Gary D. Riley, Software Technology Branch of NASA-Johnson Space Center 5 | // Fuzzy reasoning extensions w/ certainty factors for facts and rules 6 | // Bob Orchard, NRCC - Nat'l Research Council of Canada 7 | // PVM (Parallel Virtual Machine) communication extentions, Mike Bobak, ANL 8 | /----------------------------------------------------------------------------*/ 9 | /* Use: ts-agt -r "(load util.clp)" -r "(load pvm.clp)" 10 | or ts-agt -r "(batch b)" where the file b has the above commands*/ 11 | /* To include model specific code, add lines like those in pvm[ud]fncs.c */ 12 | 13 | /*c-l-fncs.c c-misc-fncs.c c-pvm-fncs.c c-misc-defs.c c-pvm-defs.c ts-agent.c*/ 14 | 15 | #include "c-misc-fncs.c" 16 | #include "c-pvm-fncs.c" 17 | #include "c-l-fncs.c" 18 | #include "clipsmain.c" 19 | 20 | /*---------------------------------------------------------------USERFUNCTIONS*/ 21 | VOID UserFunctions() 22 | { 23 | #include "c-misc-defs.c" 24 | #include "c-pvm-defs.c" 25 | /*defines for c-l-fncs.c 26 | DefineFunction2("tpn_n_out",'i',PTIF tpn_n_out,"tpn_n_out","44ikuik"); 27 | DefineFunction2("tpn_n_in",'i',PTIF tpn_n_in,"tpn_n_in","44ikuik"); 28 | */ 29 | DefineFunction2("tpn_n_c",'i',PTIF tpn_n_c,"tpn_n_c","45ikuikk"); 30 | } 31 | /*----------------------------------------------------------------EOF*/ 32 | -------------------------------------------------------------------------------- /clp-pvm/c/tsd-agent.c: -------------------------------------------------------------------------------- 1 | /*--------------------------------------------------------------------------- 2 | /* FuzzyClips w/ PVM (Model)/'Agent' code includes: 3 | // "C" Language Integrated Production System, CLIPS Version 6.02 4 | // Gary D. Riley, Software Technology Branch of NASA-Johnson Space Center 5 | // Fuzzy reasoning extensions w/ certainty factors for facts and rules 6 | // Bob Orchard, NRCC - Nat'l Research Council of Canada 7 | // PVM (Parallel Virtual Machine) communication extentions, Mike Bobak, ANL 8 | /----------------------------------------------------------------------------*/ 9 | /* Use: ts-agt -r "(load util.clp)" -r "(load pvm.clp)" 10 | or ts-agt -r "(batch b)" where the file b has the above commands*/ 11 | /* To include model specific code, add lines like those in pvm[ud]fncs.c */ 12 | 13 | /*c-l-fncs.c c-misc-fncs.c c-pvm-fncs.c c-misc-defs.c c-pvm-defs.c ts-agent.c*/ 14 | 15 | #include "c-misc-fncs.c" 16 | #include "c-pvm-fncs.c" 17 | #include "c-l-fncs.c" 18 | #include "clipsmain.c" 19 | #define PTIF (int (*)(VOID_ARG)) 20 | #define VPTIF (void (*)(VOID_ARG)) 21 | /* DefineFunction2("DF2"",'i',PTIF DF2,"DF2","45iskuss"); */ 22 | int 23 | DF2() 24 | { 25 | char c1, chr1[9] ,str1[99] ,str2[99] ,str3[99]; 26 | /*PTIF fncptr; at the worst might have to give the return type &do a switch*/ 27 | int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/ 28 | fncptr = PTIF get_ptr(3); 29 | if((int)fncptr < 999) printf("[fncptr=%d]",(int)fncptr); /*return(0);*/ 30 | sprintf(str1,"%s",(char *)RtnLexeme(1)); 31 | sprintf(chr1,"%s",(char *)RtnLexeme(2)); 32 | sprintf(str2,"%s",(char *)RtnLexeme(4)); 33 | c1= chr1[0]; 34 | printf("[DefineFunction2 for:%s with type=%c]\n",str1,c1); 35 | if(RtnArgCount()>4) 36 | { 37 | sprintf(str3,"%s",(char *)RtnLexeme(5)); 38 | DefineFunction2(str1,c1,PTIF fncptr,str2,str3); 39 | } 40 | else DefineFunction(str1,c1,PTIF fncptr,str2); 41 | return(1); 42 | } 43 | /*if this could be done interactively then a compiled model could print out 44 | a batch file that would desribe all the fnc(in C) directly as clips fncs 45 | -it might still be a good idea to have instances to call the fncs 46 | it would at least save putting ifs in, allowing for direct calling*/ 47 | /*problem is turning the cmndline version of the fnc into the fnc ptr 48 | don't think it will work. the only way is if all the possible functions 49 | where compiled in extern&all, in a big switch -then there is the opt 50 | to make it a clips deffunction or if something is linked in use that 51 | ---could be done on arg types.. or vararg wrappers to Cfncs---??*/ 52 | 53 | /*could have any obj files print out the fnc ptrs in a SUBROUTINE inst 54 | then DF2 could be called with this #, as part of a handler call 55 | -this might even be able to done w/ fortran code w/out having to use f2c*/ 56 | /*start including val_ptr slots in the subroutines and try DF2 w/ this #*/ 57 | 58 | /*can at least use these fnc ptrs for some basic in C array ops*/ 59 | 60 | /*Don't need to use DF2, can just call using the ptr to the fnc/sub & 61 | all the ptrs to the args, (all wrapped in a fnc/sub clips inst)*/ 62 | 63 | /* DefineFunction2("cf0i"",'i',PTIF cf0i,"cf0i","11ii"); */ 64 | int 65 | cf0i() 66 | { 67 | int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/ 68 | int i; 69 | fncptr = PTIF get_ptr(1); 70 | printf("[cf0i:calling %d]\n",(int)fncptr); 71 | i=fncptr(); 72 | return(i); 73 | } 74 | /* DefineFunction2("cf0v"",'i',PTIF cf0v,"cf0v","11ii"); */ 75 | int 76 | cf0v() 77 | { 78 | void (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/ 79 | fncptr = VPTIF get_ptr(1); 80 | printf("[cf0v:calling %d]\n",(int)fncptr); 81 | fncptr(); 82 | return(1); 83 | } 84 | /*will want a version that can handle a arbitrary number of arg ptrs*/ 85 | 86 | /* (DF2 "tst" i tst "tst" "11ik"); */ 87 | /* (DF2 "srrf" i # "srrf" "00i"); */ 88 | int tst() { 89 | char str1[99]; 90 | sprintf(str1,"%s",(char *)RtnLexeme(1)); 91 | printf("[test fnc tst can print out:%s]\n",str1); 92 | return(1); 93 | } 94 | 95 | extern int ftst_(); 96 | 97 | int ctst() 98 | { 99 | printf("(ftst of FUNC (val_ptr %d))",(int)ftst_); 100 | fflush(stdout); 101 | } 102 | 103 | /*---------------------------------------------------------------USERFUNCTIONS*/ 104 | VOID UserFunctions() 105 | { 106 | #include "c-misc-defs.c" 107 | #include "c-pvm-defs.c" 108 | DefineFunction2("tpn_n_c",'i',PTIF tpn_n_c,"tpn_n_c","45ikuikk"); 109 | DefineFunction2("DF2",'i',PTIF DF2,"DF2","45iskuss"); 110 | DefineFunction2("cf0i",'i',PTIF cf0i,"cf0i","11ii"); 111 | DefineFunction2("cf0v",'v',PTIF cf0v,"cf0v","11ii"); 112 | DefineFunction2("ftst",'i',PTIF ftst_,"ftst","00i"); 113 | DefineFunction2("ctst",'i',PTIF ctst,"ctst","00i"); 114 | } 115 | /*----------------------------------------------------------------EOF*/ 116 | -------------------------------------------------------------------------------- /clp-pvm/clp/array.clp: -------------------------------------------------------------------------------- 1 | ;class lib and msg handlers for arrays=(values of params) M.Bobak,ANL 2 | ;-------------------------- 3 | ;-needs: util.clp 4 | ;-------------------------- 5 | ;might have some array stuff accessible through PARAM handlers? 6 | ;lambda-fncs would still be nice (maybe tcl or scheme)-(has array,vect too) 7 | ;output to hdf format for viewing, trans this way?,can do quick mat.calcs 8 | 9 | ;==============================================================ARRAY 10 | (defclass ARRAY 11 | (is-a ACCESSIBLE) 12 | (role concrete) 13 | (pattern-match reactive) 14 | (slot count (type INTEGER) ;number of this type of instance made 15 | (create-accessor read-write) (storage shared)) 16 | (slot fresh (default FALSE) ;if the array is newly filled 17 | (create-accessor read-write)) 18 | ;----------------------stuff for the array 0 to 3 dim 19 | (slot type (default f) ;type of the array value (i/f/d/s) 20 | (create-accessor read-write) (visibility public)) 21 | ; (multislot index (type INTEGER) (create-accessor read-write)) ;max array index 22 | (slot lang (type SYMBOL) (create-accessor read-write)) ;FORTRAN or C 23 | (slot x (type INTEGER) (default 1) ;1st dimension index 24 | (create-accessor read-write) (visibility public)) 25 | (slot y (type INTEGER) (default 1) ;2nd dimension index 26 | (create-accessor read-write) (visibility public)) 27 | (slot z (type INTEGER) (default 1) ;3rd dimension index 28 | (create-accessor read-write) (visibility public)) 29 | (slot num (type INTEGER) (default 1) ;num of elts 30 | (create-accessor read-write) (visibility public)) 31 | (slot size (type INTEGER) (default 1) ;num of elements * #bytes/element 32 | (create-accessor read-write) (visibility public)) ;can just calc 33 | (slot val_ptr (type INTEGER) ;long_int to point to value 34 | (create-accessor read-write) (visibility public)) 35 | ;----------------------if array a seperate class fill these 36 | ;for viewing & matching, which can be done with (param)arrays 37 | ;w/deamons can get and set val_ptr ed space, and update get/put-time 38 | (slot value ;first value (usually only if 111) 39 | (create-accessor read-write) (visibility public)) 40 | (multislot values ;first values (usually only if n11) 41 | (create-accessor read-write) (visibility public)) 42 | ) 43 | ;-----------------------------------------------------------GET-VALUE 44 | (defmessage-handler ARRAY get-value after () ;for debugging 45 | (printout t "[" (instance-name ?self) " v=" ?self:value "]")) 46 | 47 | (deffunction get-value (?p) ;or (slot-value ?p value) 48 | (if (slot-existp (class ?p) value) then (send ?p get-value) 49 | else (printout t "[WARNING:" ?p " does not have a value slot]")) ) 50 | (deffunction gv (?p) (slot-value ?p value)) 51 | (deffunction pv (?p ?v) (send ?p put-value ?v)) 52 | ;if get rid of value slot have these fncs, then hndlrs too 53 | ;(deffunction get-value (?p) (first (slot-value ?p values))) 54 | ;(deffunction put-value (?p ?val) (replace$ (slot-value ?p values) 1 1 ?val)) 55 | 56 | ;-------------------------------------------array INIT after 57 | (defmessage-handler ARRAY init after () 58 | (printout t ?self ",") 59 | (send ?self incr count) 60 | (bind ?self:num (* ?self:x ?self:y ?self:z)) 61 | (bind ?self:size (* ?self:num (typelen ?self:type))) 62 | (if (< ?self:val_ptr 999) then (bind ?self:val_ptr (imalloc ?self:size))) 63 | ; (if (or (and (instancep ?self:global-name) (neq ?self:global-name [nil])) 64 | ; (stringp ?self:global-name)) then 65 | ; (make-instance ?self:global-name of ARRAY 66 | ; (x ?self:x) (y ?self:y) (z ?self:z) 67 | ; (msgtag ?self:msgtag) (val_ptr ?self:val_ptr))) 68 | ) 69 | 70 | ;in the end it might not have the same val_ptr/msgtag-for printing 71 | 72 | ;-------------------------------------------(array)MPRINT 73 | (defmessage-handler ARRAY mprint primary () ;for debugging 74 | (ptag (nnn ?self:msgtag))) 75 | 76 | ;-------------------------------------------(array)PUT-INDEX 77 | (defmessage-handler ARRAY put-index ($?indx) ;sets indecies 78 | (bind ?self:x (first-dflt ?indx 1)) 79 | (bind ?self:y (second-dflt ?indx 1)) 80 | (bind ?self:z (third-dflt ?indx 1))) 81 | 82 | ;=======================================================ARRAY STUFF 83 | ;'arrays' can be from 0 to 3 dimensions, (single= 1 1 1) 84 | ;-------------------------------------------------------Deref Handlers 85 | (defmessage-handler ARRAY deref primary ($?nums) 86 | (if (<> (length$ ?nums) 0) then (funcall deref ?self:type ?self:val_ptr ?nums) 87 | else (deref ?self:type ?self:val_ptr))) 88 | ;------------------- 89 | (defmessage-handler ARRAY deref-off primary (?offset $?nums) 90 | (if (> ?offset ?self:size) then 91 | (printout t "WARNING:offset too large " ?offset crlf) (return nil)) 92 | (printout t "[deref-off " ?offset " makes " ?self:val_ptr " into " (+ ?self:val_ptr (* ?offset 4)) "," ?nums "]" crlf) 93 | (if (<> (length$ ?nums) 0) 94 | then (funcall deref ?self:type (+ ?self:val_ptr (* ?offset 4)) ?nums) 95 | else (deref ?self:type (+ ?self:val_ptr (* ?offset 4))))) 96 | ;right now type-size is hard-coded to 4 97 | ;------------------- 98 | (defmessage-handler ARRAY zero-to primary (?n) 99 | (loop-for-count (?i 0 ?self:num) do (send ?self deref-off ?i ?n))) 100 | ;------------------- 101 | (defmessage-handler ARRAY deref-off-n primary (?offset ?n) 102 | (bind ?top (+ ?offset ?n)) 103 | (bind ?l (create$ )) 104 | (loop-for-count (?i 0 ?n) do 105 | (printout t "[" (send ?self deref-off (- ?top ?i)) "]") 106 | (insert$ ?l 1 (send ?self deref-off (- ?top ?i)))) 107 | ?l) 108 | ;------------------- 109 | (deffunction add2 (?x ?y) (+ ?x ?y)) 110 | (deffunction sub2 (?x ?y) (- ?x ?y)) 111 | (deffunction div2 (?x ?y) (/ ?x ?y)) 112 | (deffunction mul2 (?x ?y) (* ?x ?y)) 113 | 114 | ;maybe ?fnc ?outarray $?array where they could be nums or array 115 | ;so array becomes a new wilder m.f. 116 | (defmessage-handler ARRAY deref-fnc2 primary (?fnc ?warray ?outarray $?off-n) 117 | (bind ?offset (first-dflt ?off-n 0)) 118 | (bind ?n (second-dflt ?off-n ?self:num)) 119 | (bind ?top (+ ?offset ?n)) 120 | (loop-for-count (?i ?offset ?top) do 121 | (send ?outarray deref-off ?i 122 | (funcall ?fnc (send ?self deref-off ?i) (send ?warray deref-off ?i))))) 123 | 124 | ;(get-nprcpk of SUBROUTINE 125 | ; (sub "(send [rainc] deref-fnc2 add2 [rainnc] [nprcpk])")) 126 | ;then (call [get-nprcpk]) to calculate it (do this in bats) rain(n)c state-vars 127 | ;------------------- 128 | (defmessage-handler ARRAY check-ptr primary () 129 | (if (< (nn ?self:val_ptr) 99) then 130 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return TRUE) 131 | else (return FALSE))) 132 | 133 | ;============================-----------------GET/PUT VALUE DEAMONS 134 | ;have a GET-value that does a get-value but gets it from the model 1st 135 | ;have a PUT-value that does a put-value then puts it into the model too 136 | ;--not needed in the same executable, as you are accessing the same space 137 | ;--------------------------------------------- 138 | ;could just make value a multislot, or just have/use value, for now 139 | ;if just have values, can have get/put-value just access the 1st one <-* 140 | 141 | ;-------------------------PUT after 142 | (defmessage-handler ARRAY put-value after ($?val) 143 | (if (< (nn ?self:val_ptr) 99) then 144 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil)) 145 | (if (> ?self:num 1) then 146 | (printout t crlf "[WARNING you are overwriting the 1st array element")) 147 | (bind ?self:put-time (elapse-time)) 148 | (printout t "[" (instance-name ?self) " put-v " (send ?self deref) "]") 149 | (send ?self deref ?val)) ;what put in value slot, goes in val_ptr space 150 | 151 | (defmessage-handler ARRAY put-values after ($?vals) 152 | (if (< (nn ?self:val_ptr) 99) then 153 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil)) 154 | (bind ?self:put-time (elapse-time)) 155 | (send ?self deref ?vals)) ;what put in values slot, goes in val_ptr space 156 | 157 | ;-------------------------GET before 158 | (defmessage-handler ARRAY get-value before () 159 | (if (< (nn ?self:val_ptr) 99) then 160 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil)) 161 | (bind ?self:value (send ?self deref)) ;get value from val_ptr space, &cache 162 | (printout t "[" (instance-name ?self) " get-v " ?self:value "]") 163 | (bind ?self:get-time (elapse-time))) 164 | 165 | (defmessage-handler ARRAY get-values before ($?n) 166 | (if (< (nn ?self:val_ptr) 99) then 167 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil)) 168 | (bind ?self:values (send ?self deref-n (first-dflt ?n 1))) 169 | (bind ?self:get-time (elapse-time))) 170 | ;get values from val_ptr space, &cache 171 | ;;;;------------------------------------------------------------- 172 | ;remeber the C deref fnc only takes a ptr & if it gets a number it sets it 173 | ;so to pick another array loc a handler has to recompute the ptr 174 | ;;;;------------------------------------------------------------- 175 | ;/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\-array com code (might change) 176 | ;-------------------------- 177 | ;-needs: util.clp & pvm.clp 178 | ;-------------------------- 179 | ;=======================================array COMMUNICATION (pvm) packing 180 | ;can send stride to pk_tpn too 181 | ;--------------------------------------------(un)packing using the tpn C fnc 182 | ;write a tpn fnc that takes an offset---------actually just alter the old 1 183 | (defmessage-handler ARRAY pack-it primary ($?n-off) ;then stride & binary-flag 184 | (bind ?n (first-dflt ?n-off ?self:num)) 185 | (bind ?off (second-dflt ?n-off 0)) 186 | (bind ?stride (third-dflt ?n-off 1)) 187 | (pk_tpn ?self:type ?self:val_ptr ?n ?off ?stride) 188 | (send ?self get-value)) 189 | 190 | (defmessage-handler ARRAY upack-it primary ($?n-off) 191 | (bind ?n (first-dflt ?n-off ?self:num)) 192 | (bind ?off (second-dflt ?n-off 0)) 193 | (bind ?stride (third-dflt ?n-off 1)) 194 | (pk_tpn (upcase ?self:type) ?self:val_ptr ?n ?off ?stride) 195 | ;(send ?self mprint) ;to have the FORTRAN model print out the arrays 196 | (make-fresh ?self) 197 | (send ?self get-value)) 198 | ;--------------------------------------------(un)packing using the pvm_(u)pkbyte 199 | (defmessage-handler ARRAY pack-byte primary ($?s) 200 | (bind ?s (first-dflt ?s ?self:size)) 201 | (printout t "[pack-byte " ?self:val_ptr ", " ?s "]") 202 | (pkbyte ?self:val_ptr ?s) 203 | (send ?self get-value)) 204 | 205 | (defmessage-handler ARRAY upack-byte primary ($?s) 206 | (bind ?s (first-dflt ?s ?self:size)) 207 | ;a version of unpkbyte that takes a ptr rather than returning 1 208 | (printout t "[upkbyte " ?self:val_ptr " " ?s " " ?self:size "]") 209 | (upkbyte ?self:val_ptr ?s) 210 | (make-fresh ?self) 211 | (send ?self get-value)) 212 | ;-------------------------------------------------------------------- 213 | ;think about making array's xyz write-once (unless want to realloc) 214 | ; but would be better to just make a new one and transfer the data 215 | ;;;;-------------------------------------------------------------EOF 216 | -------------------------------------------------------------------------------- /clp-pvm/clp/eval.clp: -------------------------------------------------------------------------------- 1 | ;-------fnc/hndlers to eval stuff on the other side MTB 2 | ;will need util.clp & pvm.clp (a send-str-to fnc) 3 | ;===================== 4 | ;----------------------------------------EVAL-SEND-TO 5 | (deffunction eval-send-to (?str ?task) 6 | (send-str-to (str-cat (eval ?str)) ?task)) 7 | 8 | ;will evaluate the string and turn the result into a strin & send it to ?task 9 | ;often called remotely to get a result back from an eval 10 | ;-more in eval.clp -all use send-str-to 11 | 12 | ;----------------------------------------SEND-BACK-TO 13 | (deffunction send-back-to (?str ?task $?to-opt) 14 | (bind ?to-task (first-dflt ?to-opt (mytid))) 15 | (send-str-to (quotes eval-send-to ?str ?to-task) ?task)) 16 | 17 | ;send a str ready for evaluation to task, it is eval-ed and the result is 18 | ; sent back in string form to your task (or optionally to another task). 19 | ;--make a send-back-to-param & eval-send-to-param (which sticks it in the value) 20 | 21 | ;===================== 22 | ;----------------------------------------------------EVAL-SEND-TO-ARRAY 23 | (deffunction eval-send-to-array (?str ?task ?array) 24 | (send-str-to (quotes send ?array put-value (eval ?str)) ?task)) 25 | 26 | ;(send-str-to (quote send ?array put-value (str-cat (eval ?str))) ?task) 27 | ;don't want string, but the real value now, make sure it's the right type 28 | 29 | ;will evaluate the string and turn the result into a strin & send it to ?task 30 | ; (& this version puts it in the value slot of the given array) 31 | ;often called remotely to get a result back from an eval 32 | 33 | ;----------------------------------------------------SEND-BACK-TO-ARRAY 34 | (deffunction send-back-to-array (?str ?task ?array) 35 | (send-str-to (quotes eval-send-to-array ?str (mytid) ?array) ?task)) 36 | 37 | ;?task could default to (mytid) so would always get sent back 38 | ;or the other side could do a bufinfo to see what the source is 39 | 40 | ;send a str ready for evaluation to task, it is eval-ed and the result is 41 | ; sent back in string form to your task. 42 | ; (& this version puts it in the value slot of the given array) 43 | ;---want to make sure that it puts in the correct type 44 | 45 | ;-might have a version that can send a mf back to the values slot 46 | ;-might have a version that lets you pick the slot to put it into -better 47 | 48 | ;===================== 49 | ;a version that 50 | ;lets you return the ?str eval-ed at ?task and put it in the ?slot of your ?ins 51 | 52 | ;----------------------------------------------------EVAL-SEND-TO-INS 53 | (deffunction eval-send-to-ins (?str ?task ?ins ?slot) 54 | (send-str-to (quotes send ?ins (sym-cat put- ?slot) (eval ?str)) ?task)) 55 | 56 | ;----------------------------------------------------SEND-BACK-TO-INS 57 | (deffunction send-back-to-ins (?str ?task ?ins ?slot) 58 | (send-str-to (quotes eval-send-to-ins ?str (mytid) ?ins ?slot) ?task)) 59 | 60 | ;=================================================================COPY routines= 61 | ;----------------------turn slot & value into a parened symbol 62 | (deffunction sv-sym (?ins ?sn) (quote ?sn (slot-value ?ins ?sn))) 63 | ;----------------------------------------------------COPY-NEW-INS-TO 64 | (deffunction copy-new-ins-to (?task ?ins $?sn-s) 65 | (if (not (instance-existp ?ins)) then 66 | (printout t "[WARNING: No " ?ins " in copy-ins-to]") (return nil)) 67 | (bind ?sns (if (eq (length ?sn-s) 0) then (slotnames ?ins) else ?sn-s)) 68 | (send-str-to 69 | (quotes make-instance ?ins of (class ?ins) (map2 sv-sym ?ins ?sns)) 70 | ?task)) 71 | ;----------------------------------------------------COPY-OLD-INS-TO 72 | (deffunction copy-old-ins-to (?task ?ins $?sn-s) 73 | (if (not (instance-existp ?ins)) then 74 | (printout t "[WARNING: No " ?ins " in copy-ins-to]") (return nil)) 75 | (bind ?sns (if (eq (length ?sn-s) 0) then (slotnames ?ins) else ?sn-s)) 76 | (send-str-to 77 | (quotes modify-instance ?ins of (class ?ins) (map2 sv-sym ?ins ?sns)) 78 | ?task)) 79 | ;later give another name to copy it too 80 | ;;;;------------------------------------------------------------- 81 | ;;;;-------------------------------------------------------------EOF 82 | 83 | -------------------------------------------------------------------------------- /clp-pvm/clp/lib.clp: -------------------------------------------------------------------------------- 1 | ;-------------------util fncs 2 | (deffunction s-atoi (?str) 3 | (if (or (null ?str) (eq ?str "")) then 0 else (atoi ?str))) 4 | ;(deffunction gn (?ins) (instance-name-to-symbol ?ins)) 5 | ;(deffunction gn (?ins) (sub-string 11 55 (str-cat (sym-cat ?ins)))) 6 | (deffunction gn (?ins) ?ins) ;just use instance-name 7 | ;=================================================================UPDATEABLE 8 | ;anything which is updated/ has a time-stamp /needs an explanation 9 | (defclass UPDATEABLE 10 | (is-a INITIAL-OBJECT) 11 | (role concrete) 12 | (pattern-match reactive) 13 | ;set these in advance 14 | (slot expl (type STRING) ;short description 15 | (create-accessor read-write) (visibility public)) 16 | (slot time (type INTEGER) ;time of last update 17 | (create-accessor read-write) (visibility public)) 18 | ;get/put deamons will update, so can be used for 'freshness'/matching 19 | (slot get-time (type INTEGER) ;time of last put bind 20 | (create-accessor read-write) (visibility public)) 21 | (slot put-time (type INTEGER) ;time of last get request 22 | (create-accessor read-write) (visibility public)) 23 | (slot fresh (default FALSE) ;if the proj is newly filled 24 | (create-accessor read-write)) 25 | ) 26 | ;-----------------------------------make-fresh 27 | (deffunction make-fresh (?p) 28 | (send ?p put-fresh TRUE) 29 | (if (slot-existp (class ?p) params) then 30 | (map1 make-fresh (send ?p get-params)))) 31 | ;will be done during an unpack & by running appropriate subs ? 32 | 33 | ;-------------------------------------------updateable INIT after 34 | (defmessage-handler UPDATEABLE init after () 35 | (bind ?self:time (round (elapse-time)))) 36 | ;------------------- 37 | ;=================================================================ACCESSIBLE 38 | ;------------------- 39 | ;used for any instance that will be transmitted between unix processes 40 | (defclass ACCESSIBLE 41 | (is-a UPDATEABLE) ; (is-a INITIAL-OBJECT) 42 | (role concrete) 43 | (pattern-match reactive) 44 | 45 | ;this will be even more of a numeric (rather than str) id, (no necc. msgtag) 46 | (slot msgtag (type INTEGER) ;the flag used in the model (vid,fid) 47 | (create-accessor read-write) (visibility public)) 48 | ;set at runtime 49 | (slot in-task ;task it is in 50 | (create-accessor read-write) (visibility public)) 51 | (slot in-tid (type INTEGER) ;task-id it is in ?? 52 | (create-accessor read-write) (visibility public)) 53 | (slot count (type INTEGER) ;number of this type of instance made 54 | (create-accessor read-write) (storage shared)) 55 | ) 56 | ;-------------------------------------------accessible INIT after 57 | (defmessage-handler ACCESSIBLE init after () 58 | (bind ?self:put-time (round (elapse-time))) 59 | (if (instance-existp ?self:in-task) then 60 | (printout t "[filling in-tid slot]") 61 | (bind ?self:in-tid (get-tid ?self:in-task)))) 62 | ;--------------------------------------------------------GET-TAG(s) 63 | (deffunction get-tag (?acc) ;send in and accessible|| tag get out a tag 64 | (if (numberp ?acc) then ?acc else (send ?acc get-msgtag))) 65 | 66 | (deffunction get-tags ($?accs) (map1 get-tag ?accs)) ;outputs the tags 67 | 68 | ;-------------------------------------------------------- 69 | ;keep simulated real time/ real clock time ratio -to see how its doing 70 | ;--------------------------------------------------------EOF 71 | -------------------------------------------------------------------------------- /clp-pvm/clp/mf.clp: -------------------------------------------------------------------------------- 1 | (defclass ConsCell 2 | (is-a INITIAL-OBJECT) 3 | (role concrete) 4 | (pattern-match reactive) 5 | 6 | (slot first (create-accessor read-write)) 7 | (slot rest (create-accessor read-write)) 8 | ) 9 | 10 | -------------------------------------------------------------------------------- /clp-pvm/clp/misc-fnc.clp: -------------------------------------------------------------------------------- 1 | ;misc-fnc.clp has various misc functions MTB 2 | ;----------------------------------------time etc 3 | (deffunction elapse-time () (- (time) ?*start-time*)) 4 | 5 | (deffunction rt () (round (time))) 6 | (deffunction rt1 () (round (/ (time) 10))) 7 | (deffunction rt2 () (round (/ (time) 100))) 8 | 9 | (deffunction debug (?level) (setopt 2 ?level)) ;sets it up for debugs 10 | (deffunction rr () (reset) (run 1) (agenda) (debug 1)) ;to start it up 11 | (deffunction e () (agenda) (exit_pvm) (exit)) ;exit in a clean way 12 | 13 | (deffunction ri (?file) (load-instances ?file)) 14 | (deffunction sleep (?t) (system (format nil "sleep %d" ?t))) 15 | 16 | (deffunction is () (initsend 1)) ;1=no encodeing,0=xdr (avoid 2 for strs) 17 | (deffunction bi () (bufinfo)) 18 | (deffunction rbi () (progn (recv_ -1) (bufinfo))) 19 | (deffunction lrbi (?i) (loop-for-count ?i (printout t (rbi) crlf))) 20 | 21 | ;----------------------------------------------------------------DEBUG FNCS 22 | (deffunction wa () (watch all)) 23 | (deffunction wmsg () (watch messages)) 24 | (deffunction whnd () (watch message-handlers)) 25 | (deffunction uwa () (unwatch all)) 26 | (deffunction wdf ($?fncs) (funcall watch deffunctions ?fncs)) 27 | (deffunction uwdf ($?fncs) (funcall unwatch deffunctions ?fncs)) 28 | (deffunction wmh ($?fncs) (funcall watch message-handlers ?fncs)) 29 | (deffunction uwmh ($?fncs) (funcall unwatch message-handlers ?fncs)) 30 | (deffunction insm (?class) (instances MAIN ?class)) 31 | (deffunction list-insts (?class) (instances MAIN ?class)) 32 | (deffunction list-insts-from (?class) (instances MAIN ?class)) 33 | ;might make a (wa) that takes extra args that would be fncs to (uwdf) 34 | ;---------------------------------------------------------------- 35 | (deffunction list ($?stuff) (create$ ?stuff)) 36 | ;(deffunction let* ($?l2) (map-skip 2 bind ?l2)) 37 | ;--------------------------------------------------------EOF 38 | -------------------------------------------------------------------------------- /clp-pvm/clp/param-lib.clp: -------------------------------------------------------------------------------- 1 | ;defn & msg-handlers for some of the PARAM class (has-a classes) MTB 2 | ;-sometimes what was a glob-pram will be made of a few of what where loc-params 3 | ; should references to them be sent along, or by transfering the 'glob-param' 4 | ; does it calc it from the locals, if they have been updated 5 | ;=========================================================projection_PARAMeter 6 | ;defclass PARAM in param.clp 7 | ;=================================================================GRID 8 | (defclass GRID 9 | (is-a ACCESSIBLE) 10 | (role concrete) 11 | (pattern-match reactive) 12 | (slot units (type SYMBOL) ;actuall units (eg: ft,mi,m,km,deg) 13 | (create-accessor read-write) (visibility public)) 14 | ;could take any 2 opposite corners, but this is easier for now 15 | (multislot corner-sw (type FLOAT) ;location of SW-lower corner 16 | (create-accessor read-write) (visibility public)) 17 | (multislot corner-ne (type FLOAT) ;location of NE-upper corner 18 | (create-accessor read-write) (visibility public)) 19 | (multislot delta (type FLOAT) ;length of delta-x-y-z segments 20 | (create-accessor read-write) (visibility public)) 21 | (multislot nseg (type INTEGER) ;# of segments (should=array's xyz) 22 | (create-accessor read-write) (visibility public)) 23 | ) 24 | ;deg would be in deg-min-sec, but can't do z this way 25 | ;will be able to have relation like subgrid-p & eq-sp-subgrid-p 26 | ;& fncs like grid-intersection & grid-union 27 | ;----------------------------------------------------------------- 28 | ;=================================================================UNITS 29 | ;SI base-units: meter, kilogram, second, ampere, Kelvin, mole, and candela 30 | ; length, mass, time, current, temprature, mole, illum 31 | ; l(m) m(kg) t(s) c(A) t(K) (M) Cnd 32 | ;force=newton=kg m / s s 33 | ;--might not need an instance for this? (more just standardization of names) 34 | (defclass UNITS ;name the instance w/ the basic-unit types (above order) 35 | (is-a ACCESSIBLE) 36 | (role concrete) 37 | (pattern-match reactive) 38 | (multislot units (type SYMBOL) ;actuall units (eg: ft / sec sec) orStr? 39 | (create-accessor read-write) (visibility public)) 40 | (multislot units-type (type SYMBOL) ;type equiv (eg: length / time time) 41 | (create-accessor read-write) (visibility public)) 42 | (multislot units-si (type SYMBOL) ;SI equiv (eg: m / sec sec) [7 types] 43 | (create-accessor read-write) (visibility public)) 44 | (multislot syn (type SYMBOL) ;list of eqv unit defns (use member$) 45 | (create-accessor read-write) (visibility public))) 46 | ;have all numerator terms a / then all the denominator terms 47 | ;----------------------------------------------------------------- 48 | ;=================================================================DESCRIPT 49 | ;(defclass DESCRIPT ;describe maybe hold constraints -ref? 50 | ; (is-a ACCESSIBLE) 51 | ; (role concrete) 52 | ; (pattern-match reactive) 53 | ;(slot journal (type INSTANCE) ;list of proceedures applied to the param 54 | ;(create-accessor read-write) (visibility public)) 55 | ;(slot constr (type INSTANCE) ;list of constraint instances 56 | ;(create-accessor read-write) (visibility public)) 57 | ;;maybe put these in contraint objs: 58 | ;(multislot range ;min & max of the values 59 | ; (create-accessor read-write) (visibility public)) 60 | ;(slot default ;default value for the array value(s) 61 | ; (create-accessor read-write) (visibility public))) 62 | ;for units ft/(sec sec), ft/sec sec, ft/sec/sec or num= ft den= sec sec 63 | ;range/default values could be another param-inst 64 | ; which could mean use its range/default slots or the sep vals of the array 65 | ;could have get-actual-min get-actual-max get-mean get-median <-for arrays 66 | ;dumping the normed values or histogram of val bins to a fuz-fact ? 67 | ;would be nice to make arrays a base clips obj -or not 68 | ;------------------------------------------------------------------ 69 | ;=================================================================CONSTR 70 | (defclass CONSTR ;constraints 71 | (is-a SUBROUTINE) 72 | (role concrete) 73 | (pattern-match reactive) 74 | ) 75 | ;use the constraint obj that updates slots/params/etc 76 | ;make it general, maybe like a subroutine, have good backup fncs 77 | ;--------------------------------------------------------------------------- 78 | ;---still want to have params which are composed of other params,so need map-fnc 79 | ;------------------- 80 | ;instead of mapping, just have full description which can be mapped between 81 | ; (multislot from-var (type SYMBOL) ;variable(s) mapped from (usually 1) 82 | ; (create-accessor read-write) (visibility public)) 83 | ; (slot to-var (type SYMBOL) ;variable mapped to 84 | ; (create-accessor read-write) (visibility public)) 85 | ;;;have to list the model separtely, if no proxy around 86 | ;;(multislot from-mod (type SYMBOL) ;model(s) mapped from (almost always 1) 87 | ; (create-accessor read-write) (visibility public)) 88 | ;;(slot to-mod (type SYMBOL) ;model mapped to 89 | ; (create-accessor read-write) (visibility public)) 90 | ; (slot map-fnc (type SYMBOL) ;fnc to map between them 91 | ; (create-accessor read-write) (visibility public)) ) 92 | ;------------------- 93 | ;Linda-like fncs/hndlers should be written around the param- 94 | ;------------------------------------------------------------------EOF 95 | -------------------------------------------------------------------------------- /clp-pvm/clp/param.clp: -------------------------------------------------------------------------------- 1 | ;defn & msg-handlers for the PARAM class MTB 2 | ;-sometimes what was a glob-pram will be made of a few of what where loc-params 3 | ; should references to them be sent along, or by transfering the 'glob-param' 4 | ; does it calc it from the locals, if they have been updated 5 | 6 | ;be able to mark if the array is in a model or malloced 7 | ;& if that array is in fortran or C format 8 | 9 | ;=========================================================projection_PARAMeter 10 | (defclass PARAM 11 | (is-a ACCESSIBLE) 12 | (role concrete) 13 | (pattern-match reactive) 14 | (slot count (type INTEGER) ;number of this type of instance made 15 | (create-accessor read-write) (storage shared)) 16 | ;---------------------------------------------------------------has-a instances 17 | ;---------------------description of gridding of data 18 | (slot grid (type INSTANCE) ;inst w/gridding info 19 | (create-accessor read-write) (visibility public)) 20 | ;---------------------description of gridding of data 21 | (slot units (type INSTANCE) ;inst w/units info 22 | (create-accessor read-write) (visibility public)) 23 | ;---------------------holds the array (is in array.clp) 24 | (slot array (type INSTANCE) ;inst w/memory &assoc descript 25 | (create-accessor read-write) (visibility public)) 26 | ;---------------------holds the constraint instances 27 | (multislot cnstrs (type INSTANCE) 28 | (create-accessor read-write) (visibility public)) 29 | ;---------------------holds the process/sub instances which act of the inst 30 | ;=have the lists only be for the current & last simulation timesteps 31 | ;(finest grain or diferrent in each model- except for reasoning) 32 | ;-can use something like journal to show the goal state params 33 | ; or state at the begin/end of any process (as the annotation) 34 | ;This annotation will have to use the abstract process name (eg. [srfx]) 35 | (multislot journal (type INSTANCE) ;would be nice to also add the time 36 | (create-accessor read-write) (visibility public)) 37 | (multislot journal-time (type INTEGER) ;time of the journal entry 38 | (create-accessor read-write) (visibility public)) 39 | (multislot journal-use (type INTEGER) ;used as in out in-out 40 | (create-accessor read-write) (visibility public)) ;assume only 'out'? 41 | ;-journal might get really long quickly with looping 42 | ; easier to keep a journal of calls, & then reconstruct the params-touched ? 43 | ;;---------------------description of type of data (meaning??) 44 | ; (slot descript (type INSTANCE) ;might hold constraints 45 | ; (create-accessor read-write) (visibility public)) 46 | ;----------------------------------------------------------------extra val rep?? 47 | ;for viewing & matching, which can be done with (param)arrays 48 | ;w/deamons can get and set val_ptr ed space, and update get/put-time 49 | (slot value ;first value (usually only if xyz=111)?? 50 | (create-accessor read-write) (visibility public)) 51 | (multislot values ;first values(usually only if xyz=n11)?? 52 | (create-accessor read-write) (visibility public))) 53 | ;if copy over all the slots, then the refered to instances latter, they can 54 | ; be chekced with a sim-time stamp, and the value(s) slot too 55 | ;----------------------------------------------------------------- 56 | ;constraints checked when the value is updated (maybe for get/put seperately) 57 | ; might have w/>1 param so put in each to be 2way 58 | ;----------------------------------------------------------------- 59 | ;use descriptive/(standard) names (so could even do defaults from the name) 60 | ;defclass GRID in param-lib.clp 61 | ;defclass UNITS in param-lib.clp 62 | ;defclass CONSTR in param-lib.clp 63 | ;defclass ARRAY in array.clp 64 | ;if copy param to another task,refer to has-a as needed,use in-task slot to find 65 | ;------------------------------------------------------------------ 66 | (defmessage-handler PARAM pack-it primary ($?n-off) 67 | (send ?self:array pack-it ?n-off)) 68 | (defmessage-handler PARAM upack-it primary ($?n-off) 69 | (send ?self:array upack-it ?n-off)) 70 | ;------------------- 71 | ;Linda-like fncs/hndlers should be written around the param- 72 | ;------------------------------------------------------------------EOF 73 | -------------------------------------------------------------------------------- /clp-pvm/clp/proj.clp: -------------------------------------------------------------------------------- 1 | ;defn & msg-handlers for the PROJ class MTB 2 | ;=================================================================PROJection 3 | (defclass PROJ 4 | (is-a ACCESSIBLE) 5 | (role concrete) 6 | (pattern-match reactive) 7 | (slot from (type INSTANCE) ;where is comes from ?? 8 | (create-accessor read-write)) 9 | (slot to (type INSTANCE) ;where is goes to ?? 10 | (create-accessor read-write)) 11 | (slot for (type INSTANCE) ;what subroutine gets called after ?? 12 | (create-accessor read-write)) ;it gets this data (redo so data-driven) 13 | (multislot params ;(default (create$)) ;param instances which hold values 14 | (create-accessor read-write) (visibility public)) 15 | ) 16 | ;----------------------------------------------------- 17 | 18 | ;-----------------------------------------------------proj SEND-TO 19 | ;pack the upk cmd in a string then pack all the params 20 | ;(map1 pack-byte ?self:params ?tid) ;then one send 21 | 22 | ;-----------------------------------------------------(U)PK-(G)-PARAM 23 | (deffunction pk-param (?param) (send (send ?param get-array) pack-byte)) 24 | (deffunction upk-param (?param) (send (send ?param get-array) upack-byte)) 25 | 26 | ;----------------------------------------------------send-to 27 | ;(defmessage-handler PROJ send-to primary (?task) 28 | ; (if (< (length ?self:params) 1) then 29 | ; (printout t "[WARNING: PROJ send-to has no params " ?self:params "]")) 30 | ; (initsend 1) 31 | ;;need to have params stay a mf, but can't (quote (quote)) w/out messed up "" 32 | ; (pkstr (quotes map1 upk-param (quote create$ ?self:params))) 33 | ; (map1 pk-param ?self:params) 34 | ; (send_0 ?task)) 35 | ; 36 | ;(defmessage-handler PROJ send_to_n primary (?task) 37 | ; (initsend 1) 38 | ; (pkstr (quotes apply-2 send (quote create$ ?self:params) upack-n)) 39 | ; (apply-2 send ?self:params pack-n) 40 | ;;this is more like mark's proj-param-array send 41 | ;;(pkstr (quotes apply-2 send (quote create$ ?self:params) upack-byte)) 42 | ;;(apply-2 send ?self:params pack-byte) 43 | ; (send_0 ?task)) 44 | ;then the trecv-eval loop on the other side will get the string & upk the params 45 | ;assumes the glob params are set up the same on the other side 46 | ;the string that is sent along, runs upk-param which can updates/touchs the inst 47 | ;this is more efficient than the presend deem++send, so it should be reworked 48 | 49 | ;----------------------------------------------------proj SEND_TO 50 | (defmessage-handler PROJ send_to primary (?task $?opt) 51 | (initsend 1) 52 | (pkstr (quotes apply-2 send (quote create$ ?self:params) upack-it ?opt)) 53 | (apply-2 send ?self:params pack-it ?opt) 54 | (send_0 ?task)) 55 | 56 | ;then the trecv-eval loop on the other side will get the string & upk the params 57 | ;---------------------- 58 | ;----------------------------------------------------GET_FROM 59 | ;(defmessage-handler PROJ get_from primary (?task $?to-opt) 60 | ; (bind ?to-task (first-dflt ?to-opt (mytid))) (initsend 1) 61 | ; (pkstr (quotes send ?self send_to ?to-task ?to-opt)) 62 | ; (send_0 ?task)) ;this only works if that proj is on the other side 63 | ;could do (send [clim-to-bats-init-proj] get_from [clim] [bats]) 64 | ;if could assume the proper proj was there (could copy it) 65 | 66 | ;do by using a send_to for PARAM 67 | (defmessage-handler PROJ get_from primary (?task $?opt) 68 | (initsend 1) 69 | (pkstr (quotes apply-2 send (quote create$ ?self:params) send_to (mytid) ?opt)) 70 | (send_0 ?task)) ;this only works if params are on the other side 71 | 72 | ;(pkstr (quotes apply-2 send (quote create$ ?self:params) pack-it ?opt)) 73 | ;(apply-2 send ?self:params pack-it ?opt) 74 | 75 | ;param version of eval-send-to & send-back-to (in eval.clp) 76 | ;---------------------------------------------------- 77 | ;probably have to reconfigure to synch w/ st 78 | ;----------------------------------------------------EOF 79 | -------------------------------------------------------------------------------- /clp-pvm/clp/pvm.clp: -------------------------------------------------------------------------------- 1 | ;start of pvm clips code, Mike B. ;-needs:util.clp 2 | 3 | ;-------------------send/recv functions 4 | ;----------------------------------------send-str 5 | ;general send a string to a task w/ tid (takes an int||task & string, w/opt int) 6 | (deffunction send-str (?task ?str $?msgtag) 7 | (initsend 0) 8 | (if (and (integerp (bind ?tid (get-tid ?task))) (lexemep ?str)) then 9 | (pkstr ?str) ;might use stringp 10 | (send_ ?tid (first-dflt ?msgtag 0)) 11 | else (printout t "[bad send-str " ?task ", " ?str "]"))) 12 | ;----------------------------------------send-str-to 13 | ;(deffunction send-str-to (?str ?task) 14 | ; (initsend 1) 15 | ; (if (and (integerp (bind ?tid (get-tid ?task))) (stringp ?str)) then 16 | ; (pkstr ?str) (send_ ?tid 0) 17 | ; else (printout t "[bad send-str-to " ?task ", " ?str "]"))) 18 | 19 | ;----------------------------------------send_0 20 | ;(deffunction send_0 (?task) 21 | ; (if (integerp (bind ?tid (get-tid ?task))) then (send_ ?tid 0) 22 | ; else (printout t "[bad send_0 " ?tid "]"))) 23 | ;task can be a task-inst a tid or a group-string, msgtag will=0 24 | (deffunction send_0 (?task) 25 | (if (integerp (bind ?tid (get-tid ?task))) then (send_ ?tid 0) 26 | else (if (stringp ?task) then (bcast ?task 0) 27 | else (printout t "[bad send_0 " ?tid "]")))) 28 | 29 | ;----------------------------------------SEND-STR-TO 30 | (deffunction send-str-to (?str $?tasks) 31 | (initsend 1) 32 | (if (stringp ?str) then (pkstr ?str) (map1 send_0 ?tasks) 33 | else (printout t "[bad send-str-to " ?tasks ", " ?str "]"))) 34 | 35 | 36 | ;----------------------------------------send-str-to-deem 37 | ;(deffunction send-str-to-deem (?str) 38 | ; (initsend 1) (pkstr ?str) (bcast "deem" 0)) 39 | ;----------------------------------------send-str-to-models 40 | ;(deffunction send-str-to-models (?str) 41 | ; (initsend 1) (pkstr ?str) (bcast "models" 0)) 42 | 43 | ;---------------------------------------------------(u)pk strings by bytes 44 | (deffunction pkstrb (?str) 45 | (bind ?l (+ (str-length ?str) 1)) 46 | (printout t "[pkstrb of len=" ?l "]") 47 | ;(free (pkbyte (deref b (imalloc ?l) ?str) ?l)) 48 | (pkbyte (deref b (imalloc ?l) ?str) ?l)) 49 | ;------------------- 50 | ;(deffunction upkstrb (?l) (deref b (upkbyte (imalloc ?l) ?l))) 51 | (deffunction upkstrb (?l) 52 | (bind ?p (imalloc ?l)) 53 | (printout t "[upkstrb of len=" ?l "into " ?p "]") 54 | (bind ?p2 (upkbyte ?p ?l)) 55 | (printout t "final ptr=" ?p2) 56 | (deref b ?p2)) 57 | ;------------------- 58 | ;----------------------------------------send-cl 59 | ;general send a string to a task w/ tid (takes an int & string) 60 | ;pkbyte for sends to fortran, probably won't be used 61 | (deffunction send-cl (?tid ?str ?len) 62 | (initsend 0) 63 | (pkbyte ?str ?len) 64 | (send_ ?tid 1)) 65 | 66 | (deffunction send-c (?tid ?str) 67 | (send-cl ?tid ?str (str-length ?str))) 68 | 69 | ;----------------------------------------TRECV_EVAL 70 | ;timed receive, which expects a string, and will evaluate it. 71 | (deffunction trecv_eval ($?time) 72 | (bind ?t (first-dflt ?time 10)) 73 | (if (<> (trecv -1 0 ?t) 0) then ;(eval (upkstr)) 74 | (bind ?str (upkstr)) 75 | (if (lexemep ?str) then (eval ?str) 76 | else (printout t "[bad trecv_eval:" ?str "]")) 77 | )) 78 | ;----------------------------------------recv-eval 79 | ;general receive any string and eval it (run this periodically) 80 | (deffunction recv-eval ($?tid) 81 | (recv_ (first-dflt ?tid -1) 0) 82 | (eval (upkstr))) 83 | ;-------------------------------------------------EOF 84 | -------------------------------------------------------------------------------- /clp-pvm/clp/rul.clp: -------------------------------------------------------------------------------- 1 | ;-----------------------------------------------------new: 2 | (defclass TID ;task obj id ;mirror globals for now 3 | (is-a INITIAL-OBJECT) 4 | (role concrete) (pattern-match reactive) 5 | (slot tid (type INTEGER) (create-accessor read-write)) ;task id ([inst] or int id) 6 | (slot pid (type INTEGER) (create-accessor read-write)) ;parent task id ([inst] or int id) 7 | (slot start-time (type FLOAT) (create-accessor read-write)) ;also was a global ;try diff type 8 | (slot recv-d-time (type INTEGER) (create-accessor read-write)) ;also was a global ;does it change w/time? 9 | (slot elapse-time (type FLOAT) (create-accessor read-write)) ;was a fact 10 | (slot model (type INTEGER) (create-accessor read-write)) ;also was a global 11 | (multislot inst-tids (create-accessor read-write)) ;also was a global 12 | ) 13 | ;------------------------------------------------RULES 14 | ;the first rule to run (goes only once/reset), 15 | ;sets globals & some other stuff. 16 | (defrule startup-TIME 17 | (initial-fact) 18 | => 19 | ;(add_nrcv_route) 20 | ;(assert (TIME (rt2))) 21 | (assert (TIME 0.0)) 22 | (bind ?*my-tid* (mytid)) 23 | (bind ?*parent-tid* (parent)) 24 | (printout t " mytid= " ?*my-tid* crlf) 25 | (bind ?*start-time* (time)) 26 | ;-new 27 | (make-instance mytid of TID ;new 28 | (start-time ?*start-time*) 29 | (tid ?*my-tid*) 30 | (pid ?*parent-tid*) 31 | ) 32 | ;(send [mytid] put-start-time ?*start-time*) 33 | ;(send [mytid] put-tid ?*my-tid*) 34 | ;(send [mytid] put-pid ?*parent-tid*) 35 | ; 36 | ;(make-tasks) ;set up the TASK instances 37 | ;(bcast-str (tasks ?*my-tid*)) ;make sure others get this new 1 38 | (initsend) 39 | (agenda) 40 | ) 41 | 42 | ;the problem is after the 1st time test fails, it is never checked again 43 | ;until the fact chages, (could try tick tock w/ nrecv_rout) 44 | 45 | ;updates the time, and does receives of command-strings 46 | (defrule UPDATE-TIME 47 | (declare (salience -50)) ;could go up w/time 48 | ?t <- (TIME ?old-time) 49 | ; (test (neq (rt2) ?old-time)) 50 | => 51 | (printout t "UT=" (rt2) " ") 52 | ;(if (not (nrecv_route)) then (system "sleep 1")) 53 | (trecv_eval ?*recv-d-time*) 54 | (send [mytid] put-recv-d-time ?*recv-d-time*) ;new 55 | (send [mytid] put-elapse-time (elapse-time)) ;new 56 | (retract ?t) 57 | ;(assert (TIME (rt2))) 58 | ;(assert (TIME (- (time) ?*start-time*))) 59 | (assert (TIME (elapse-time))) 60 | (agenda) 61 | ) 62 | ;-------------------------------------------------context rules 63 | ;;;;;;--this is out of date, latest work is in the tmp rul files 64 | ;(deffunction find-pp (?ppname) 65 | ; (find-instance (?pp PROVIDED-PARAM) 66 | ; (eq ?pp:gname ?ppname))) 67 | ;fix for all.clp -mb ;no class or gname elsewhere, glenda, howto-fix? ;also not called 68 | (defclass PROVIDED-PARAM ;add this, as this file was probably lost. 69 | (is-a PARAM) ;(is-a ACCESSIBLE) 70 | (role concrete) 71 | (pattern-match reactive) 72 | (slot gname (create-accessor read-write)) ;maybe w/glenda? 73 | ) ;it is used in 'inputs' slot below, so there was even a produced|similar subclass? 74 | (defclass PROCESS ;add this, as this file was probably lost, which really sucks. -mb 75 | (is-a ACCESSIBLE) 76 | (role concrete) 77 | (pattern-match reactive) 78 | (multislot inputs (create-accessor read-write)) ; 79 | (multislot outputs (create-accessor read-write)) ; 80 | (multislot comp-proc (create-accessor read-write)) ; 81 | ) 82 | (deffunction find-pp (?ppname) 83 | (find-instance ((?pp PROVIDED-PARAM)) 84 | (eq ?pp:gname ?ppname))) 85 | (deffunction maprm (?l1 ?l2) (set-difference ?l1 ?l2)) ;just a guess right now-mb 86 | ;-------------------------------------------------FIND-PROC-PROVIDES 87 | (defrule FIND-PROC-PROVIDES 88 | (declare (salience 5)) ;doing before make-proc-chunks could save time? 89 | ?p1 <- (object (is-a PROCESS) (inputs ?in1) ;mved a paren back up-mb 90 | (outputs ?out1) 91 | (comp-proc ?cp1)) 92 | => 93 | ;(map1 find-pp ?in1) ;gives a list of params that are provided for the proc 94 | ;this process's params should then be marked as being available 95 | ; and can be taken out of the active input list 96 | ;-would be good to save the old list or mark as not matchable 97 | (send ?p1 put-inputs (maprm (map1 find-pp ?in1) ?in1)) 98 | ) 99 | ;-------------------------------------------------MAKE-PROC-CHUNKS 100 | ;make a process out of 2 processes (refire till no more chunking/its usable) 101 | (defrule MAKE-PROC-CHUNKS 102 | ?p1 <- (object (is-a PROCESS) (inputs $?in1) 103 | (outputs $?out1) 104 | (comp-proc $?cp1)) 105 | ?p2 <- (object (is-a PROCESS) (inputs $?in2) 106 | (outputs $?out2) 107 | (comp-proc $?cp2)) 108 | (test (and (neq ?p1 ?p2) ;not combining the same process 109 | (not (member$ ?p1 ?cp2)) ;process not alread a component 110 | (not (member$ ?p2 ?cp1)) ; of a (chunked) process 111 | (null-lv (intersection ?cp1 ?cp2)))) 112 | => 113 | (bind ?int1to2 (intersection ?in1 ?out2)) ;calc any out to input matches 114 | (bind ?int2to1 (intersection ?in2 ?out1)) 115 | ;if there are any make a chunked process 116 | (if (full-lv ?int1to2) then (make-instance 117 | (sym-cat (instance-name ?p1) - (instance-name ?p2)) 118 | of PROCESS 119 | (inputs (union- ?in1 (set-difference ?in2 ?int1to2))) 120 | (outputs (union- ?out1 ?out2)) 121 | (comp-proc (create$ ?p1 ?p2 ?cp1 ?cp2)))) 122 | (if (full-lv ?int2to1) then (make-instance 123 | (sym-cat (instance-name ?p2) - (instance-name ?p1)) 124 | of PROCESS 125 | (inputs (union- ?in2 (set-difference ?in1 ?int2to1))) 126 | (outputs (union- ?out2 ?out1)) 127 | (comp-proc (create$ ?p2 ?p1 ?cp2 ?cp1)))) 128 | ) 129 | ;inputs are all of the first ones and of of the 2nd except what the 1st provieds 130 | ;outputs are the combined outputs (even though used, still available-branch out) 131 | ;comprised proceedures are the 2 put together & all of there comp-proc s 132 | ;------------------------------------------------- 133 | ;(sym-cat (format nil "%s-%s" (instance-name ?p1) (instance-name ?p2))) 134 | ;-------------------------------------------------EOF 135 | 136 | -------------------------------------------------------------------------------- /clp-pvm/clp/sub.clp: -------------------------------------------------------------------------------- 1 | ;=================================================================SUBROUTINE 2 | ;-------can be similar to Lambda Fncs (but no args as of yet)<-(objs for now)* 3 | ;used to hold the information on how to run a subroutine in a model 4 | ;can include the variables that need to be current to run, and the ones wich 5 | ;will be updated/or returned when the subroutine is finished 6 | (defclass SUBROUTINE 7 | (is-a ACCESSIBLE) 8 | (role concrete) 9 | (pattern-match reactive) 10 | (slot sub ;subroutine code to eval 11 | (create-accessor read-write)) 12 | 13 | (slot busy (default FALSE) ;wether the subroutine is busy 14 | (create-accessor read-write)) 15 | 16 | (slot val_ptr (type INTEGER) ;LOC(sub-name) 17 | (create-accessor read-write)) ;to be used by DF2 18 | (multislot args (type INSTANCE) ;instances it will be called w/ 19 | (create-accessor read-write)) ; used to get arg typ/ptrs &#? 20 | 21 | ;might not use these-----------------get more data dict 22 | (multislot vars-needed (type INSTANCE) ;vars used /needed 23 | (create-accessor read-write)) ;can check if updated 24 | (multislot proj-needed (type INSTANCE) ;vars used /needed 25 | (create-accessor read-write)) ;can check if updated 26 | (multislot sub-needed (type INSTANCE) ;vars used /needed 27 | (create-accessor read-write)) ;can check if updated 28 | (slot count (type INTEGER) ;number of this type of instance made 29 | (create-accessor read-write) (storage shared)) 30 | ) ;even id/fid/msgtag because nothing is returned 31 | ;-------------------------------------------subroutine INIT after 32 | (defmessage-handler SUBROUTINE init after () 33 | ; (if (and (stringp ?self:expl) (neq ?self:expl "")) then 34 | ; (printout t "[ " ?self:expl " ]")) 35 | (printout t ?self ",")) 36 | 37 | ;------------------------------------make-busy 38 | (deffunction make-busy (?sub) 39 | (send ?sub put-busy TRUE)) 40 | 41 | ;------------------------------------------------------CALL 42 | (defmessage-handler SUBROUTINE call primary () 43 | (if (stringp ?self:sub) then 44 | (if (and (stringp ?self:expl) (neq ?self:expl "")) then 45 | (printout t "[ " ?self:expl " ]")) 46 | (eval ?self:sub) 47 | else 48 | (printout t "[call->ptag " ?self:msgtag "]") 49 | (ptag ?self:msgtag) 50 | )) 51 | 52 | (deffunction call-a-sub (?sub) 53 | (if (not (instance-existp ?sub)) then 54 | (printout t "[WARNING: sub:" ?sub " not there]") 55 | (return nil) 56 | else 57 | (printout t "[sub:" ?sub "]") 58 | (send ?sub call))) 59 | 60 | ;takes a list of subs and send the call msg to them 61 | (deffunction call ($?subs) 62 | (apply-1 call-a-sub ?subs)) 63 | 64 | 65 | ;------------------------------------rcall 66 | (deffunction rcall (?task $?subs) 67 | (send-str-to (quotes call ?subs) ?task) 68 | (map1 make-busy ?subs)) 69 | 70 | ;=====================================================FUNCTION 71 | ;similar to a subroutine instance, but has a specific return value to look at 72 | (defclass FUNCTION 73 | (is-a SUBROUTINE) 74 | (role concrete) 75 | (pattern-match reactive) 76 | (multislot ret-value ;a 'future' to be filled latter 77 | (create-accessor read-write)) 78 | ) 79 | ;-------------------a handler should construct the ret val send 80 | ;(quote send-str ?self:sub ?*my-tid*) 81 | ;will use: (send-back-to-param ?str ?task ?param) 82 | ;where the string gets eval-ed on the other side and 83 | ; the resulting value (not str) is put into the param's value slot 84 | 85 | ;------------------------------------------------------------------ 86 | ;------------------------------------------------------------------EOF 87 | -------------------------------------------------------------------------------- /clp-pvm/clp/task.clp: -------------------------------------------------------------------------------- 1 | ;start of pvm clips task code, Mike B. ;-needs:util.clp 2 | (defglobal ?*my-tid* = 0) 3 | (defglobal ?*parent-tid* = 0) 4 | (defglobal ?*model* = 0) ;compiled w/ the model, or talking to it 5 | (defglobal ?*inst-tids* = (create$ )) ;tids of all the task instances 6 | (defglobal ?*start-time* = 0) 7 | (defglobal ?*recv-d-time* = 10) 8 | ;------------------------------------------------util 9 | ;(deffunction elapse-time () (- (time) ?*start-time*)) in misc-fnc.clp 10 | (deffunction elapse-time () (- (time) ?*start-time*)) ;in misc-fnc.clp 11 | (deffunction upk1int () (upkint)) 12 | 13 | ;holds the information on how to contact another unix process on the 14 | ;virtual machine (note: pvm's virtual machine can include many machines) 15 | (defclass TASK 16 | (is-a INITIAL-OBJECT) 17 | (role concrete) (pattern-match reactive) 18 | (slot init-time (create-accessor read-write)) 19 | (slot active (create-accessor read-write)) 20 | (slot tid (create-accessor read-write)) 21 | (slot tpid (create-accessor read-write)) 22 | (slot host (create-accessor read-write)) 23 | (slot flag (create-accessor read-write)) 24 | ;(multislot msgtags (create-accessor read-write)) ;tags of possible interest 25 | (slot global-name ;(type INSTANCE) 26 | (create-accessor read-write) (visibility public)) 27 | (slot Name (create-accessor read-write))) 28 | 29 | ;a type of task which will be a clips process which controls a model 30 | (defclass CNTRL-TASK 31 | (is-a TASK) 32 | (role concrete) (pattern-match reactive) 33 | (slot init-time (create-accessor read-write))) 34 | 35 | ;a type of task which will be the actual FORTRAN/C(++) model 36 | (defclass MODEL-TASK 37 | (is-a TASK) 38 | (role concrete) (pattern-match reactive) 39 | (slot init-time (create-accessor read-write))) 40 | 41 | ;send-str (implode$ (local-slotnames ?inst)) 42 | ;send-str (implode$ (slot-local-values ?inst)) 43 | ;can use to-str & to-pstr=quote now for any list of args 44 | 45 | ;-------------------------------------------------------send_to_tasks 46 | ;so can send whatever is packed up to many different tasks 47 | ;can use mcast too, or bcast & a group name 48 | (deffunction send_to_tasks ($?tasks) 49 | ;(map2 send_ (map1 get-tid ?tasks) 0) 50 | ;(map2 send_0 ?tasks) ;in my orig file 51 | (map2 send_0 ?tasks 0) ;a guess at a fix, mb 52 | ) 53 | 54 | ;-------------------------------------------------------GET-TID 55 | (deffunction get-tid (?task) 56 | (if (numberp ?task) then ?task 57 | else (if (instancep ?task) then (send ?task get-tid) 58 | else (printout t "[get-tid:bad-arg " ?task "]")))) 59 | ;(if (numberp ?task) then ?task else (send ?task get-tid)) 60 | ; else if (stringp ?task) then return all the tids 61 | 62 | ;-------------------TASK msg handlers----------------- 63 | ;-------------------send/recv handlers 64 | 65 | ;(deffunction send-str-to (?str $?tasks) 66 | ; (printout t "[send-str to defined below]")) 67 | (deffunction send-str-to (?str $?tasks) 68 | (printout t "[send-str to defined below]")) 69 | ;------------------------------------------------------task EVAL 70 | ;take the args make into a parened string, and send to task for evaluation 71 | ;(defmessage-handler TASK eval primary ($?args) 72 | ; (send-str-to (quotes ?args) ?self)) 73 | 74 | ;-------------------TASK init handler ------------- 75 | ;makes sure that a newly created task has many of its slots filled in. 76 | (defmessage-handler TASK init after () 77 | (send ?self put-init-time (elapse-time)) 78 | ;if active slot isn't set, the task is waiting (by default) 79 | ;if spawned or gotton from tasks it should be set to active (if it is) 80 | ;flag has some of that status info 81 | (if (not (symbolp ?self:active)) then (send ?self put-active waiting)) 82 | ;set host if not set 83 | (if (and (numberp ?self:tid) (not (numberp ?self:host))) then 84 | (send ?self put-host (tidtohost ?self:tid))) 85 | (insert$ ?*inst-tids* 1 ?self:tid) 86 | 87 | ;if there is a global-name for the task make that inst w/ the same tid 88 | (if (or (and (instancep ?self:global-name) (neq ?self:global-name [nil])) 89 | (stringp ?self:global-name)) then 90 | (make-instance ?self:global-name of TASK (tid ?self:tid))) 91 | ) 92 | 93 | (defmessage-handler TASK get-tid before () 94 | (if (null ?self:tid) then (printout t "[" ?self " has no tid, so put-tid]"))) 95 | 96 | 97 | ;--ADD-TASK (takes 2 strings & and int right now) 98 | ;makes an instance of a task 99 | (deffunction add-process (?name ?where ?tid) 100 | (make-instance (sym-cat task- ?name - ?tid) of TASK 101 | (tid ?tid) 102 | (host ?where) 103 | (Name ?name))) 104 | 105 | ;--MAKE-TASK (takes 2 strings right now) 106 | ;makes an instance of a task 107 | (deffunction make-process (?name ?where) 108 | (bind ?tid 109 | (spawn ?name "(load pvm-agt)" 1 ?where (if (stringp ?where) then 1 else 0)) ) 110 | (add-process ?name ?where ?tid)) 111 | ;latter will just incr the #, and use the tid slot for sends 112 | 113 | ;might still want something like above, so when you have a task/spawn it 114 | ;that the rest of the (tasks tid) info can be parsed into the new instance 115 | 116 | ;------------------------------------------------------task EVAL 117 | ;take the args make into a parened string, and send to task for evaluation 118 | (defmessage-handler TASK eval primary ($?args) 119 | (send-str-to (quotes ?args) ?self)) 120 | ;------------------------------------------------------ 121 | ;------------------------------------------------------OID 122 | (defclass OID ;obj id (~= cORB-NAME) 123 | (is-a INITIAL-OBJECT) 124 | (role concrete) (pattern-match reactive) 125 | (slot tid (create-accessor read-write)) ;task id ([inst] or int id) 126 | (slot iid (create-accessor read-write)) ;inst id ([inst] or str id) 127 | (slot orb-name (create-accessor read-write))) ;name given by naming service 128 | ;to have a globally seperate name, need 1 naming service 129 | ;either inst-name or orb-name slot should be unique 130 | ;-----------------------------------------------------new: 131 | ;(defclass TID ;task obj id ;mirror globals for now 132 | ; (is-a INITIAL-OBJECT) 133 | ; (role concrete) (pattern-match reactive) 134 | ; (slot tid (type INTEGER) (create-accessor read-write)) ;task id ([inst] or int id) 135 | ; (slot pid (type INTEGER) (create-accessor read-write)) ;parent task id ([inst] or int id) 136 | ; (slot start-time (type INTEGER) (create-accessor read-write)) ;also was a global 137 | ; (slot recv-d-time (type INTEGER) (create-accessor read-write)) ;also was a global 138 | ; (slot model (type INTEGER) (create-accessor read-write)) ;also was a global 139 | ; (multislot inst-tids (create-accessor read-write)) ;also was a global 140 | ;) 141 | ;-----------------------------------------------------EOF 142 | -------------------------------------------------------------------------------- /csd.auth.gr/.note: -------------------------------------------------------------------------------- 1 | R-DEVICE code from my last zip of it: -rw-r--r-- 1 bobak 230K Feb 27 2014 r-device.zip 2 | also have: -rw-r--r-- 1 bobak 7.4K Jan 12 13:59 r-device-compiled-rule-class-instances-defeasible-r-device-rules-caleb.clp 3 | O-Device from a copy of: -rw-r--r-- 1 bobak 664K Feb 27 2014 odevice_v2.rar 4 | There might be more, but this is what I can find right now; might be @archive.org's wayback machine/etc too? 5 | Probably more at: http://lpis.csd.auth.gr/projects.asp http://lpis.csd.auth.gr/systems.asp 6 | http://lpis.csd.auth.gr/research.asp?areaID=3 http://lpis.csd.auth.gr/systems/device.html 7 | http://lpis.csd.auth.gr/systems/r-device.html has r-device.zip 8 | http://lpis.csd.auth.gr/systems/o-device/o-device.html 9 | http://lpis.csd.auth.gr/systems/dr-device.html 10 | http://lpis.csd.auth.gr/systems/VDR-Device_Tutorial.htm 11 | & http://lpis.csd.auth.gr/systems/x-device.html http://lpis.csd.auth.gr/systems/practic.html 12 | http://lpis.csd.auth.gr/ontologies/ontolist.html 13 | -------------------------------------------------------------------------------- /csd.auth.gr/.note~: -------------------------------------------------------------------------------- 1 | R-DEVICE code from my last zip of it: -rw-r--r-- 1 bobak 230K Feb 27 2014 r-device.zip 2 | also have: -rw-r--r-- 1 bobak 7.4K Jan 12 13:59 r-device-compiled-rule-class-instances-defeasible-r-device-rules-caleb.clp 3 | O-Device from a copy of: -rw-r--r-- 1 bobak 664K Feb 27 2014 odevice_v2.rar 4 | There might be more, but this is what I can find right now; might be @archive.org's wayback machine/etc too? 5 | Probably more at: http://lpis.csd.auth.gr/projects.asp http://lpis.csd.auth.gr/systems.asp 6 | http://lpis.csd.auth.gr/research.asp?areaID=3 http://lpis.csd.auth.gr/systems/device.html 7 | http://lpis.csd.auth.gr/systems/o-device/o-device.html 8 | http://lpis.csd.auth.gr/systems/r-device.html has r-device.zip 9 | http://lpis.csd.auth.gr/systems/dr-device.html 10 | http://lpis.csd.auth.gr/systems/VDR-Device_Tutorial.htm 11 | & http://lpis.csd.auth.gr/systems/x-device.html http://lpis.csd.auth.gr/systems/practic.html 12 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/aggregates.clp: -------------------------------------------------------------------------------- 1 | (defclass aggregate-function 2 | (is-a USER) 3 | (role concrete) 4 | (pattern-match reactive) 5 | (slot class (type SYMBOL)) 6 | (slot instance (type INSTANCE-NAME)) 7 | (slot attribute (type SYMBOL)) 8 | (multislot values) 9 | (multislot objects) 10 | ) 11 | 12 | (defmessage-handler aggregate-function calc-result ($?result) 13 | $?result 14 | ) 15 | 16 | (defclass sum 17 | (is-a aggregate-function) 18 | ) 19 | 20 | (defmessage-handler sum calc-result ($?result) 21 | (sum$ $?result) 22 | ) 23 | 24 | (defclass count 25 | (is-a aggregate-function) 26 | ) 27 | 28 | (defmessage-handler count calc-result ($?result) 29 | (length$ $?result) 30 | ) 31 | 32 | (defclass avg 33 | (is-a aggregate-function) 34 | ) 35 | 36 | (defmessage-handler avg calc-result ($?result) 37 | (if (> (length$ $?result) 0) 38 | then 39 | (/ (sum$ $?result) (length$ $?result)) 40 | else 41 | 0 42 | ) 43 | ) 44 | 45 | (defclass max 46 | (is-a aggregate-function) 47 | ) 48 | 49 | (defmessage-handler max calc-result ($?result) 50 | (bind ?class (send ?self get-class)) 51 | (bind ?att (send ?self get-attribute)) 52 | (bind $?types (slot-types ?class ?att)) 53 | (if (or (member$ INTEGER $?types) 54 | (member$ FLOAT $?types)) 55 | then 56 | (max-int $?result) 57 | else 58 | (max-string $?result) 59 | ) 60 | ) 61 | 62 | (defclass min 63 | (is-a aggregate-function) 64 | ) 65 | 66 | (defmessage-handler min calc-result ($?result) 67 | (bind ?class (send ?self get-class)) 68 | (bind ?att (send ?self get-attribute)) 69 | (bind $?types (slot-types ?class ?att)) 70 | (if (or (member$ INTEGER $?types) 71 | (member$ FLOAT $?types)) 72 | then 73 | (min-int $?result) 74 | else 75 | (min-string $?result) 76 | ) 77 | ) 78 | 79 | (defclass list 80 | (is-a aggregate-function) 81 | ) 82 | 83 | (defclass ord_list 84 | (is-a aggregate-function) 85 | ) 86 | 87 | (defmessage-handler ord_list calc-result ($?list) 88 | (bind ?class (send ?self get-class)) 89 | (bind ?att (send ?self get-attribute)) 90 | (bind $?types (slot-types ?class ?att)) 91 | (if (or (member$ INTEGER $?types) 92 | (member$ FLOAT $?types)) 93 | then 94 | (sort > $?list) 95 | else 96 | (sort string> $?list) 97 | ) 98 | ) 99 | 100 | (defclass string 101 | (is-a aggregate-function) 102 | ) 103 | 104 | (defmessage-handler string calc-result ($?list) 105 | (funcall str-cat $?list) 106 | ) 107 | 108 | (defclass phrase 109 | (is-a aggregate-function) 110 | ) 111 | 112 | (defmessage-handler phrase calc-result ($?list) 113 | (str-cat$ $?list) 114 | ) 115 | 116 | (deffunction is-aggregate-function (?x) 117 | (and 118 | (class-existp ?x) 119 | (subclassp ?x aggregate-function) 120 | ) 121 | ) 122 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/arp-only.bat: -------------------------------------------------------------------------------- 1 | java -cp "c:\Program Files\arp\arp.jar;c:\Program Files\xerces\xerces.jar" com.hp.hpl.jena.rdf.arp.NTriple %1.rdf > %1.n3 2 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/arp.bat: -------------------------------------------------------------------------------- 1 | "c:\Program Files\Libwww\loadtofile.exe" %1 -o %2.rdf 2 | java -cp "c:\Program Files\arp\arp.jar;c:\Program Files\xerces\xerces.jar" com.hp.hpl.jena.rdf.arp.NTriple %1 > %2.n3 3 | rem pause 4 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/classes.clp: -------------------------------------------------------------------------------- 1 | (defglobal 2 | ?*verbose_status* = off 3 | ?*untranslated_rules* = 0 4 | ) 5 | 6 | (defclass TYPED-CLASS 7 | (is-a USER) 8 | (role concrete) 9 | (pattern-match reactive) 10 | (multislot class-refs 11 | (type SYMBOL) 12 | (storage shared) 13 | (access read-only) 14 | ) 15 | (slot namespace 16 | (type SYMBOL) 17 | (storage shared) 18 | (access read-only) 19 | ) 20 | ) 21 | 22 | ;(defclass DERIVED-CLASS 23 | ; (is-a TYPED-CLASS) 24 | ; (slot counter (type INTEGER) (default 1)) 25 | ; (multislot derivators (type STRING)) 26 | ; (multislot derivators (type INSTANCE-NAME)) 27 | ; (multislot derivators) 28 | ;) 29 | 30 | (defclass DERIVED-CLASS 31 | (is-a TYPED-CLASS RDF-CLASS) 32 | (slot counter (type INTEGER) (default 1)) 33 | (multislot derivators) 34 | ) 35 | 36 | (deftemplate deductive-rule 37 | (slot name (type SYMBOL)) 38 | (slot del-name (type SYMBOL)) 39 | (slot deductive-rule (type STRING)) 40 | (slot production-rule (type STRING)) 41 | ;(slot delete-production-rule (type STRING)) 42 | (slot derived-class (type SYMBOL)) 43 | (multislot depends-on (type SYMBOL)) 44 | (slot implies (type SYMBOL)) 45 | ) 46 | 47 | (deftemplate derived-attribute-rule 48 | (slot name (type SYMBOL)) 49 | (slot del-name (type SYMBOL)) 50 | (slot derived-attribute-rule (type STRING)) 51 | ;(slot production-rule (type STRING)) 52 | ;(slot delete-production-rule (type STRING)) 53 | ; (slot derived-class (type SYMBOL)) 54 | (multislot depends-on (type SYMBOL)) 55 | (slot implies (type SYMBOL)) 56 | ) 57 | 58 | (deftemplate aggregate-attribute-rule 59 | (slot name (type SYMBOL)) 60 | (slot del-name (type SYMBOL)) 61 | (slot aggregate-attribute-rule (type STRING)) 62 | ;(slot production-rule (type STRING)) 63 | ;(slot delete-production-rule (type STRING)) 64 | ; (slot derived-class (type SYMBOL)) 65 | (multislot depends-on (type SYMBOL)) 66 | (slot implies (type SYMBOL)) 67 | ) 68 | 69 | (deftemplate derived-class 70 | (slot name (type SYMBOL)) 71 | (slot stratum (type INTEGER) (default 1)) 72 | (multislot deductive-rules (type SYMBOL)) 73 | ) 74 | 75 | (deftemplate namespace 76 | (slot name (type SYMBOL)) 77 | (slot address (type STRING)) 78 | (multislot classes (type SYMBOL)) 79 | ) 80 | 81 | (deftemplate pending-rule 82 | (slot production-rule (type STRING)) 83 | (slot delete-production-rule (type STRING)) 84 | (multislot non-existent-classes (type SYMBOL)) 85 | ) 86 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/import.clp: -------------------------------------------------------------------------------- 1 | (defglobal 2 | ?*undef_rules* = (create$) 3 | ?*undef_functions* = (create$) 4 | ) 5 | 6 | (deffunction backup-class-def (?class) 7 | (bind $?all-slots (delete-member$ (class-slots ?class) class-refs aliases)) 8 | (bind $?slot-defs (create$)) 9 | (while (> (length$ $?all-slots) 0) 10 | do 11 | (bind $?slot-types (slot-types ?class (nth$ 1 $?all-slots))) 12 | (if (is-multislot ?class (nth$ 1 $?all-slots)) 13 | then 14 | (bind ?slot-field multislot) 15 | else 16 | (bind ?slot-field slot) 17 | ) 18 | (bind $?slot-defs (create$ $?slot-defs "(" ?slot-field (nth$ 1 $?all-slots) "(" type $?slot-types ")" ")")) 19 | (bind $?all-slots (rest$ $?all-slots)) 20 | ) 21 | (assert (redefined-class 22 | (name ?class) 23 | (isa-slot (class-superclasses ?class)) 24 | (slot-definitions $?slot-defs) 25 | (class-refs-defaults (slot-default-value ?class class-refs)) 26 | (aliases-defaults (slot-default-value ?class aliases)) 27 | )) 28 | ) 29 | 30 | (deffunction backup-class-hierarchy (?class) 31 | (bind $?classes (create$ ?class (class-subclasses ?class inherit))) 32 | (bind ?end (length$ $?classes)) 33 | (loop-for-count (?n 1 ?end) 34 | do 35 | (backup-class-def (nth$ ?n $?classes)) 36 | ) 37 | ) 38 | 39 | (deffunction backup-class (?class) 40 | (bind ?filename (str-cat "backup-class-" (str-replace ?class "-" ":") "-instances.txt")) 41 | (save-instances ?filename visible inherit ?class) 42 | (assert (backup-instances ?filename)) 43 | ;(do-for-all-instances ((?x ?class)) TRUE (send ?x delete)) 44 | (backup-class-hierarchy ?class) 45 | (assert (class-to-undefine ?class)) 46 | ;(undefclass ?class) 47 | ) 48 | 49 | (deffunction undefine-classes () 50 | (bind $?facts (get-template-specific-facts class-to-undefine (get-fact-list))) 51 | (bind ?end (length$ $?facts)) 52 | (loop-for-count (?n 1 ?end) 53 | do 54 | (bind ?class (nth$ 1 (fact-slot-value (nth$ ?n $?facts) implied))) 55 | (if (class-existp ?class) 56 | then 57 | (do-for-all-instances ((?x ?class)) TRUE (send ?x delete)) 58 | (undefclass ?class) 59 | ) 60 | (retract (nth$ ?n $?facts)) 61 | ) 62 | ) 63 | 64 | ;(deffunction undefine-functions () 65 | ; (bind ?end (length$ ?*undef_functions*)) 66 | ; (verbose "Undefining " ?end " functions" crlf) 67 | ; (loop-for-count (?n 1 ?end) 68 | ; do 69 | ; (verbose "Undefining function: " (nth$ ?n ?*undef_functions*) crlf) 70 | ; (undeffunction (nth$ ?n ?*undef_functions*)) 71 | ; ) 72 | ; TRUE 73 | ;) 74 | 75 | (deffunction undefine-functions () 76 | (undeffunction load-rdf) 77 | (undeffunction load-namespaces) 78 | (undeffunction load-namespace) 79 | (undeffunction insert-triples) 80 | (undeffunction create-namespaces) 81 | (undeffunction scan_base) 82 | (undeffunction scan_namespaces) 83 | (undeffunction import-resource) 84 | (undeffunction create-aliases) 85 | (undeffunction find-all-super-properties) 86 | (undeffunction resource-make-instance) 87 | ) 88 | 89 | (deffunction undefine-rules () 90 | (bind ?end (length$ ?*undef_rules*)) 91 | ;(verbose "Undefining " ?end " rules" crlf) 92 | (loop-for-count (?n 1 ?end) 93 | do 94 | ;(verbose "Undefining rule: " (nth$ ?n ?*undef_rules*) crlf) 95 | (undefrule (nth$ ?n ?*undef_rules*)) 96 | ) 97 | TRUE 98 | ; (undefrule create-instances-of-existing-classes) 99 | ; (undefrule changing-type-of-existing-instances) 100 | ; (undefrule create-instances-of-multiple-existing-classes) 101 | ; (undefrule create-instances-of-multiple-classes-1) 102 | ; (undefrule create-instances-of-multiple-classes-2) 103 | ; (undefrule put-instance-slots-resources) 104 | ; (undefrule put-instance-slots-literals) 105 | ; (undefrule property-inheritance-domains) 106 | ; (undefrule property-inheritance-ranges) 107 | ; (undefrule property-with-multiple-domains) 108 | ; (undefrule property-with-multiple-ranges) 109 | ; (undefrule create-non-existing-classes_create-candidate-class) 110 | ; (undefrule create-non-existing-classes_create-slots-type-Literal) 111 | ; (undefrule create-non-existing-classes_create-slots-type-Resource) 112 | ; (undefrule create-non-existing-classes_create-slots-type-no-range) 113 | ; (undefrule generate-non-existing-classes_create-create-final-class) 114 | ; (undefrule put-new-properties-no-domain) 115 | ; (undefrule put-new-properties-with-one-domain) 116 | ; (undefrule insert-new-property-no-domain-Literal) 117 | ; (undefrule insert-new-property-no-domain-Resource) 118 | ; (undefrule insert-new-property-no-domain-no-range) 119 | ; (undefrule insert-new-property-one-domain-Literal) 120 | ; (undefrule insert-new-property-one-domain-Resource) 121 | ; (undefrule insert-new-property-one-domain-no-range) 122 | ; (undefrule put-remaining-triples-container-membership-properties) 123 | ; (undefrule put-remaining-triples-properties) 124 | ; (undefrule put-remaining-triples-subjects-with-domain) 125 | ; (undefrule put-remaining-triples-subjects-no-domain) 126 | ; (undefrule put-remaining-triples-subjects-wrong-domain) 127 | ; (undefrule put-remaining-triples-objects-with-range) 128 | ; (undefrule put-remaining-triples-objects-no-range) 129 | ; (undefrule add-extra-superclass) 130 | ; (undefrule insert-extra-superclass) 131 | ) 132 | 133 | (deffunction build-undefinitions () 134 | (bind ?*undef_rules* (create$)) 135 | (open (str-cat ?*R-DEVICE_PATH* "triple-transformation.clp") ttt "r") 136 | (bind ?line (readline ttt)) 137 | (while (neq ?line EOF) 138 | do 139 | ;(verbose "line: " ?line crlf) 140 | (bind ?pos (str-index defrule ?line)) 141 | (if (integerp ?pos) 142 | then 143 | ;(verbose "pos: " ?pos crlf) 144 | (bind ?line (sub-string (+ ?pos 8) (length ?line) ?line)) 145 | ;(verbose "new line: " ?line crlf) 146 | (bind ?pos (str-index " " ?line)) 147 | ;(verbose "new pos: " ?pos crlf) 148 | (if (integerp ?pos) 149 | then 150 | (bind ?rule (sym-cat (sub-string 1 (- ?pos 1) ?line))) 151 | else 152 | (bind ?rule (sym-cat ?line)) 153 | ) 154 | ;(verbose "rule: " ?rule crlf) 155 | (bind ?*undef_rules* (create$ ?*undef_rules* ?rule)) 156 | ) 157 | (bind ?line (readline ttt)) 158 | ) 159 | (close ttt) 160 | ) 161 | 162 | (deffunction import () 163 | (build-undefinitions) 164 | (set-strategy mea) 165 | ;(bind ?*triple_counter* (length$ (get-template-specific-facts triple (get-fact-list)))) 166 | (while (> ?*triple_counter* 0) 167 | do 168 | (bind ?no-of-triples-before (+ ?*triple_counter* 1)) 169 | (bind ?no-of-triples-after ?*triple_counter*) 170 | (while (> ?no-of-triples-before ?no-of-triples-after) 171 | do 172 | (bind ?no-of-triples-before ?no-of-triples-after) 173 | (run-goal create-instances) 174 | (run-goal put-slot-values) 175 | (run-goal property-inheritance) 176 | (run-goal multiple-domains-ranges) 177 | (run-goal create-new-classes) 178 | (run-goal generate-new-classes) 179 | (bind ?no-of-triples-after ?*triple_counter*) 180 | ) 181 | (run-goal put-new-properties) 182 | (bind ?redef-classes (length$ (get-template-specific-facts redefined-class (get-fact-list)))) 183 | (if (> ?redef-classes 0) 184 | then 185 | ;(verbose "After 1st set of rules!" crlf) 186 | ;(undefrule *) 187 | (undefine-rules) 188 | ;(verbose "Undefined rules!" crlf) 189 | (undefine-functions) 190 | ;(verbose "Undefined functions!" crlf) 191 | (if (member$ rdf_classes (get-definstances-list)) 192 | then 193 | (undefinstances rdf_classes) 194 | ) 195 | ;(verbose "Undefined definstances!" crlf) 196 | (undefine-classes) 197 | ;(verbose "Undefined classes!" crlf) 198 | (load* (str-cat ?*R-DEVICE_PATH* "restore-classes.clp")) 199 | (run-goal restore-classes) 200 | ;(verbose "Before re-loading files" crlf) 201 | (load* (str-cat ?*R-DEVICE_PATH* "load-rdf.clp")) 202 | (load* (str-cat ?*R-DEVICE_PATH* "triple-transformation.clp")) 203 | ;(verbose "After re-loading files" crlf) 204 | (run-goal put-slot-values) 205 | ) 206 | (run-goal put-remaining-triples) 207 | ) 208 | TRUE 209 | ) 210 | 211 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/main.clp: -------------------------------------------------------------------------------- 1 | (deffunction load-rule-file (?filename) 2 | (bind ?rule-string "") 3 | (open ?filename rule "r") 4 | (bind ?line (readline rule)) 5 | ;(verbose "line: " ?line crlf) 6 | (while (neq ?line EOF) 7 | do 8 | (bind ?rule-string (str-cat ?rule-string ?line)) 9 | (bind ?line (readline rule)) 10 | ;(verbose "line: " ?line crlf) 11 | ) 12 | (close rule) 13 | ;(verbose "rule-string: " ?rule-string crlf) 14 | (bind $?rule-list (my-explode$ ?rule-string)) 15 | ;(verbose "Rules: " $?rule-list crlf) 16 | (while (> (length$ $?rule-list) 0) 17 | do 18 | (bind ?p2 (get-token $?rule-list)) 19 | (bind $?rule (subseq$ $?rule-list 1 ?p2)) 20 | ;(bind ?rule-string (str-cat$ "(" (nth$ 2 $?rule) (str-cat$ (subseq$ $?rule 3 (- (length$ $?rule) 1))) ")")) 21 | ;(funcall assert (nth$ 2 $?rule) (str-cat$ (subseq$ $?rule 3 (- (length$ $?rule) 1)))) 22 | (bind ?rule-type (nth$ 2 $?rule)) 23 | (bind ?rule-string (str-cat$ (subseq$ $?rule 3 (- (length$ $?rule) 1)))) 24 | (switch ?rule-type 25 | (case deductiverule 26 | then 27 | (assert (deductiverule ?rule-string)) 28 | (bind ?*untranslated_rules* (+ ?*untranslated_rules* 1)) 29 | ) 30 | (case derivedattrule 31 | then 32 | (assert (derivedattrule ?rule-string)) 33 | (bind ?*untranslated_rules* (+ ?*untranslated_rules* 1)) 34 | ) 35 | (case aggregateattrule 36 | then 37 | (assert (aggregateattrule ?rule-string)) 38 | (bind ?*untranslated_rules* (+ ?*untranslated_rules* 1)) 39 | ) 40 | (default (printout t "Unknown rule type: " crlf (str-cat$ $?rule) crlf)) 41 | ) 42 | (bind $?rule-list (subseq$ $?rule-list (+ ?p2 1) (length$ $?rule-list))) 43 | ) 44 | TRUE 45 | ) 46 | 47 | (deffunction load-rule-files ($?file-list) 48 | (bind ?end (length$ $?file-list)) 49 | (loop-for-count (?n 1 ?end) 50 | do 51 | (load-rule-file (nth$ ?n $?file-list)) 52 | ) 53 | ) 54 | 55 | (deffunction go () 56 | (verbose "Running rules..." crlf) 57 | (bind ?old-strategy (get-strategy)) 58 | (bind ?old-salience (get-salience-evaluation)) 59 | (set-strategy breadth) 60 | (set-salience-evaluation when-activated) 61 | (bind ?objects-before -1) 62 | (bind ?objects-after (no-of-derived-objects)) 63 | (while (<> ?objects-after ?objects-before) 64 | do 65 | (bind ?ind (assert (run-deductive-rules))) 66 | (bind ?objects-before ?objects-after) 67 | (run) 68 | (bind ?objects-after (no-of-derived-objects)) 69 | (retract ?ind) 70 | ) 71 | (set-salience-evaluation ?old-salience) 72 | (set-strategy ?old-strategy) 73 | (verbose "End of inferencing!" crlf) 74 | TRUE 75 | ) 76 | 77 | ; Loading should distinguish between .bat and .clp files 78 | (deffunction device (?rule-files ?class-files ?object-files ?verbose) 79 | (set-verbose ?verbose) 80 | (verbose "Loading classes...") 81 | (load-files (explode$ ?class-files)) 82 | (verbose " ok" crlf) 83 | (reset) 84 | (set-verbose ?verbose) 85 | (verbose "Loading rules...") 86 | (load-rule-files (explode$ ?rule-files)) 87 | (verbose " ok" crlf) 88 | (verbose "Loading objects...") 89 | (load-files (explode$ ?object-files)) 90 | (verbose " ok" crlf) 91 | ;(run) 92 | (verbose "Translating rules..." ) 93 | (translate-device-rules) 94 | (verbose " ok" crlf) 95 | TRUE 96 | ) 97 | 98 | (deffunction r-device (?rule-files) 99 | (verbose "Loading rules...") 100 | (load-rule-files (explode$ ?rule-files)) 101 | (verbose " ok" crlf) 102 | ;(reset) 103 | ;(run) 104 | (verbose "Translating rules..." ) 105 | (translate-device-rules) 106 | (verbose " ok" crlf) 107 | TRUE 108 | ) 109 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/manual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MBcode/CLIPSmsc/05a813b3993104fb8ea82700bd1cec85a2949e6d/csd.auth.gr/R-DEVICE/manual.pdf -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/r-device.bat: -------------------------------------------------------------------------------- 1 | (defglobal ?*R-DEVICE_PATH* = "C:\\Program Files\\R-DEVICE\\") 2 | (load* (str-cat ?*R-DEVICE_PATH* "rdf.clp")) 3 | (load* (str-cat ?*R-DEVICE_PATH* "classes.clp")) 4 | (load* (str-cat ?*R-DEVICE_PATH* "auxiliary-functions.clp")) 5 | (load* (str-cat ?*R-DEVICE_PATH* "class-functions.clp")) 6 | (load* (str-cat ?*R-DEVICE_PATH* "aggregates.clp")) 7 | (load* (str-cat ?*R-DEVICE_PATH* "types.clp")) 8 | (load* (str-cat ?*R-DEVICE_PATH* "oo-querying.clp")) 9 | (load* (str-cat ?*R-DEVICE_PATH* "second-order.clp")) 10 | (load* (str-cat ?*R-DEVICE_PATH* "stratification.clp")) 11 | (load* (str-cat ?*R-DEVICE_PATH* "translation.clp")) 12 | (load* (str-cat ?*R-DEVICE_PATH* "translation-rules.clp")) 13 | (load* (str-cat ?*R-DEVICE_PATH* "main.clp")) 14 | (load* (str-cat ?*R-DEVICE_PATH* "rdf-auxiliary.clp")) 15 | (load* (str-cat ?*R-DEVICE_PATH* "load-rdf.clp")) 16 | (load* (str-cat ?*R-DEVICE_PATH* "import.clp")) 17 | (load* (str-cat ?*R-DEVICE_PATH* "export.clp")) 18 | (load* (str-cat ?*R-DEVICE_PATH* "triple-transformation.clp")) 19 | (reset) 20 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/rdf.clp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MBcode/CLIPSmsc/05a813b3993104fb8ea82700bd1cec85a2949e6d/csd.auth.gr/R-DEVICE/rdf.clp -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/restore-classes.clp: -------------------------------------------------------------------------------- 1 | (defrule restore-classes 2 | (goal restore-classes) 3 | ?x <- (redefined-class (name ?class) (isa-slot $?super-classes) (slot-definitions $?slot-defs) (class-refs-defaults $?class-refs) (aliases-defaults $?aliases)) 4 | (not (redefined-class (name ?super-class&:(member$ ?super-class $?super-classes)))) 5 | => 6 | (verbose "Restoring class: " ?class crlf) 7 | (my-build (str-cat$ 8 | "(" defclass ?class 9 | "(" is-a 10 | (if (> (length$ $?super-classes) 0) 11 | then 12 | $?super-classes 13 | else 14 | rdfs:Resource 15 | ) 16 | ")" 17 | $?slot-defs 18 | "(" multislot class-refs 19 | "(" source composite ")" 20 | "(" default (unique-pairs (create$ $?class-refs (collect-defaults class-refs $?super-classes))) ")" 21 | ")" 22 | "(" multislot aliases 23 | "(" source composite ")" 24 | "(" default (unique-pairs (create$ $?aliases (collect-defaults aliases $?super-classes))) ")" 25 | ")" 26 | ")" 27 | )) 28 | (retract ?x) 29 | ) 30 | 31 | 32 | (defrule restore-instances 33 | (goal restore-classes) 34 | (not (redefined-class)) 35 | ?x <- (backup-instances ?filename) 36 | => 37 | (restore-instances ?filename) 38 | (retract ?x) 39 | (remove ?filename) 40 | ) 41 | 42 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/stratification.clp: -------------------------------------------------------------------------------- 1 | 2 | 3 | (deffunction collect-positive-class-names ($?condition) 4 | ) 5 | 6 | (deffunction collect-positive-class-names-one ($?cond-elem) 7 | (if (eq (nth$ 2 $?cond-elem) not) 8 | then 9 | (create$) 10 | else 11 | (if (or (eq (nth$ 2 $?cond-elem) or) 12 | (eq (nth$ 2 $?cond-elem) and)) 13 | then 14 | (collect-positive-class-names (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1))) 15 | else 16 | (if (eq (nth$ 2 $?cond-elem) <-) 17 | then 18 | (if (eq (nth$ 4 $?cond-elem) object) 19 | then 20 | (bind ?class (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem)) 21 | else 22 | (bind ?class (nth$ 4 $?cond-elem)) 23 | ) 24 | else 25 | (if (eq (nth$ 2 $?cond-elem) object) 26 | then 27 | (bind ?class (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem)) 28 | else 29 | (bind ?class (nth$ 2 $?cond-elem)) 30 | ) 31 | ) 32 | (if (is_derived ?class) 33 | then 34 | ?class 35 | else 36 | (create$) 37 | ) 38 | ) 39 | ) 40 | ) 41 | 42 | (deffunction collect-positive-class-names ($?condition) 43 | (bind $?result (create$)) 44 | (while (> (length$ $?condition) 0) 45 | do 46 | (bind ?p2 (get-token $?condition)) 47 | ;(bind $?first-cond-elem (subseq$ $?condition 1 ?p2)) 48 | (bind $?result (create$ $?result (collect-positive-class-names-one (subseq$ $?condition 1 ?p2)))) 49 | (bind $?condition (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 50 | ) 51 | $?result 52 | ) 53 | 54 | (deffunction collect-negative-class-names ($?condition) 55 | ) 56 | 57 | (deffunction collect-negative-class-names-one ($?cond-elem) 58 | (if (eq (nth$ 2 $?cond-elem) not) 59 | then 60 | (collect-positive-class-names (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1))) 61 | else 62 | (if (or (eq (nth$ 2 $?cond-elem) or) 63 | (eq (nth$ 2 $?cond-elem) and)) 64 | then 65 | (collect-negative-class-names (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1))) 66 | else 67 | (create$) 68 | ) 69 | ) 70 | ) 71 | 72 | (deffunction collect-negative-class-names ($?condition) 73 | (bind $?result (create$)) 74 | (while (> (length$ $?condition) 0) 75 | do 76 | (bind ?p2 (get-token $?condition)) 77 | ;(bind $?first-cond-elem (subseq$ $?condition 1 ?p2)) 78 | (bind $?result (create$ $?result (collect-negative-class-names-one (subseq$ $?condition 1 ?p2)))) 79 | (bind $?condition (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 80 | ) 81 | $?result 82 | ) 83 | 84 | 85 | (deffunction calc-positive-stratum (?no-of-derived-classes ?current-stratum $?positive-condition-classes) 86 | (if (> ?current-stratum ?no-of-derived-classes) 87 | then 88 | -1 89 | else 90 | (if (= (length$ $?positive-condition-classes) 0) 91 | then 92 | ?current-stratum 93 | else 94 | ;(bind ?pos-class (nth$ 1 $?positive-condition-classes)) 95 | ;(bind ?pos-class-id (nth$ 1 (get-specific-facts derived-class name (nth$ 1 $?positive-condition-classes)))) 96 | (bind ?body-class-stratum (fact-slot-value (nth$ 1 (get-specific-facts derived-class name (nth$ 1 $?positive-condition-classes))) stratum)) 97 | (if (< ?current-stratum ?body-class-stratum) 98 | then 99 | (calc-positive-stratum ?no-of-derived-classes ?body-class-stratum (rest$ $?positive-condition-classes)) 100 | else 101 | (calc-positive-stratum ?no-of-derived-classes ?current-stratum (rest$ $?positive-condition-classes)) 102 | ) 103 | ) 104 | ) 105 | ) 106 | 107 | (deffunction calc-negative-stratum (?no-of-derived-classes ?current-stratum $?negative-condition-classes) 108 | (if (> ?current-stratum ?no-of-derived-classes) 109 | then 110 | -1 111 | else 112 | (if (= (length$ $?negative-condition-classes) 0) 113 | then 114 | ?current-stratum 115 | else 116 | (bind ?body-class-stratum (fact-slot-value (nth$ 1 (get-specific-facts derived-class name (nth$ 1 $?negative-condition-classes))) stratum)) 117 | (if (<= ?current-stratum ?body-class-stratum) 118 | then 119 | (calc-negative-stratum ?no-of-derived-classes (+ ?body-class-stratum 1) (rest$ $?negative-condition-classes)) 120 | else 121 | (calc-negative-stratum ?no-of-derived-classes ?current-stratum (rest$ $?negative-condition-classes)) 122 | ) 123 | ) 124 | ) 125 | ) 126 | 127 | (deffunction calc-stratum (?derived-class $?condition) 128 | ;(bind $?positive-condition-classes (remove-duplicates$ (collect-positive-class-names $?condition))) 129 | ;(bind $?negative-condition-classes (remove-duplicates$ (collect-negative-class-names $?condition))) 130 | (bind ?no-of-derived-classes (length$ (get-template-specific-facts derived-class (get-fact-list)))) 131 | (bind ?derived-class-index (nth$ 1 (get-specific-facts derived-class name ?derived-class))) 132 | (if (eq ?derived-class-index nil) 133 | then 134 | 1 135 | else 136 | ;(bind ?current-stratum (fact-slot-value ?derived-class-index stratum)) 137 | ;(bind ?next-stratum (calc-positive-stratum ?no-of-derived-classes (fact-slot-value ?derived-class-index stratum) (remove-duplicates$ (collect-positive-class-names $?condition)))) 138 | (calc-negative-stratum ?no-of-derived-classes (calc-positive-stratum ?no-of-derived-classes (fact-slot-value ?derived-class-index stratum) (remove-duplicates$ (collect-positive-class-names $?condition))) (remove-duplicates$ (collect-negative-class-names $?condition))) 139 | ) 140 | ) 141 | 142 | 143 | 144 | (deffunction calc-stratum-afterwards (?production-rule-condition ?class) 145 | ;(bind $?pr (explode$ ?production-rule)) 146 | ;(bind ?imp_pos (member$ => $?pr)) 147 | ;(bind $?condition (subseq$ $?pr 17 (- ?imp_pos 1))) ;avoid initial stuff 148 | ;(bind $?condition (explode$ ?production-rule-condition)) 149 | (bind ?stratum (calc-stratum ?class (my-explode$ ?production-rule-condition))) 150 | (if (= ?stratum -1) 151 | then 152 | (printout t "Rules are not stratified!" crlf) 153 | (halt) 154 | else 155 | (if (> ?stratum 1) 156 | then 157 | (bind ?derived-class-index (nth$ 1 (get-specific-facts derived-class name ?class))) 158 | (modify ?derived-class-index (stratum ?stratum)) 159 | ) 160 | ) 161 | ) 162 | 163 | (deffunction calc-salience (?class) 164 | ;(bind ?derived-class-index (nth$ 1 (get-specific-facts derived-class name ?class))) 165 | ;(bind ?class-stratum (fact-slot-value (nth$ 1 (get-specific-facts derived-class name ?class)) stratum)) 166 | (- 1000 (fact-slot-value (nth$ 1 (get-specific-facts derived-class name ?class)) stratum)) 167 | ) 168 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/dc.rdf: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Dublin Core Metadata Element Set, Version 1.1: Reference Description 5 | 6 | 7 | The Dublin Core Element Set v1.1 namespace providing access to it's content by means of an RDF Schema 8 | The Dublin Core Metadata Initiative 9 | The Dublin Core Element Set v1.1 namespace provides URIs for the Dublin Core Elements v1.1. Entries are declared using RDF Schema language to support RDF applications. 10 | English 11 | 1999-07-02 12 | 2002-05-22 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | Title 21 | A name given to the resource. 22 | Typically, a Title will be a name by which the resource is formally known. 23 | 24 | 1999-07-02 25 | 26 | 27 | Contributor 28 | An entity responsible for making contributions to the content of the resource. 29 | Examples of a Contributor include a person, an organisation, or a service. Typically, the name of a Contributor should be used to indicate the entity. 30 | 31 | 1999-07-02 32 | 33 | 34 | Creator 35 | An entity primarily responsible for making the content of the resource. 36 | Examples of a Creator include a person, an organisation, or a service. Typically, the name of a Creator should be used to indicate the entity. 37 | 38 | 1999-07-02 39 | 40 | 41 | Publisher 42 | An entity responsible for making the resource available. 43 | Examples of a Publisher include a person, an organisation, or a service. Typically, the name of a Publisher should be used to indicate the entity. 44 | 45 | 1999-07-02 46 | 47 | 48 | Subject and Keywords 49 | The topic of the content of the resource. 50 | 51 | Typically, a Subject will be expressed as keywords, key phrases or classification codes that describe a topic of the resource. Recommended best practice is to select a value from a controlled vocabulary or formal classification scheme. 52 | 53 | 1999-07-02 54 | 55 | 56 | Description 57 | An account of the content of the resource. 58 | Description may include but is not limited to: an abstract, table of contents, reference to a graphical representation of content or a free-text account of the content. 59 | 60 | 1999-07-02 61 | 62 | 63 | Date 64 | A date associated with an event in the life cycle of the resource. 65 | Typically, Date will be associated with the creation or availability of the resource. Recommended best practice for encoding the date value is defined in a profile of ISO 8601 [W3CDTF] and follows the YYYY-MM-DD format. 66 | 67 | 1999-07-02 68 | 69 | 70 | Resource Type 71 | The nature or genre of the content of the resource. 72 | Type includes terms describing general categories, functions, genres, or aggregation levels for content. Recommended best practice is to select a value from a controlled vocabulary (for example, the list of Dublin Core Types). To describe the physical or digital manifestation of the resource, use the FORMAT element. 73 | 74 | 75 | 1999-07-02 76 | 77 | 78 | Format 79 | The physical or digital manifestation of the 80 | resource. 81 | Typically, Format may include the media-type or dimensions of the resource. Format may be used to determine the software, hardware or other equipment needed to display or operate the resource. Examples of dimensions include size and duration. Recommended best practice is to select a value from a controlled vocabulary (for example, the list of Internet Media Types defining computer media formats). 82 | 83 | 1999-07-02 84 | 85 | 86 | Resource Identifier 87 | An unambiguous reference to the resource within a given context. 88 | Recommended best practice is to identify the resource by means of a string or number conforming to a formal identification system. Example formal identification systems include the Uniform Resource Identifier (URI) (including the Uniform Resource Locator (URL)), the Digital Object Identifier (DOI) and the International Standard Book Number (ISBN). 89 | 90 | 1999-07-02 91 | 92 | 93 | Language 94 | A language of the intellectual content of the resource. 95 | Recommended best practice is to use RFC 3066 [RFC30 66], which, in conjunction with ISO 639 [ISO639], defines two- and three-letter primary language tags with optional subtags. Examples include "en" or "eng" for English, "akk" for Akkadian, and "en-GB" for English used in the United Kingdom. 96 | 97 | 1999-07-02 98 | 2001-05-21 99 | 100 | 101 | 102 | Relation 103 | A reference to a related resource. 104 | Recommended best practice is to reference the resource by means of a string or number conforming to a formal identification system. 105 | 106 | 1999-07-02 107 | 108 | 109 | Source 110 | A Reference to a resource from which the present resource is derived. 111 | The present resource may be derived from the Source resource in whole or in part. Recommended best practice is to reference the resource by means of a string or number conforming to a formal identification system. 112 | 113 | 1999-07-02 114 | 115 | 116 | Coverage 117 | The extent or scope of the content of the resource. 118 | Coverage will typically include spatial location (a place name or geographic coordinates), temporal period (a period label, date, or date range) or jurisdiction (such as a named administrative entity). Recommended best practice is to select a value from a controlled vocabulary (for example, the Thesaurus of Geographic Names [TGN]) and that, where appropriate, named places or time periods be used in preference to numeric identifiers such as sets of coordinates or date ranges. 119 | 120 | 1999-07-02 121 | 122 | 123 | Rights Management 124 | Information about rights held in and over the resource. 125 | Typically, a Rights element will contain a rights management statement for the resource, or reference a service providing such information. Rights information often encompasses Intellectual Property Rights (IPR), Copyright, and various Property Rights. If the Rights element is absent, no assumptions can be made about the status of these and other rights with respect to the resource. 126 | 127 | 1999-07-02 128 | 129 | 130 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/dctype.rdf: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | The DCMI Types namespace providing access to its content by means of an RDF Schema 5 | The Dublin Core Metadata Initiative 6 | The Dublin Core Types namespace provides URIs for the entries of the DCMI Type Vocabulary. Entries are declared using RDF Schema language to support RDF applications. The Schema will be updated according to dc-usage decisions. 7 | English 8 | 9 | 10 | 11 | 12 | 13 | 2000-07-11 14 | 2002-05-22 15 | 16 | 17 | 18 | The DCMI Type Vocabulary provides a general, 19 | cross-domain list of approved terms that may be used as values for the 20 | Resource Type element to identify the genre of a resource. 21 | 2000-07-11 22 | 23 | 24 | Collection 25 | 26 | A collection is an aggregation of items. The term collection means that the resource is described as a group; its parts may be separately described and navigated. 27 | 28 | 2000-07-11 29 | 30 | 31 | Dataset 32 | 33 | A dataset is information encoded in a defined structure (for example, lists, tables, and databases), intended to be useful for direct machine processing. 34 | 35 | 2000-07-11 36 | 37 | 38 | Event 39 | 40 | An event is a non-persistent, time-based 41 | occurrence. Metadata for an event provides descriptive information that 42 | is the basis for discovery of the purpose, location, duration, responsible agents, and links to related events and resources. The resource of type Event may not be retrievable if the described instantiation has expired or is yet to occur. Examples - exhibition, web-cast, conference, workshop, open-day, performance, battle, trial, wedding, tea-party, conflagration. 43 | 44 | 2000-07-11 45 | 46 | 47 | Image 48 | 49 | An image is a primarily symbolic visual representation other than text. For example - images and photographs of physical objects, paintings, prints, drawings, other images and graphics, animations and moving pictures, film, diagrams, maps, musical notation. Note that image may include both electronic and physical representations. 50 | 51 | 2000-07-11 52 | 53 | 54 | Interactive Resource 55 | 56 | An interactive resource is a resource which requires interaction from the user to be understood, executed, or experienced. For example - forms on web pages, applets, multimedia learning objects, chat services, virtual reality. 57 | 58 | 2000-07-11 59 | 60 | 61 | Software 62 | 63 | Software is a computer program in source or compiled form which may be available for installation non-transiently on another machine. For software which exists only to create an interactive environment, use interactive instead. 64 | 65 | 2000-07-11 66 | 67 | 68 | Service 69 | 70 | A service is a system that provides one or more functions of value to the end-user. Examples include: a photocopying service, a banking service, an authentication service, interlibrary loans, a Z39.50 or Web server. 71 | 72 | 2000-07-11 73 | 74 | 75 | Sound 76 | 77 | A sound is a resource whose content is primarily intended to be rendered as audio. For example - a music playback file format, an audio compact disc, and recorded speech or sounds. 78 | 79 | 2000-07-11 80 | 81 | 82 | Text 83 | 84 | A text is a resource whose content is primarily words for reading. For example - books, letters, dissertations, poems, newspapers, articles, archives of mailing lists. Note that facsimiles or images of texts are still of the genre text. 85 | 86 | 2000-07-11 87 | 88 | 89 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/dmoz.rdf: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Index of /rdf 5 | 6 | 7 |

Index of /rdf

8 | 
      Name                    Last modified       Size  Description
 9 | 

10 | [DIR] Parent Directory        12-Dec-2002 22:00      -  
11 | [TXT] Changes.html            23-Jul-2002 13:17     6k  
12 | [   ] brasil-content.rdf.u8   24-Apr-2002 11:15   812k  
13 | [   ] brasil-structure.rdf.u8 24-Apr-2002 11:15   159k  
14 | [CMP] catmv.log.gz            11-Dec-2002 12:56  10.0M  
15 | [TXT] charsets.txt            19-Jan-2000 11:22     2k  
16 | [TXT] content.example.txt     28-Jan-1999 13:19    23k  
17 | [CMP] content.rdf.u8.gz       22-Sep-2002 09:17   205M  
18 | [CMP] content.rdf.u8.gz.old   26-Aug-2002 09:18    12k  
19 | [CMP] kt-content.rdf.u8.gz    22-Sep-2002 09:22   1.4M  
20 | [CMP] kt-structure.rdf.u8.gz  22-Sep-2002 09:22   169k  
21 | [CMP] kt-terms.rdf.u8.gz      22-Sep-2002 09:22     7k  
22 | [CMP] netscape-content.rdf..> 22-Sep-2002 09:33  1021k  
23 | [CMP] netscape-structure.r..> 22-Sep-2002 09:33    11k  
24 | [CMP] netscape-terms.rdf.u..> 22-Sep-2002 09:33     1k  
25 | [   ] nohup.out               18-Sep-2002 13:29     0k  
26 | [DIR] old/                    17-Sep-2002 15:29      -  
27 | [   ] rand.cats               27-Mar-2001 10:20   263k  
28 | [CMP] redirect.rdf.gz         11-Jan-2001 23:49   3.7M  
29 | [CMP] redirect.rdf.u8.gz      22-Sep-2002 13:22   5.8M  
30 | [CMP] sample.rdf.u8.gz        17-Jan-2001 15:03  50.3M  
31 | [TXT] structure.example.txt   28-Jan-1999 13:19    32k  
32 | [CMP] structure.rdf.u8.gz     22-Sep-2002 09:17  36.7M  
33 | [TXT] tags.html               09-Dec-2002 18:35     7k  
34 | [   ] terms.rdf               11-Jan-2001 22:38   388k  
35 | [   ] terms.rdf.u8            16-Mar-2002 06:13   485k  
36 | [CMP] terms.rdf.u8.gz         22-Sep-2002 09:17    76k  
37 |
38 | 39 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question0.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (? (dc:title ?t)) 3 | => 4 | (result (title ?t)) 5 | ) 6 | 7 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question1.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (dmoz:Topic (dc:title ?t)) 3 | => 4 | (result (title ?t)) 5 | ) 6 | 7 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question2.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (dmoz:Topic (dc:title ?t) (dmoz:newsGroup ?n)) 3 | => 4 | (result (title ?t) (news ?n)) 5 | ) 6 | 7 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question3.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (dmoz:Topic (dmoz:catid "4") (dc:title ?t)) 3 | => 4 | (result (title ?t)) 5 | ) 6 | 7 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question4.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (dmoz:Topic (dmoz:catid "4") (dc:title ?t) (dmoz:link $? ?l $?)) 3 | ?l <- (dmoz:ExternalPage (dc:title ?lt)) 4 | => 5 | (result (title ?t) (link_title ?lt)) 6 | ) 7 | 8 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question5.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (dmoz:Topic (dmoz:catid "4") (dc:title ?t) (dmoz:link $? ?l $?)) 3 | ?l <- (dmoz:ExternalPage (dc:title ?lt) (dc:description ?d)) 4 | => 5 | (result (title ?t) (link_title ?lt) (link_desc ?d)) 6 | ) 7 | 8 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question6.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (dmoz:Topic (dmoz:catid ~"4") (dc:title ?t) (dmoz:link $? ?l $?)) 3 | ?l <- (dmoz:ExternalPage (dc:title ?lt) (dc:description ?d) (dmoz:priority 1)) 4 | => 5 | (result (title ?t) (link_title ?lt) (link_desc ?d)) 6 | ) 7 | 8 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question7.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (dmoz:Topic (dc:title ?top) (dmoz:narrow $? ?n $?)) 3 | ?n <- (dmoz:Topic (dc:title ?t) (dmoz:link $? ?l $?)) 4 | ?l <- (dmoz:ExternalPage (dc:title ?lt)) 5 | => 6 | (result (top_title ?top) (title ?t) (link_title ?lt)) 7 | ) 8 | 9 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/question8.clp: -------------------------------------------------------------------------------- 1 | (deductiverule 2 | (dmoz:Topic (dc:title ?top) (dmoz:narrow $? ?n $?)) 3 | ?n <- (dmoz:Topic (dc:title ?t) (dmoz:link $? ?l $?)) 4 | ?l <- (dmoz:ExternalPage (dc:title ?lt) (dmoz:priority 1)) 5 | => 6 | (result (top_title ?top) (title ?t) (link_title ?lt)) 7 | ) 8 | 9 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/test/run-test.bat: -------------------------------------------------------------------------------- 1 | (set-verbose off) 2 | (load-rdf "structure" local) 3 | (load-rdf "content" local) 4 | (import) 5 | (r-device "question8.clp") 6 | (go) 7 | (do-for-all-instances ((?p result)) TRUE (progn (printout t crlf)(send ?p print) (printout t crlf))) 8 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/translation-rules.clp: -------------------------------------------------------------------------------- 1 | (defrule translate-derived-attribute-rules 2 | (goal translate-derived-attribute-rules) 3 | ?rule-idx <- (derivedattrule ?rule-string) 4 | => 5 | (bind $?classes (build-dependency-network ?rule-string)) 6 | ;(verbose "classes: " $?classes crlf) 7 | (translate-derived-attribute-rule ?rule-string $?classes) 8 | (retract ?rule-idx) 9 | (bind ?*untranslated_rules* (- ?*untranslated_rules* 1)) 10 | ) 11 | 12 | (defrule translate-aggregate-attribute-rules 13 | (goal translate-aggregate-attribute-rules) 14 | ?rule-idx <- (aggregateattrule ?rule-string) 15 | => 16 | (bind $?classes (build-dependency-network ?rule-string)) 17 | ;(verbose "classes: " $?classes crlf) 18 | (translate-aggregate-attribute-rule ?rule-string $?classes) 19 | (retract ?rule-idx) 20 | (bind ?*untranslated_rules* (- ?*untranslated_rules* 1)) 21 | ) 22 | 23 | (defrule translate-2nd-order-rules 24 | (goal translate-2nd-order-rules) 25 | ?rule-idx <- (2nd-order-rule ?rule-string $?results-2nd-order) 26 | => 27 | (translate-2nd-order-rule ?rule-string $?results-2nd-order) 28 | (retract ?rule-idx) 29 | (bind ?*untranslated_rules* (- ?*untranslated_rules* 1)) 30 | ) 31 | 32 | (defrule pre-compile-deductive-rules 33 | (goal pre-compile-deductive-rules) 34 | ?rule-idx <- (deductiverule ?rule-string) 35 | => 36 | (pre-compile-deductive-rule ?rule-string) 37 | (retract ?rule-idx) 38 | (bind ?*untranslated_rules* (- ?*untranslated_rules* 1)) 39 | ) 40 | 41 | (defrule translate-deductive-rules 42 | (goal translate-deductive-rules) 43 | ?rule-idx <- (deductive-rule (deductive-rule ?rule-string) (production-rule "") (depends-on $? ?class $?)) 44 | (not (deductive-rule (production-rule "") (implies ?class))) 45 | => 46 | (translate-deductive-rule ?rule-idx ?rule-string) 47 | ) 48 | 49 | (defrule insert-pending-rules 50 | (goal insert-pending-rules) 51 | ?rule-idx <- (pending-rule (production-rule ?pr) (delete-production-rule ?dpr) (non-existent-classes $?classes)) 52 | => 53 | (insert-pending-rule ?pr ?dpr $?classes) 54 | (retract ?rule-idx) 55 | ) 56 | 57 | (defrule calc-stratum-for-all 58 | (goal calc-stratum-for-all) 59 | ?rule-idx <- (deductive-rule (production-rule ?rule-condition&~"") (derived-class ?class&~nil)) 60 | => 61 | (calc-stratum-afterwards ?rule-condition ?class) 62 | ) 63 | 64 | -------------------------------------------------------------------------------- /csd.auth.gr/R-DEVICE/types.clp: -------------------------------------------------------------------------------- 1 | (deffunction discover-slot-name (?pos $?cond-elem) 2 | (bind ?pos (- ?pos 1)) 3 | (while (neq (nth$ ?pos $?cond-elem) "(") 4 | do 5 | (bind ?pos (- ?pos 1)) 6 | ) 7 | (nth$ (+ ?pos 1) $?cond-elem) 8 | ) 9 | 10 | (deffunction discover-type (?var $?condition) 11 | (if (= (length$ $?condition) 0) 12 | then 13 | (create$) 14 | else 15 | (bind ?p2 (get-token $?condition)) 16 | (bind $?cond-elem (subseq$ $?condition 1 ?p2)) 17 | ;(bind $?rest-cond (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 18 | (if (or 19 | (eq (nth$ 2 $?cond-elem) not) 20 | (eq (nth$ 2 $?cond-elem) test)) 21 | then 22 | (discover-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 23 | else 24 | (if (or 25 | (eq (nth$ 2 $?cond-elem) and) 26 | (eq (nth$ 2 $?cond-elem) or)) 27 | then 28 | (bind ?type (discover-type ?var (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1)))) 29 | (if (not ?type) 30 | then 31 | (discover-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 32 | else 33 | ?type 34 | ) 35 | else 36 | (if (eq (nth$ 2 $?cond-elem) <-) 37 | then 38 | (bind $?cond-elem (subseq$ $?cond-elem 3 (length$ $?cond-elem))) 39 | else 40 | (if (eq (nth$ 4 $?cond-elem) name) 41 | then 42 | (bind $?cond-elem (delete$ $?cond-elem 3 6)) 43 | ) 44 | ) 45 | (bind ?pos (member$ ?var $?cond-elem)) 46 | (if (not ?pos) 47 | then 48 | (discover-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 49 | else 50 | (bind ?slot (discover-slot-name ?pos $?cond-elem)) 51 | (if (eq (nth$ 2 $?cond-elem) object) 52 | then 53 | (bind ?class (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem)) 54 | else 55 | (bind ?class (nth$ 2 $?cond-elem)) 56 | ) 57 | (if (and (class-existp ?class) (slot-existp ?class ?slot)) 58 | then 59 | (bind $?slot-types (slot-types ?class ?slot)) 60 | (if (eq (nth$ 1 $?slot-types) INSTANCE-NAME) 61 | then 62 | (create$ INSTANCE-NAME (get-type-of ?class ?slot)) 63 | else 64 | $?slot-types 65 | ) 66 | else 67 | (if (and (eq (sub-string 1 3 ?class) "gen") (eq (sub-string (- (length ?slot) 3) (length ?slot) ?slot) "_obj")) 68 | then 69 | (create$ INSTANCE-NAME USER) 70 | else 71 | (create$) 72 | ) 73 | ) 74 | ) 75 | ) 76 | ) 77 | ) 78 | ) 79 | 80 | (deffunction discover-ref-type (?var $?condition) 81 | (if (= (length$ $?condition) 0) 82 | then 83 | (create$) 84 | else 85 | (bind ?p2 (get-token $?condition)) 86 | (bind $?cond-elem (subseq$ $?condition 1 ?p2)) 87 | ;(bind $?rest-cond (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 88 | (if (or 89 | (eq (nth$ 2 $?cond-elem) not) 90 | (eq (nth$ 2 $?cond-elem) test)) 91 | then 92 | (discover-ref-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 93 | else 94 | (if (or 95 | (eq (nth$ 2 $?cond-elem) and) 96 | (eq (nth$ 2 $?cond-elem) or)) 97 | then 98 | (bind $?type (discover-ref-type ?var (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1)))) 99 | (if (= (length$ $?type) 0) 100 | then 101 | (discover-ref-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 102 | else 103 | $?type 104 | ) 105 | else 106 | (if (or 107 | (and 108 | (eq (nth$ 1 $?cond-elem) ?var) 109 | (eq (nth$ 2 $?cond-elem) <-)) 110 | (and 111 | (eq (nth$ 4 $?cond-elem) name) 112 | (eq (nth$ 5 $?cond-elem) ?var))) 113 | then 114 | ;(bind ?class (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem)) 115 | (create$ INSTANCE-NAME (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem)) 116 | else 117 | (discover-ref-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition))) 118 | ) 119 | ) 120 | ) 121 | ) 122 | ) 123 | 124 | (deffunction guess-slot-def ($?condition-and-slot) 125 | ;(verbose "guess-slot-def - $?condition-and-slot: " $?condition-and-slot crlf) 126 | (bind $?condition (subseq$ $?condition-and-slot 1 (- (member$ $$$ $?condition-and-slot) 1))) 127 | (bind $?slot (subseq$ $?condition-and-slot (+ (member$ $$$ $?condition-and-slot) 1) (length$ $?condition-and-slot))) 128 | (bind $?value-expr (subseq$ $?slot 3 (- (length$ $?slot) 1))) 129 | (if (= (length$ $?value-expr) 1) 130 | then 131 | (bind ?value (nth$ 1 $?value-expr)) 132 | (if (is-singlevar ?value) 133 | then 134 | (bind ?slot-field slot) 135 | else 136 | (if (is-multivar ?value) 137 | then 138 | (bind ?slot-field multislot) 139 | else 140 | (bind ?slot-field slot) 141 | ) 142 | ) 143 | else 144 | (if (eq (nth$ 1 $?value-expr) "(") 145 | then 146 | (if (and 147 | (is-aggregate-function (nth$ 2 $?value-expr)) 148 | (is-var (nth$ 3 $?value-expr))) 149 | then 150 | (bind ?slot-field multislot) 151 | (bind ?value (nth$ 3 $?value-expr)) 152 | else 153 | (bind ?slot-field multislot) 154 | (bind ?value (nth$ 2 $?value-expr)) 155 | ) 156 | ) 157 | ) 158 | (if (floatp ?value) 159 | then 160 | (bind $?type FLOAT) 161 | (bind $?ref-type (create$)) 162 | else 163 | (if (integerp ?value) 164 | then 165 | (bind $?type INTEGER) 166 | (bind $?ref-type (create$)) 167 | else 168 | (if (symbolp ?value) 169 | then 170 | (bind $?type SYMBOL) 171 | (bind $?ref-type (create$)) 172 | else 173 | (if (is-var ?value) 174 | then 175 | (bind $?type (discover-type ?value $?condition)) 176 | (if (= (length$ $?type) 0) 177 | then 178 | (bind $?type (discover-ref-type ?value $?condition)) 179 | ) 180 | (if (= (length$ $?type) 0) 181 | then 182 | (bind $?type "?VARIABLE") 183 | (bind $?ref-type (create$)) 184 | else 185 | (if (eq (nth$ 1 $?type) INSTANCE-NAME) 186 | then 187 | ;(bind ?class (nth$ 2 $?type)) 188 | ;(bind ?slot-name (nth$ 2 $?slot)) 189 | (bind $?ref-type (create$ (nth$ 2 $?slot) (nth$ 2 $?type))) 190 | (bind $?type INSTANCE-NAME) 191 | else 192 | (bind $?ref-type (create$)) 193 | ) 194 | ) 195 | else 196 | (bind $?type STRING) 197 | (bind $?ref-type (create$)) 198 | ) 199 | ) 200 | ) 201 | ) 202 | (create$ 203 | "(" ?slot-field (nth$ 2 $?slot) "(" type $?type ")" ")" 204 | ;(insert$ (replace$ $?slot 3 3 (create$ "(" type $?type ")")) 2 ?slot-field) 205 | $$$ 206 | $?ref-type 207 | ) 208 | ) 209 | 210 | (deffunction guess-slot-defs ($?condition-and-slots) 211 | (bind $?condition (subseq$ $?condition-and-slots 1 (- (member$ $$$ $?condition-and-slots) 1))) 212 | (bind $?slots (subseq$ $?condition-and-slots (+ (member$ $$$ $?condition-and-slots) 1) (length$ $?condition-and-slots))) 213 | (if (= (length$ $?slots) 0) 214 | then 215 | (create$ $$$) 216 | else 217 | ;(bind ?p1 (member$ "(" $?slots)) 218 | ;(bind ?p2 (member$ ")" $?slots)) 219 | (bind ?p2 (get-token $?slots)) 220 | ;(bind $?slot (subseq$ $?slots (member$ "(" $?slots) ?p2)) 221 | (bind $?new-slot-and-ref (guess-slot-def (create$ $?condition $$$ (subseq$ $?slots (member$ "(" $?slots) ?p2)))) 222 | ;(bind $?new-slot (subseq$ $?new-slot-and-ref 1 (- (member$ $$$ $?new-slot-and-ref) 1))) 223 | ;(bind $?new-reference-type (subseq$ $?new-slot-and-ref (+ (member$ $$$ $?new-slot-and-ref) 1) (length$ $?new-slot-and-ref))) 224 | ;(bind $?rest-slots (subseq$ $?slots (+ ?p2 1) (length$ $?slots))) 225 | (bind $?new-rest-slots-and-refs (guess-slot-defs (create$ $?condition $$$ (subseq$ $?slots (+ ?p2 1) (length$ $?slots))))) 226 | ;(bind $?new-rest-slots (subseq$ $?new-rest-slots-and-refs 1 (- (member$ $$$ $?new-rest-slots-and-refs) 1))) 227 | ;(bind $?new-rest-reference-types (subseq$ $?new-rest-slots-and-refs (+ (member$ $$$ $?new-rest-slots-and-refs) 1) (length$ $?new-rest-slots-and-refs))) 228 | (create$ (subseq$ $?new-slot-and-ref 1 (- (member$ $$$ $?new-slot-and-ref) 1)) (subseq$ $?new-rest-slots-and-refs 1 (- (member$ $$$ $?new-rest-slots-and-refs) 1)) $$$ (subseq$ $?new-slot-and-ref (+ (member$ $$$ $?new-slot-and-ref) 1) (length$ $?new-slot-and-ref)) (subseq$ $?new-rest-slots-and-refs (+ (member$ $$$ $?new-rest-slots-and-refs) 1) (length$ $?new-rest-slots-and-refs))) 229 | ) 230 | ) 231 | 232 | (deffunction discover-class-of-var (?class-expr $?condition) 233 | (bind ?pos (member$ ?class-expr $?condition)) 234 | (if (integerp ?pos) 235 | then 236 | (if (eq (nth$ (- ?pos 2) $?condition) <-) 237 | then 238 | (bind ?oid (nth$ (- ?pos 3) $?condition)) 239 | (if (not (is-var ?oid)) 240 | then 241 | (if (instance-existp (symbol-to-instance-name ?oid)) 242 | then 243 | (return (class (symbol-to-instance-name ?oid))) 244 | else 245 | (return ?class-expr) 246 | ) 247 | else 248 | (bind $?types (discover-type ?oid $?condition)) 249 | (if (eq (nth$ 1 $?types) INSTANCE-NAME) 250 | then 251 | (return (nth$ 2 $?types)) 252 | else 253 | (return ?class-expr) 254 | ) 255 | ) 256 | else 257 | (return ?class-expr) 258 | ) 259 | else 260 | (return ?class-expr) 261 | ) 262 | ) 263 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/.note: -------------------------------------------------------------------------------- 1 | total 2.6M 2 | -rw-r--r-- 1 bobak 838K Apr 6 2008 CLIPSDOS.exe 3 | -rw-r--r-- 1 bobak 850K Apr 6 2008 CLIPSWin.exe 4 | -rw-r--r-- 1 bobak 2.4K Oct 13 2009 config.bat 5 | -rw-r--r-- 1 bobak 1015 Aug 30 2009 create-classes.clp 6 | -rw-r--r-- 1 bobak 2.2K Sep 7 2009 create-objects.clp 7 | -rw-r--r-- 1 bobak 41K Oct 9 2009 create-templates.clp 8 | -rw-r--r-- 1 bobak 135 Aug 27 2009 description.txt 9 | -rw-r--r-- 1 bobak 1001 Oct 11 2009 exec.bat 10 | -rw-r--r-- 1 bobak 55K Oct 13 2009 functions.clp 11 | -rw-r--r-- 1 bobak 7.0K Oct 13 2009 global.clp 12 | -rw-r--r-- 1 bobak 1.2K Aug 27 2009 how-to-use.txt 13 | -rw-r--r-- 1 bobak 27K Oct 14 2009 j2cf.jar 14 | -rw-r--r-- 1 bobak 576 Aug 20 2009 LICENSE.txt 15 | -rw-r--r-- 1 bobak 151 Aug 20 2009 NOTICE.txt 16 | -rw-r--r-- 1 bobak 664K Feb 27 2014 odevice_v2.rar 17 | -rw-r--r-- 1 bobak 1.7K Oct 11 2009 order.clp 18 | -rw-r--r-- 1 bobak 1.9K Oct 14 2009 prepare.bat 19 | -rw-r--r-- 1 bobak 1022 Aug 27 2009 readme.txt 20 | -rw-r--r-- 1 bobak 2.9K Oct 14 2009 release_notes.txt 21 | -rw-r--r-- 1 bobak 25K Oct 6 2009 rule-generator.clp 22 | -rw-r--r-- 1 bobak 4.5K Oct 9 2009 vocabulary-abbr.clp 23 | -rw-r--r-- 1 bobak 7.1K Oct 9 2009 vocabulary.clp 24 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright 2009 Georgios Meditskos 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and limitations 13 | under the License. -------------------------------------------------------------------------------- /csd.auth.gr/o-device/NOTICE.txt: -------------------------------------------------------------------------------- 1 | 2 | -O-DEVICE makes use of the Jena API (http://jena.sourceforge.net/) 3 | -O-DEVICE makes use of the CLIPS rule engine (http://clipsrules.sourceforge.net/) -------------------------------------------------------------------------------- /csd.auth.gr/o-device/config.bat: -------------------------------------------------------------------------------- 1 | ;;; ###################################################################################### 2 | ;;; ******* Modify these gloabals according to your configuration ****** 3 | ;;; ###################################################################################### 4 | 5 | ;******************************* 6 | ;*** Display infos, warnings *** 7 | ;******************************* 8 | (defglobal ?*warn* = TRUE) 9 | (defglobal ?*info* = TRUE) 10 | 11 | ;*************** 12 | ;*** FOLDERS *** 13 | ;*************** 14 | ;the folder path where the distribution folder of O-DEVICE exists 15 | (defglobal ?*odevice-folder* = "c:/Users/George/Desktop/@work/_code/odevice/") 16 | 17 | ;the folder path with the source files of O-DEVICE 18 | (defglobal ?*src-folder* = (str-cat ?*odevice-folder* "src/")) 19 | 20 | ;the folder path where the generated files will be stored 21 | (defglobal ?*bundle-folder* = (str-cat ?*odevice-folder* "bundle/")) 22 | 23 | ;the folder path where the facts will be stored by the J2CF module 24 | (defglobal ?*triple-folder* = (str-cat ?*odevice-folder* "triple-facts/")) 25 | 26 | 27 | 28 | ;************* 29 | ;*** FILES *** 30 | ;************* 31 | ;the file path where the dynamic rules will be stored 32 | (defglobal ?*rule-file* = (str-cat ?*bundle-folder* "$rules.clp")) 33 | 34 | ;the file path where the facts of O-DEVICE will be stored 35 | (defglobal ?*fact-file* = (str-cat ?*bundle-folder* "$facts.clp")) 36 | 37 | ;the file path where the classes of O-DEVICE will be stored 38 | (defglobal ?*class-file* = (str-cat ?*bundle-folder* "$classes.clp")) 39 | 40 | ;the file path where the generated objects will be stored 41 | (defglobal ?*object-file* = (str-cat ?*bundle-folder* "$objects.clp")) 42 | 43 | ;the file path where the triple-based facts will be stored 44 | (defglobal ?*triple-facts* = (str-cat ?*triple-folder* "$triples.clp")) 45 | 46 | ;the path of the index file where the instances will be saved (restore-instances*). 47 | (defglobal ?*ins-idx* = (str-cat ?*odevice-folder* "$ins.idx")) 48 | 49 | 50 | 51 | 52 | 53 | ;************ 54 | ;*** MISC *** 55 | ;************ 56 | 57 | ;whether to use prefixes or complete namespaces. It is recommended to 58 | ;use TRUE since it results in faster execution 59 | (defglobal ?*abbr* = TRUE) 60 | 61 | ;whether the imported ontologies should be processed or not 62 | (defglobal ?*imports* = TRUE) 63 | 64 | ;Load the ontology vocabulary in the form of defglobal variables 65 | (if ?*abbr* 66 | then (load* (str-cat ?*src-folder* "vocabulary-abbr.clp")) 67 | else (load* (str-cat ?*src-folder* "vocabulary.clp")) 68 | ) 69 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/create-classes.clp: -------------------------------------------------------------------------------- 1 | ;;; ###################################################################################### 2 | ;;; # Rules for generating the COOL classes 3 | ;;; ###################################################################################### 4 | 5 | ;;; owl:Thing is the superclass of all the classes 6 | (defrule realize-owl:Thing 7 | (declare (salience 9910)) 8 | (goal (name delegators-defined)) 9 | ?T <- (CLASS (name ?term&:(eq ?term ?*owl:Thing*))(slots $?slots)(materialized FALSE)) 10 | => 11 | (define-class ?*owl:Thing* (create$ USER) $?slots) 12 | (modify ?T (materialized TRUE)) 13 | ) 14 | 15 | ;;; create the class. Note that the restriction classes do not 16 | ;;; participate physically in the OO model 17 | (defrule realize-class 18 | (declare (salience 9909)) 19 | (goal (name delegators-defined)) 20 | ?CL <- (CLASS (name ?c)(subclass $?superclasses)(slots $?slots)(materialized FALSE)) 21 | (not (CLASS (name ?c2 & ~?c &:(member$ ?c2 $?superclasses))(materialized FALSE))) 22 | => 23 | (define-class ?c $?superclasses $?slots) 24 | (modify ?CL (materialized TRUE)) 25 | ) 26 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/create-objects.clp: -------------------------------------------------------------------------------- 1 | ;;; ###################################################################################### 2 | ;;; Rules for generating the objects. O-DEVICE uses two user-defined functions 3 | ;;; for creating objects and inserting slot values, namely owl-make-instance and 4 | ;;; owl-insert-values, respectively (see functions.clp for more details) 5 | ;;; ###################################################################################### 6 | ;;; create the object based on the rdf:type value 7 | (defrule create-object 8 | (declare (salience 9900)) 9 | (goal (name delegators-defined)) 10 | ?t <- (triple (subject ?o) (predicate ?term&:(eq ?term ?*rdf:type*))(object ?class)) 11 | (CLASS(name ?class)) 12 | => 13 | (owl-make-instance ?o ?class) 14 | (retract ?t) 15 | ) 16 | 17 | ;;; manage owl:oneOf 18 | (defrule owl:oneOf 19 | (declare (salience 9900)) 20 | (goal (name delegators-defined)) 21 | ?t <- (triple (subject ?c)(predicate ?term&:(eq ?term ?*owl:oneOf*))(object ?oneof)) 22 | (CLASS (name ?c)) 23 | => 24 | (bind $?objects (collect-list-elements ?oneof)) 25 | (progn$ (?obj $?objects) 26 | (owl-make-instance ?obj ?c)) 27 | (retract ?t) 28 | ) 29 | 30 | ;;; owl:allDifferent construct 31 | (defrule owl:allDifferent 32 | (declare (salience 9900)) 33 | (goal (name delegators-defined)) 34 | ?t1 <- (triple (subject ?c)(predicate ?term1&:(eq ?term1 ?*rdf:type*)) 35 | (object ?term2&:(eq ?term2 ?*owl:AllDifferent*))) 36 | ?t2 <- (triple (subject ?c)(predicate ?term3&:(eq ?term3 ?*owl:distinctMembers*))(object ?list)) 37 | => 38 | (bind $?objects (collect-list-elements ?list)) 39 | (progn$ (?o1 $?objects) 40 | (progn$ (?o2 $?objects) 41 | (owl-insert-value ?o1 ?*owl:differentFrom* ?o2))) 42 | (retract ?t1) 43 | (retract ?t2) 44 | ) 45 | 46 | ;;; owl:hasValue construct 47 | (defrule owl:hasValue-object 48 | (declare (salience 9899)) 49 | (goal (name delegators-defined)) 50 | (RESTRICTION (onProperty ?p)(restriction hasValue)(value ?o)) 51 | (PROPERTY (name ?p&: (is-object-property ?p))) 52 | (test (not (instance-existp ?o))) 53 | => 54 | (owl-make-instance ?o ?*owl:Thing*) 55 | ) 56 | 57 | ;;; insert values into the objects 58 | (defrule insert-object-value 59 | (declare (salience 9899)) 60 | (goal (name delegators-defined)) 61 | ?t <- (triple (subject ?o)(predicate ?p)(object ?v)) 62 | (PROPERTY (name ?p)) 63 | => 64 | (owl-insert-value ?o ?p ?v) 65 | (retract ?t) 66 | ) 67 | 68 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/description.txt: -------------------------------------------------------------------------------- 1 | 2 | For more details about O-DEVICE, please read the corresponding paper 3 | 4 | http://doi.ieeecomputersociety.org/10.1109/TKDE.2007.190699 5 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/exec.bat: -------------------------------------------------------------------------------- 1 | ;;; ###################################################################################### 2 | ;;; Load the generated files of O-DEVICE and the necessary O-DEVICE source code. 3 | ;;; ###################################################################################### 4 | (set-dynamic-constraint-checking FALSE) 5 | (object-pattern-match-delay 6 | (load* (str-cat ?*src-folder* "global.clp")) 7 | (load* (str-cat ?*src-folder* "functions.clp")) 8 | (load* (str-cat ?*src-folder* "order.clp")) 9 | (load* ?*class-file*) 10 | (load-facts ?*fact-file*) 11 | (load* ?*rule-file*) 12 | (restore-instances ?*object-file*)) 13 | (set-dynamic-constraint-checking TRUE) 14 | 15 | (assert (goal (name delegators-defined))) 16 | 17 | ;use the 'build' function to define the rule in JAVA 18 | (defrule $refresh$ 19 | (declare (salience 8999)) 20 | ?UP <- (UPDATE (refresh TRUE)) 21 | => 22 | (debug info "updating...") 23 | (modify ?UP (refresh FALSE)) 24 | (load* ?*rule-file*) 25 | (progn$ (?r ?*rule-files*) 26 | (printout t test crlf) 27 | (load* ?r)) 28 | (run)) 29 | 30 | (run) 31 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/global.clp: -------------------------------------------------------------------------------- 1 | 2 | ;;; ###################################################################################### 3 | ;;; Deftemplate definition for storing and manipulating the order of the classes 4 | ;;; in the is-a constraint of defclass definitions. In that way, O-DEVICE prevents the 5 | ;;; throwing of errors relevant to class precedence lists 6 | ;;; ###################################################################################### 7 | (deftemplate strong-order 8 | (slot c1) 9 | (slot c2) 10 | ) 11 | 12 | ;;; ###################################################################################### 13 | ;;; System template for regulating the execution of rules 14 | ;;; ###################################################################################### 15 | (deftemplate goal 16 | (slot name) 17 | ) 18 | 19 | ;;; ###################################################################################### 20 | ;;; Template for holding the COOL code of classes 21 | ;;; ###################################################################################### 22 | (deftemplate DEFCLASS 23 | (slot code) 24 | ) 25 | 26 | ;;; ###################################################################################### 27 | ;;; Template for holding the namespace-to-prefix mapping that Jena computes for the set 28 | ;;; of the loaded ontologies 29 | ;;; ###################################################################################### 30 | (deftemplate PrefixNsMap 31 | ;e.g. rdfs, owl, ... 32 | (slot prefix) 33 | ;e.g. xsd:, ... 34 | (slot namespace) 35 | ) 36 | 37 | ;;; ###################################################################################### 38 | ;;; Deftemplate definition for storing the state of O-DEVICE. If a class in CLIPS 39 | ;;; is generated dynamically, then the objects of this class cannot be matched in the 40 | ;;; conditions of rules, since the class has been defined after the definition of the 41 | ;;; corresponding object pattern. Therefore, the rules should be reloaded in order 42 | ;;; to incorporate further rule activations. This may cause an overhead to the 43 | ;;; perfromance of O-DEVICE and it has to do with the semantics of OWL that require 44 | ;;; sometimes to generate dynamically classes, e.g. in the case of an object that 45 | ;;; belongs simlultaneously to more than one class. 46 | ;;; ###################################################################################### 47 | (deftemplate UPDATE 48 | (slot refresh) 49 | ) 50 | 51 | ;;; ###################################################################################### 52 | ;;; Deftemplate definition for storing the synamic rules that O-DEVICE generates. 53 | ;;; ###################################################################################### 54 | (deftemplate rule 55 | ;rule type 56 | (slot type) 57 | ;rule name 58 | (slot name) 59 | ;rule definition 60 | (slot code) 61 | ) 62 | 63 | ;;; ###################################################################################### 64 | ;;; Deftemplate definition for storing in the form of CLIPS facts the ontology triples 65 | ;;; that the ARP Parser produces 66 | ;;; ###################################################################################### 67 | (deftemplate triple 68 | ;the subject of the triple 69 | (slot subject) 70 | ;the predicate of the triples 71 | (slot predicate) 72 | ;the object of the triple 73 | (slot object) 74 | ) 75 | 76 | ;;; ###################################################################################### 77 | ;;; Deftemplate definition for collecting the information regarding the OWL classes. 78 | ;;; ###################################################################################### 79 | (deftemplate CLASS 80 | ;the name of the class 81 | (slot name) 82 | ;direct superclasses (rdfs:subClassOf) 83 | (multislot subclass) 84 | ;intesection classes (owl:intersectionOf) 85 | (multislot intersection) 86 | ;equivalent classes (owl:equivalentClass) 87 | (multislot equivalent) 88 | ;complement of classes (owl:complementOf) 89 | (multislot complement) 90 | ;disjoint classes (owl:disjointWith) 91 | (multislot disjoint) 92 | ;union classes (owl:unionOf) 93 | (multislot union) 94 | ;owl:hasKey - only the named classes have keys 95 | (multislot hasKey) 96 | ;the properties that have this class as a domain 97 | (multislot slots) 98 | ;initially, all the classes are not delegators. The delegators are used 99 | ;for the mapping of OWL class equivalence, since subclass 100 | ;circles are forbitten in the oo model. 101 | (slot delegator (default FALSE)) 102 | ;label (rdfs:label) 103 | (slot label) 104 | ;comment (rdfs:comment) 105 | (slot comment) 106 | ;if the fact has been mapped on a COOL class 107 | (slot materialized (default FALSE)) 108 | ) 109 | 110 | ;;; ###################################################################################### 111 | ;;; Deftemplate definition for collecting the information regarding OWL restriction 112 | ;;; classes. The restriction classes are not mapped on actual COOL classes, but they 113 | ;;; are used in order to generate dynamically object classification rules. 114 | ;;; ###################################################################################### 115 | (deftemplate RESTRICTION 116 | ;the name 117 | (slot name) 118 | ;the owl:onProperty value 119 | (slot onProperty) 120 | ;owl:onClass 121 | (slot onClass) 122 | ;owl:onDataRange 123 | (slot onDataRange) 124 | ;the restriction type (owl:cardinality, owl:someValuesFrom, etc) 125 | (slot restriction) 126 | ;the restriction value 127 | (slot value) 128 | ;potential restriction superclass (currently O-DEVICE ignores 129 | ;superclasses of restriction classes) 130 | (multislot subclass) 131 | ;potential equivalent classes (currently O-DEVICE ignores 132 | ;equivalent classes of restriction classes) 133 | (multislot equivalent) 134 | ;label 135 | (slot label) 136 | ;comment 137 | (slot comment) 138 | ) 139 | 140 | ;;; ###################################################################################### 141 | ;;; Deftemplate definition for collecting the information regarding OWL properties. 142 | ;;; ###################################################################################### 143 | (deftemplate PROPERTY 144 | ;the property name 145 | (slot name) 146 | ;the type of the property (object, datatype, transitive, etc) 147 | (multislot type) 148 | ;the domain classes (rdfs:domain) 149 | (multislot domain) 150 | ;the range classes (rdfs:range) 151 | (multislot range) 152 | ;subproperties (rdfs:subPropertyOf) 153 | (multislot subproperty) 154 | ;equivalent properties (owl:equivalentProperty) 155 | (multislot equivalentProperty) 156 | ;inverse properties (owl:inverseOf) 157 | (multislot inverse) 158 | ;property chains 159 | (multislot propertyChain) 160 | ;label 161 | (slot label) 162 | ;comment 163 | (slot comment) 164 | ) 165 | 166 | ;;; ###################################################################################### 167 | ;;; Deftemplate definition for collecting the information regarding data ranges 168 | ;;; (owl:DataRange). 169 | ;;; ###################################################################################### 170 | (deftemplate DATARANGE 171 | ;the name 172 | (slot name) 173 | ;the values that the data range contains 174 | (multislot oneOf) 175 | ) 176 | 177 | ;;; ###################################################################################### 178 | ;;; Deftemplate definition for collecting the information regarding disjoint classes 179 | ;;; (owl:AllDisjointClasses) 180 | ;;; ###################################################################################### 181 | (deftemplate ALL_DISJOINT_CLASSES 182 | ;the name 183 | (slot name) 184 | ;the classes 185 | (multislot members) 186 | ) 187 | 188 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/how-to-use.txt: -------------------------------------------------------------------------------- 1 | 2 | How to Use 3 | ============= 4 | -> Modify the file odevice/config.bat in order to 5 | match your configuration. In principle, only the 6 | folder path of O-DEVICE needs to be defined. 7 | 8 | -> Add to the odevice/prepare.bat file the ontology(ies) 9 | you want to transform using the load-ontology function, e.g. 10 | (load-ontology "http://www..." "http://www" "file:c:/work/..") 11 | 12 | -> Start the CLIPS rule engine 13 | 14 | -> Execute the odevice/config.bat file, i.e. 15 | CLIPS> (batch* odevice/config.bat) 16 | 17 | -> Execute the odevice/prepare.bat file, i.e. 18 | CLIPS> (batch* odevice/prepare.bat) 19 | 20 | -> Execute the (clear) function of CLIPS or run a complete 21 | new instance of the CLIPS rule engine. 22 | 23 | -> Execute the odevice/exec.bat file, i.e. 24 | CLIPS> (batch* odevice/exec.bat) 25 | 26 | -> CLIPS contains now the OO model of the ontologies, 27 | as well as some entailment rules in order to preserve 28 | some semantics of OWL in the OO model. Any new instance 29 | should be created using the O-DEVICE function 30 | (owl-make-instance instance-name class-name) and the 31 | values should be inserted into object slots using the 32 | O-DEVICE function (owl-insert-value instance-name slot value). 33 | 34 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/j2cf.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MBcode/CLIPSmsc/05a813b3993104fb8ea82700bd1cec85a2949e6d/csd.auth.gr/o-device/j2cf.jar -------------------------------------------------------------------------------- /csd.auth.gr/o-device/order.clp: -------------------------------------------------------------------------------- 1 | ;;; ###################################################################################### 2 | ;;; Manage class is-a ordering. In some cases, especially when there is a complex 3 | ;;; subclass hierarchy, an error may occur relevant to the class precedence list 4 | ;;; that CLIPS maintains. This set of rules holds the order of the classes in the 5 | ;;; is-a constraint and it makes potential reorderings to the initially defined 6 | ;;; subclass values of the CLASS facts, in order to prevent such errors. 7 | ;;; ###################################################################################### 8 | 9 | ;;; this rule checks for mutual subclass relationships between two classes 10 | ;;; and stops the execution 11 | (defrule $detect-cyrcles 12 | (declare (salience 9916)) 13 | (goal (name delegators-defined)) 14 | (strong-order (c1 ?x)(c2 ?y)) 15 | (strong-order (c1 ?y)(c2 ?x)) 16 | => 17 | (debug error "Subclass circle has been detected: " ?x ", " ?y) 18 | ) 19 | ;;; 20 | (defrule $strong-order "subclass order" 21 | (declare (salience 9915)) 22 | (goal (name delegators-defined)) 23 | (CLASS (name ?c)(subclass $? ?sup&~?c $?)) 24 | (not (strong-order (c1 ?c)(c2 ?sup))) 25 | => 26 | (assert (strong-order (c1 ?c)(c2 ?sup)))) 27 | 28 | ;;; 29 | (defrule $strong-order-transitive "order transitivity" 30 | (declare (salience 9915)) 31 | (goal (name delegators-defined)) 32 | (strong-order (c1 ?x)(c2 ?y)) 33 | (strong-order (c1 ?y)(c2 ?z&~?x)) 34 | (not (strong-order (c1 ?x)(c2 ?z))) 35 | => 36 | (assert (strong-order (c1 ?x)(c2 ?z)))) 37 | 38 | ;;; make reorderings in order to prevent errors 39 | (defrule $modify-classes 40 | (declare (salience 9915)) 41 | (goal (name delegators-defined)) 42 | (strong-order (c1 ?c)(c2 ?d)) 43 | ?class <- (CLASS (subclass $?H ?d $?M ?c $?T)) 44 | => 45 | (modify ?class (subclass (create$ $?H ?c ?d $?M $?T))) 46 | ) 47 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/prepare.bat: -------------------------------------------------------------------------------- 1 | ;;; ###################################################################################### 2 | ;;; Load the source files 3 | ;;; ###################################################################################### 4 | (load* (str-cat ?*src-folder* "global.clp")) 5 | (load* (str-cat ?*src-folder* "functions.clp")) 6 | (load* (str-cat ?*src-folder* "create-templates.clp")) 7 | (load* (str-cat ?*src-folder* "order.clp")) 8 | (load* (str-cat ?*src-folder* "create-classes.clp")) 9 | (load* (str-cat ?*src-folder* "create-objects.clp")) 10 | (load* (str-cat ?*src-folder* "rule-generator.clp")) 11 | 12 | ;;; ###################################################################################### 13 | ;;; Define the addresses or the local paths of the ontologies 14 | ;;; *Note*: This function should not be called in the case where 15 | ;;; O-DEVICE is used through JAVA (using JO-DEVICE or in any other 16 | ;;; attempt to integrate O-DEVICE in JAVA applications). In these 17 | ;;; cases, the j2cf module should be called independenly in order 18 | ;;; to create the ?*fact-file*. 19 | ;;; ###################################################################################### 20 | ;examples 21 | ;(load-ontology "http://127.0.0.1/1-ub-dl-univ0-dept0.owl") 22 | ;(load-ontology "http://www.loa-cnr.it/ontologies/DOLCE-Lite.owl") 23 | ;(load-ontology "file:c:/omconfig.owl" "ontology2" "ontology3" "ontology...") 24 | 25 | 26 | 27 | ;;; ###################################################################################### 28 | ;;; Load the generated triple-based facts (from ?*triple-facts*) 29 | ;;; ###################################################################################### 30 | (batch* ?*triple-facts*) 31 | (assert (UPDATE (refresh FALSE))) 32 | 33 | ;;; ###################################################################################### 34 | ;;; Run and save O-DEVICE 35 | ;;; ###################################################################################### 36 | (run) 37 | (save-o-device) 38 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/readme.txt: -------------------------------------------------------------------------------- 1 | 2 | Details 3 | ======= 4 | O-DEVICE is a CLIPS-based rule program that transforms OWL 5 | ontologies into the COOL model of CLIPS. It can be used 6 | either as a standalone module by loading it directly into 7 | CLIPS, or through the JO-DEVICE JAVA API 8 | (https://sourceforge.net/projects/o-device/files/). 9 | 10 | Dependencies 11 | ============ 12 | - At runtime, the standalone O-DEVICE requires the j2cf.jar 13 | (https://sourceforge.net/projects/o-device/files/) and the 14 | JENA 2.6 API libraries (http://jena.sourceforge.net/). The j2cf.jar 15 | should exist under the odevice distribution folder (odevice\\j2cf.jar) 16 | and the JENA libraries should exist in a folder lib under the odevice 17 | distribution folder (odevice\\lib\\..) 18 | - The CLIPS executable (http://clipsrules.sourceforge.net/) 19 | 20 | There is a preconfigured distribution of the standalone O-DEVICE at 21 | https://sourceforge.net/projects/o-device/files/ 22 | 23 | For more details about O-DEVICE, please read the corresponding paper 24 | http://doi.ieeecomputersociety.org/10.1109/TKDE.2007.190699 -------------------------------------------------------------------------------- /csd.auth.gr/o-device/release_notes.txt: -------------------------------------------------------------------------------- 1 | 2 | Version 2.0 3 | =========== 4 | - Support for owl:AllDisjointClasses 5 | 6 | - Add (load-rules) function for loading rule programs 7 | on top of O-DEVICE. 8 | 9 | 10 | Version 1.2 11 | =========== 12 | - Support for owl:propertyChainAxiom 13 | 14 | - New function: (owl-insert-values$) for inserting multiple 15 | instance slot values 16 | 17 | - New defglobal variable (?*imports*) in order to control 18 | the processing of the imported ontologies 19 | 20 | - Support for qualified cardinality restrictions (partially) 21 | 22 | - Support for owl:hasKey property 23 | 24 | - Add functions for backing-up/restoring instances 25 | 26 | - The restore-instance* function checks also for the 27 | existence of the instance slots 28 | 29 | 30 | Version 1.1 31 | =========== 32 | - Code optimizations: 33 | - many functions have been re-written 34 | - some redundant rules have been removed (e.g. the collect-restrictions.clp) 35 | 36 | 37 | Version 1.0 38 | =========== 39 | - Major source code reorganization: only the relevant constructs are 40 | loaded using the exec.bat, resulting in faster rule execution 41 | 42 | - The (run) function is not executed any more by the functions 43 | owl-make-instance and owl-insert-value. Use instead the functions 44 | owl-make-instance-run and owl-insert-value-run 45 | 46 | 47 | Version 0.3 48 | =========== 49 | - Support for the owl:complementOf construct (checks if there are 50 | objects that belong to complement classes) 51 | 52 | - The call to the j2cf module needs to specify the ?*abbr* flag (config.bat) 53 | that denotes whether the prefixes or the namespaces should be used during the 54 | generation of the triple-based facts (create-facts function). It is recommended 55 | to use ?*abbr* = TRUE in config.bat, since it results in faster execution. 56 | 57 | - Enhanced slot type mappings regarding boolean, nonNegativeInteger, positiveInteger, 58 | nonPositiveInteger and short ranges 59 | 60 | - Only the generated code is stored into the bundle folder, without the source 61 | code of O-DEVICE (modified exec.bat file). 62 | 63 | - defglobals for OWL and RDF/RDFS vocabulary 64 | 65 | 66 | Version 0.2 67 | =========== 68 | - The namespaces are mapped on prefixes for better performance. 69 | 70 | - Parameterizes the file/folder paths (through the config.bat). 71 | 72 | - Allows the definition of more than one ontology 73 | as parameters for the function load_ontology, for 74 | example, (load-ontology "file:c:\\..." "file:c:\\..." ...) 75 | 76 | - Fixes some performance problems regarding the 77 | loading of ontologies with large number of classes. 78 | 79 | - Facts of the template PrefixNsMap are generated that 80 | contain information about the prefixes mapping on namespaces 81 | of the loaded ontologies (these mappings are computed 82 | by Jena) 83 | 84 | - The function "ns" has been added for substituting the prefix 85 | with the corresponding namespace. 86 | 87 | - The function mapPrefixNs has been added that allows the 88 | definition of new mappings for prefixes/namespaces. 89 | 90 | - CLIPS cannot process symbols that contain the character '~'. 91 | This character is removed. -------------------------------------------------------------------------------- /csd.auth.gr/o-device/vocabulary-abbr.clp: -------------------------------------------------------------------------------- 1 | ;OWL 2 | (defglobal ?*owl:AllDifferent* = owl:AllDifferent) 3 | (defglobal ?*owl:allValuesFrom* = owl:allValuesFrom) 4 | (defglobal ?*owl:AnnotationProperty* = owl:AnnotationProperty) 5 | (defglobal ?*owl:backwardCompatibleWith* = owl:backwardCompatibleWith) 6 | (defglobal ?*owl:cardinality* = owl:cardinality) 7 | (defglobal ?*owl:Class* = owl:Class) 8 | (defglobal ?*owl:complementOf* = owl:complementOf) 9 | (defglobal ?*owl:DataRange* = owl:DataRange) 10 | (defglobal ?*owl:DatatypeProperty* = owl:DatatypeProperty) 11 | (defglobal ?*owl:DeprecatedClass* = owl:DeprecatedClass) 12 | (defglobal ?*owl:DeprecatedProperty* = owl:DeprecatedProperty) 13 | (defglobal ?*owl:differentFrom* = owl:differentFrom) 14 | (defglobal ?*owl:disjointWith* = owl:disjointWith) 15 | (defglobal ?*owl:distinctMembers* = owl:distinctMembers) 16 | (defglobal ?*owl:equivalentClass* = owl:equivalentClass) 17 | (defglobal ?*owl:equivalentProperty* = owl:equivalentProperty) 18 | (defglobal ?*owl:FunctionalProperty* = owl:FunctionalProperty) 19 | (defglobal ?*owl:hasValue* = owl:hasValue) 20 | (defglobal ?*owl:imports* = owl:imports) 21 | (defglobal ?*owl:incompatibleWith* = owl:incompatibleWith) 22 | (defglobal ?*owl:intersectionOf* = owl:intersectionOf) 23 | (defglobal ?*owl:InverseFunctionalProperty* = owl:InverseFunctionalProperty) 24 | (defglobal ?*owl:inverseOf* = owl:inverseOf) 25 | (defglobal ?*owl:maxCardinality* = owl:maxCardinality) 26 | (defglobal ?*owl:minCardinality* = owl:minCardinality) 27 | (defglobal ?*owl:Nothing* = owl:Nothing) 28 | (defglobal ?*owl:ObjectProperty* = owl:ObjectProperty) 29 | (defglobal ?*owl:oneOf* = owl:oneOf) 30 | (defglobal ?*owl:onProperty* = owl:onProperty) 31 | (defglobal ?*owl:Ontology* = owl:Ontology) 32 | (defglobal ?*owl:OntologyProperty* = owl:OntologyProperty) 33 | (defglobal ?*owl:priorVersion* = owl:priorVersion) 34 | (defglobal ?*owl:Restriction* = owl:Restriction) 35 | (defglobal ?*owl:sameAs* = owl:sameAs) 36 | (defglobal ?*owl:someValuesFrom* = owl:someValuesFrom) 37 | (defglobal ?*owl:SymmetricProperty* = owl:SymmetricProperty) 38 | (defglobal ?*owl:Thing* = owl:Thing) 39 | (defglobal ?*owl:TransitiveProperty* = owl:TransitiveProperty) 40 | (defglobal ?*owl:unionOf* = owl:unionOf) 41 | (defglobal ?*owl:versionInfo* = owl:versionInfo) 42 | (defglobal ?*owl:hasKey* = owl:hasKey) 43 | (defglobal ?*owl:onClass* = owl:onClass) 44 | (defglobal ?*owl:minQualifiedCardinality* = owl:minQualifiedCardinality) 45 | (defglobal ?*owl:maxQualifiedCardinality* = owl:maxQualifiedCardinality) 46 | (defglobal ?*owl:qualifiedCardinality* = owl:qualifiedCardinality) 47 | (defglobal ?*owl:propertyChainAxiom* = owl:propertyChainAxiom) 48 | (defglobal ?*owl:AllDisjointClasses* = owl:AllDisjointClasses) 49 | (defglobal ?*owl:members* = owl:members) 50 | 51 | 52 | 53 | ;RDF/RDFS 54 | (defglobal ?*rdfs:Resource* = rdfs:Resource) 55 | (defglobal ?*rdfs:Literal* = rdfs:Literal) 56 | (defglobal ?*rdf:XMLLiteral* = rdf:XMLLiteral) 57 | (defglobal ?*rdfs:Class* = rdfs:Class) 58 | (defglobal ?*rdf:Property* = rdf:Property) 59 | (defglobal ?*rdfs:Datatype* = rdfs:Datatype) 60 | (defglobal ?*rdf:Statement* = rdf:Statement) 61 | (defglobal ?*rdf:Bag* = rdf:Bag) 62 | (defglobal ?*rdf:Seq* = rdf:Seq) 63 | (defglobal ?*rdf:Alt* = rdf:Alt) 64 | (defglobal ?*rdfs:Container* = rdfs:Container) 65 | (defglobal ?*rdfs:ContainerMembershipProperty* = rdfs:ContainerMembershipProperty) 66 | (defglobal ?*rdf:List* = rdf:List) 67 | (defglobal ?*rdf:type* = rdf:type) 68 | (defglobal ?*rdfs:subClassOf* = rdfs:subClassOf) 69 | (defglobal ?*rdfs:subPropertyOf* = rdfs:subPropertyOf) 70 | (defglobal ?*rdfs:domain* = rdfs:domain) 71 | (defglobal ?*rdfs:range* = rdfs:range) 72 | (defglobal ?*rdfs:label* = rdfs:label) 73 | (defglobal ?*rdfs:comment* = rdfs:comment) 74 | (defglobal ?*rdfs:member* = rdfs:member) 75 | (defglobal ?*rdf:first* = rdf:first) 76 | (defglobal ?*rdf:rest* = rdf:rest) 77 | (defglobal ?*rdf:nil* = rdf:nil) 78 | (defglobal ?*rdfs:seeAlso* = rdfs:seeAlso) 79 | (defglobal ?*rdfs:isDefinedBy* = rdfs:isDefinedBy) 80 | (defglobal ?*rdf:value* = rdf:value) 81 | (defglobal ?*rdf:subject* = rdf:subject) 82 | (defglobal ?*rdf:predicate* = rdf:predicate) 83 | (defglobal ?*rdf:object* = rdf:object) 84 | 85 | ;Some xsd types 86 | (defglobal ?*xsd:int* = xsd:int) 87 | (defglobal ?*xsd:float* = xsd:float) 88 | (defglobal ?*xsd:short* = xsd:short) 89 | (defglobal ?*xsd:byte* = xsd:byte) 90 | (defglobal ?*xsd:boolean* = xsd:boolean) 91 | (defglobal ?*xsd:string* = xsd:string) 92 | (defglobal ?*xsd:nonNegativeInteger* = xsd:nonNegativeInteger) 93 | (defglobal ?*xsd:Integer* = xsd:Integer) 94 | (defglobal ?*xsd:integer* = xsd:integer) 95 | (defglobal ?*xsd:anyURI* = xsd:anyURI) 96 | (defglobal ?*xsd:positiveInteger* = xsd:positiveInteger) 97 | (defglobal ?*xsd:nonPositiveInteger* = xsd:nonPositiveInteger) 98 | (defglobal ?*xsd:dateTime* = xsd:dateTime) 99 | 100 | -------------------------------------------------------------------------------- /csd.auth.gr/o-device/vocabulary.clp: -------------------------------------------------------------------------------- 1 | ;OWL 2 | (defglobal ?*owl:AllDifferent* = http://www.w3.org/2002/07/owl#AllDifferent) 3 | (defglobal ?*owl:allValuesFrom* = http://www.w3.org/2002/07/owl#allValuesFrom) 4 | (defglobal ?*owl:AnnotationProperty* = http://www.w3.org/2002/07/owl#AnnotationProperty) 5 | (defglobal ?*owl:backwardCompatibleWith* = http://www.w3.org/2002/07/owl#backwardCompatibleWith) 6 | (defglobal ?*owl:cardinality* = http://www.w3.org/2002/07/owl#cardinality) 7 | (defglobal ?*owl:Class* = http://www.w3.org/2002/07/owl#Class) 8 | (defglobal ?*owl:complementOf* = http://www.w3.org/2002/07/owl#complementOf) 9 | (defglobal ?*owl:DataRange* = http://www.w3.org/2002/07/owl#DataRange) 10 | (defglobal ?*owl:DatatypeProperty* = http://www.w3.org/2002/07/owl#DatatypeProperty) 11 | (defglobal ?*owl:DeprecatedClass* = http://www.w3.org/2002/07/owl#DeprecatedClass) 12 | (defglobal ?*owl:DeprecatedProperty* = http://www.w3.org/2002/07/owl#DeprecatedProperty) 13 | (defglobal ?*owl:differentFrom* = http://www.w3.org/2002/07/owl#differentFrom) 14 | (defglobal ?*owl:disjointWith* = http://www.w3.org/2002/07/owl#disjointWith) 15 | (defglobal ?*owl:distinctMembers* = http://www.w3.org/2002/07/owl#distinctMembers) 16 | (defglobal ?*owl:equivalentClass* = http://www.w3.org/2002/07/owl#equivalentClass) 17 | (defglobal ?*owl:equivalentProperty* = http://www.w3.org/2002/07/owl#equivalentProperty) 18 | (defglobal ?*owl:FunctionalProperty* = http://www.w3.org/2002/07/owl#FunctionalProperty) 19 | (defglobal ?*owl:hasValue* = http://www.w3.org/2002/07/owl#hasValue) 20 | (defglobal ?*owl:imports* = http://www.w3.org/2002/07/owl#imports) 21 | (defglobal ?*owl:incompatibleWith* = http://www.w3.org/2002/07/owl#incompatibleWith) 22 | (defglobal ?*owl:intersectionOf* = http://www.w3.org/2002/07/owl#intersectionOf) 23 | (defglobal ?*owl:InverseFunctionalProperty* = http://www.w3.org/2002/07/owl#InverseFunctionalProperty) 24 | (defglobal ?*owl:inverseOf* = http://www.w3.org/2002/07/owl#inverseOf) 25 | (defglobal ?*owl:maxCardinality* = http://www.w3.org/2002/07/owl#maxCardinality) 26 | (defglobal ?*owl:minCardinality* = http://www.w3.org/2002/07/owl#minCardinality) 27 | (defglobal ?*owl:Nothing* = http://www.w3.org/2002/07/owl#Nothing) 28 | (defglobal ?*owl:ObjectProperty* = http://www.w3.org/2002/07/owl#ObjectProperty) 29 | (defglobal ?*owl:oneOf* = http://www.w3.org/2002/07/owl#oneOf) 30 | (defglobal ?*owl:onProperty* = http://www.w3.org/2002/07/owl#onProperty) 31 | (defglobal ?*owl:Ontology* = http://www.w3.org/2002/07/owl#Ontology) 32 | (defglobal ?*owl:OntologyProperty* = http://www.w3.org/2002/07/owl#OntologyProperty) 33 | (defglobal ?*owl:priorVersion* = http://www.w3.org/2002/07/owl#priorVersion) 34 | (defglobal ?*owl:Restriction* = http://www.w3.org/2002/07/owl#Restriction) 35 | (defglobal ?*owl:sameAs* = http://www.w3.org/2002/07/owl#sameAs) 36 | (defglobal ?*owl:someValuesFrom* = http://www.w3.org/2002/07/owl#someValuesFrom) 37 | (defglobal ?*owl:SymmetricProperty* = http://www.w3.org/2002/07/owl#SymmetricProperty) 38 | (defglobal ?*owl:Thing* = http://www.w3.org/2002/07/owl#Thing) 39 | (defglobal ?*owl:TransitiveProperty* = http://www.w3.org/2002/07/owl#TransitiveProperty) 40 | (defglobal ?*owl:unionOf* = http://www.w3.org/2002/07/owl#unionOf) 41 | (defglobal ?*owl:versionInfo* = http://www.w3.org/2002/07/owl#versionInfo) 42 | (defglobal ?*owl:hasKey* = http://www.w3.org/2002/07/owl#hasKey) 43 | (defglobal ?*owl:onClass* = http://www.w3.org/2002/07/owl#onClass) 44 | (defglobal ?*owl:minQualifiedCardinality* = http://www.w3.org/2002/07/owl#minQualifiedCardinality) 45 | (defglobal ?*owl:maxQualifiedCardinality* = http://www.w3.org/2002/07/owl#maxQualifiedCardinality) 46 | (defglobal ?*owl:qualifiedCardinality* = http://www.w3.org/2002/07/owl#qualifiedCardinality) 47 | (defglobal ?*owl:propertyChainAxiom* = http://www.w3.org/2002/07/owl#propertyChainAxiom) 48 | (defglobal ?*owl:AllDisjointClasses* = http://www.w3.org/2002/07/owl#AllDisjointClasses) 49 | (defglobal ?*owl:members* = http://www.w3.org/2002/07/owl#members) 50 | 51 | 52 | ;RDF/RDFS 53 | (defglobal ?*rdfs:Resource* = http://www.w3.org/2000/01/rdf-schema#Resource) 54 | (defglobal ?*rdfs:Literal* = http://www.w3.org/2000/01/rdf-schema#Literal) 55 | (defglobal ?*rdf:XMLLiteral* = http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral) 56 | (defglobal ?*rdfs:Class* = http://www.w3.org/2000/01/rdf-schema#Class) 57 | (defglobal ?*rdf:Property* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Property) 58 | (defglobal ?*rdfs:Datatype* = http://www.w3.org/2000/01/rdf-schema#Datatype) 59 | (defglobal ?*rdf:Statement* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement) 60 | (defglobal ?*rdf:Bag* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Bag) 61 | (defglobal ?*rdf:Seq* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Seq) 62 | (defglobal ?*rdf:Alt* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Alt) 63 | (defglobal ?*rdfs:Container* = http://www.w3.org/2000/01/rdf-schema#Container) 64 | (defglobal ?*rdfs:ContainerMembershipProperty* = http://www.w3.org/2000/01/rdf-schema#ContainerMembershipProperty) 65 | (defglobal ?*rdf:List* = http://www.w3.org/1999/02/22-rdf-syntax-ns#List) 66 | (defglobal ?*rdf:type* = http://www.w3.org/1999/02/22-rdf-syntax-ns#type) 67 | (defglobal ?*rdfs:subClassOf* = http://www.w3.org/2000/01/rdf-schema#subClassOf) 68 | (defglobal ?*rdfs:subPropertyOf* = http://www.w3.org/2000/01/rdf-schema#subPropertyOf) 69 | (defglobal ?*rdfs:domain* = http://www.w3.org/2000/01/rdf-schema#domain) 70 | (defglobal ?*rdfs:range* = http://www.w3.org/2000/01/rdf-schema#range) 71 | (defglobal ?*rdfs:label* = http://www.w3.org/2000/01/rdf-schema#label) 72 | (defglobal ?*rdfs:comment* = http://www.w3.org/2000/01/rdf-schema#comment) 73 | (defglobal ?*rdfs:member* = http://www.w3.org/2000/01/rdf-schema#member) 74 | (defglobal ?*rdf:first* = http://www.w3.org/1999/02/22-rdf-syntax-ns#first) 75 | (defglobal ?*rdf:rest* = http://www.w3.org/1999/02/22-rdf-syntax-ns#rest) 76 | (defglobal ?*rdf:nil* = http://www.w3.org/1999/02/22-rdf-syntax-ns#nil) 77 | (defglobal ?*rdfs:seeAlso* = http://www.w3.org/2000/01/rdf-schema#seeAlso) 78 | (defglobal ?*rdfs:isDefinedBy* = http://www.w3.org/2000/01/rdf-schema#isDefinedBy) 79 | (defglobal ?*rdf:value* = http://www.w3.org/1999/02/22-rdf-syntax-ns#value) 80 | (defglobal ?*rdf:subject* = http://www.w3.org/1999/02/22-rdf-syntax-ns#subject) 81 | (defglobal ?*rdf:predicate* = http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate) 82 | (defglobal ?*rdf:object* = http://www.w3.org/1999/02/22-rdf-syntax-ns#object) 83 | 84 | ;Some xsd types 85 | (defglobal ?*xsd:int* = http://www.w3.org/2001/XMLSchema#int) 86 | (defglobal ?*xsd:float* = http://www.w3.org/2001/XMLSchema#float) 87 | (defglobal ?*xsd:short* = http://www.w3.org/2001/XMLSchema#short) 88 | (defglobal ?*xsd:byte* = http://www.w3.org/2001/XMLSchema#byte) 89 | (defglobal ?*xsd:boolean* = http://www.w3.org/2001/XMLSchema#boolean) 90 | (defglobal ?*xsd:string* = http://www.w3.org/2001/XMLSchema#string) 91 | (defglobal ?*xsd:nonNegativeInteger* = http://www.w3.org/2001/XMLSchema#nonNegativeInteger) 92 | (defglobal ?*xsd:Integer* = http://www.w3.org/2001/XMLSchema#Integer) 93 | (defglobal ?*xsd:integer* = http://www.w3.org/2001/XMLSchema#integer) 94 | (defglobal ?*xsd:anyURI* = http://www.w3.org/2001/XMLSchema#anyURI) 95 | (defglobal ?*xsd:positiveInteger* = http://www.w3.org/2001/XMLSchema#positiveInteger) 96 | (defglobal ?*xsd:nonPositiveInteger* = http://www.w3.org/2001/XMLSchema#nonPositiveInteger) 97 | (defglobal ?*xsd:dateTime* = http://www.w3.org/2001/XMLSchema#dateTime) 98 | -------------------------------------------------------------------------------- /f.clp: -------------------------------------------------------------------------------- 1 | ;load this file before my https://github.com/MBcode/CLIPSmsc/blob/master/utils.clp mike.bobak@gmail.com 2 | ;e.g. alias fclu 'rlwrap fz_clips -l ~/bin/fzutils.clp' where: cat f.clp utils.clp >fzutils.clp 3 | ;https://github.com/rorchard/FuzzyCLIPS seems to have been forked from an older clips version 4 | (deffunction string-to-field (?in) (eval ?in)) ;added as fz_clips doesn't have it 5 | ;docs on it's use at: http://mma.perso.eisti.fr/HTML-SE/Programme/fzdocs.pdf 6 | ;also http://thor.info.uaic.ro/~dcristea/cursuri/SE/fzdocs.pdf 7 | ;http://alumni.cs.ucr.edu/~vladimir/cs171/quickfuzzy.pdf 8 | ;http://math.haifa.ac.il/robotics/Presentations/pdf/Ch7_FuzzyLogic.PDF 9 | ;http://www.graco.unb.br/alvares/DOUTORADO/omega.enm.unb.br/pub/doutorado/disco2/ai.iit.nrc.ca/IR_public/fuzzy/fuzzyShower.html 10 | ;http://www.graco.unb.br/alvares/DOUTORADO/omega.enm.unb.br/pub/doutorado/disco2/ai.iit.nrc.ca/IR_public/fuzzy/fuzzyShowerJess.html 11 | ;http://www.graco.unb.br/alvares/DOUTORADO/omega.enm.unb.br/pub/doutorado/disco2/ai.iit.nrc.ca/IR_public/fuzzy/FuzzyTruck.html 12 | ;http://www.cs.dartmouth.edu/~spl/publications/fuzzy%20talk/FuzzyPendulum.html 13 | -------------------------------------------------------------------------------- /pins2km.sed: -------------------------------------------------------------------------------- 1 | / of /s// of / 2 | /^ (/s//\t(/ 3 | /\t(/s/)$/))/ 4 | /\t(/s/ / (/ 5 | /^(\[/s/(\[/(*/ 6 | /\] of/s/$/))/ 7 | /\] of /s// has (instance-of (/ 8 | / (\[/s/\]))/))/ 9 | / (\[/s// (*/ 10 | -------------------------------------------------------------------------------- /pontdi2km.sed: -------------------------------------------------------------------------------- 1 | / \"/s/$/))/ 2 | / \"/s// (description (\"/ 3 | /(defclass /s//(defclass_/ 4 | /(defclass_/s/$/ / 5 | /(defclass_/s/ / has / 6 | /(defclass_/s//(/ 7 | /(is-a /s/$/))/ 8 | /(is-a /s// (superclasses (/ 9 | -------------------------------------------------------------------------------- /u.clp: -------------------------------------------------------------------------------- 1 | ;This was at the end of my utils.clp at one point, from this work: http://lpis.csd.auth.gr/systems/r-device/manual.pdf 2 | ;-----------------------------------------EOF 3 | (defglobal ?*R-DEVICE_PATH* = "\/Users\/bobak\/Documents\/downloads\/ai\/prot\/rdf\/R-DEVICE\/") 4 | (deffunction loadr-device () 5 | "r-device rdf code loading" 6 | (load* (str-cat ?*R-DEVICE_PATH* "rdf.clp")) 7 | (load* (str-cat ?*R-DEVICE_PATH* "classes.clp")) 8 | (load* (str-cat ?*R-DEVICE_PATH* "auxiliary-functions.clp")) 9 | (load* (str-cat ?*R-DEVICE_PATH* "class-functions.clp")) 10 | (load* (str-cat ?*R-DEVICE_PATH* "aggregates.clp")) 11 | (load* (str-cat ?*R-DEVICE_PATH* "types.clp")) 12 | (load* (str-cat ?*R-DEVICE_PATH* "oo-querying.clp")) 13 | (load* (str-cat ?*R-DEVICE_PATH* "second-order.clp")) 14 | (load* (str-cat ?*R-DEVICE_PATH* "stratification.clp")) 15 | (load* (str-cat ?*R-DEVICE_PATH* "translation.clp")) 16 | (load* (str-cat ?*R-DEVICE_PATH* "translation-rules.clp")) 17 | (load* (str-cat ?*R-DEVICE_PATH* "main.clp")) 18 | (load* (str-cat ?*R-DEVICE_PATH* "rdf-auxiliary.clp")) 19 | (load* (str-cat ?*R-DEVICE_PATH* "load-rdf.clp")) 20 | (load* (str-cat ?*R-DEVICE_PATH* "import.clp")) 21 | (load* (str-cat ?*R-DEVICE_PATH* "export.clp")) 22 | (load* (str-cat ?*R-DEVICE_PATH* "triple-transformation.clp")) 23 | (reset) 24 | ) 25 | ;--------------------------------------------------------- 26 | ;This is still in utils.clp but not every machine has the other code. 27 | ;Even though Protege can work between formats, might still use this. 28 | ; 1plc would be to save gen ins ;as well as taking triples2frames 29 | --------------------------------------------------------------------------------