编程手记之ANSI C篇-(六)LISP宏解析 LISP以其优美简洁的语法备受编程爱好者推崇,至今在许多基于脚本的解释环境中,LIisp语言的影子仍随处可见,在此仅讨论一个与LISP类似的宏公式解析,姑且称其为LISP宏吧,该LISP宏主要用于表单项目或网格列的自动计算。 1、LISP宏文法 /************************************************************ LISP宏由一个函数体构成 eg: func1(param1,func2(parm,...),param2,...) 函数体由函数名和参数列表组成 lispnode --> funcname + "(" + {funcparam + ","} + ")" 参数可以为常数、变量或子函数体 funcparam --> lispnode | variable | consttoken 函数名由字母开头的字符串组成 funcname --> {a | b... | 1 | 2 ...} 变量由字母开头的字符串变量组成 variable --> {a | b | ... | 1 | 2 ...} 常数可以为数字常数或字符串常数 consttoken -> [stringtoken | numerictoken] 字符串常数由前后单括号和字符串组成 stringtoken --> "'" + {a | b... | 1 | 2 ...} + "'" 数字常数由数字和小数点组成 numerictoken --> {1 | 2 | ...} *************************************************************/
2、LISP宏解析的终结符集合 /*define some terminated char*/ #ifndef NILL #define NILL _T('\x02') #endif /*define blank char for skiping*/ static TCHAR LispBlankChar[] = {_T(' '),_T('\t'),'\r',_T('\n'),NILL}; /*define function name terminated char*/ static TCHAR LispFuncNameTerm[] = {_T('('),_T('\0'),NILL}; /*define param terminated char*/ static TCHAR LispParamTerm[] = {_T(','),_T(')'),_T('\0'),NILL};
3、LISP宏数据结构定义 /*define lisp node struct*/ typedef struct _LispNode{ LINK lk; /*lisp node self link component*/ LINK lkParams; /*lisp node param root link component*/ int type; /*lisp node tag eg: lnNull for nothing, lnString,lnNumeric for const value, lnVar for variable item, lnNode for sub lisp node*/ TCHAR* data; /*lisp node data, case lnString data is const string token,case lnNumeric data is const numeric token,case lnItem data is variable name, case lnNode data is function name*/ }LispNode;
/*定义用于取得变量值的回调函数*/ typedef TCHAR* (*LispVarFetch)(const TCHAR* var,void* parm); /*定义宏计算函数的统一样式*/ typedef TCHAR* (*LispFuncPtr)(TCHAR* pa[],int size);
/*define lisp data struct*/ typedef struct _LispData{ LINK lk; /*lisp data self link component*/ LINKPTR ht; /*lisp function set, storing in hash table*/ LINKPTR ln; /*lisp root node*/ LispVarFetch vf; /*fetch outside variable value*/ void* vfparma; /*variable fetch func callback param*/ }LispData;
/*define lisp node type*/ typedef enum{lnNull = 0,lnNode = 1,lnVar = 2,lnString = 3,lnNumeric = 4}NodeType;
/*定义从通用连接件中恢复数据节点*/ #define LispNodeFromLink(p) ((LispNode*)((unsigned int)p - (unsigned int)&(((LispNode*)0)->lk))) #define LispDataFromLink(p) ((LispData*)((unsigned int)p - (unsigned int)&(((LispData*)0)->lk)))
/*定义常用的LISP宏计算函数*/ #define PLUS _T("PLUS") /*pluse(+) element in set eg: PLUS(1,val1,0.22,...)*/ #define SUB _T("SUB") /*sub(-) sub element in set eg: SUB(10,2.9,val1,...)*/ #define DIV _T("DIV") /*div(/) div element in set eg: DIV(100,val1,20,3.9,...)*/ #define MUL _T("MUL") /*mul(*) mul element in set eg: MUL(3,9.23,val1,...)*/ #define AVG _T("AVG") /*avg(sum/count) avg element in set eg: AVG(100,30,val1,30.40,...)*/ #define MIN _T("MIN") /*find min numeric element in set eg: MIN(val1,30,100,43.98,...)*/ #define MAX _T("MAX") /*find max numeric element in set eg: MAX(val1,30,100,43.98,...)*/ #define ROUND _T("ROUND") /*round one numeric element by precision eg: ROUND(val,2) or ROUND(100.3456,2)*/ #define ABS _T("ABS") /*remove one numeric negative sign eg: ABS(-100) or ABS(val)*/ #define LEN _T("LEN") /*get one string element length eg: LEN("hello") or LEN(val)*/ #define MID _T("MID") /*Returns a specified number of characters from a string element eg: MID("hello",1,3) */ #define CAT _T("CAT") /*cat string element in set eg: CAT("ab","cd",val,...)*/ #define FMT _T("FMT") /*format numeric element to string by limited length and precision eg: FMT(100.2456,5,2)*/ #define EMPTY _T("EMPTY") /*test string element is empty eg: EMPTY("")*/ #define IF _T("IF") /*if function to test two element which will be return eg: IF(val,"one","two")*/ #define LTR _T("LTR") /*trim left string element eg: LTR(val)*/ #define RTR _T("RTR") /*trim right string element eg: RTR(val)*/ #define CTR _T("CTR") /*trim left and right string element eg: CTR*/ #define SCMP _T("SCMP") /*compare two string element eg: SCMP("str1","str2")*/ #define NCMP _T("NCMP") /*compare two numeric element eg: NCMP(100,30.20)*/ #define ZERO _T("ZERO") /*test element is zero eg: ZERO(val)*/ #define LEZE _T("LEZE") /*test element is less then and equal zero eg: LEZE(val)*/ #define GRZE _T("GRZE") /*test element is grate then and equal zero eg: GRZE(val)*/
4、LISP过程实现 /*LISP宏常用函数的实现*/ /************************************************************ lisp common function implement begin *************************************************************/ TCHAR* lisp_plus(TCHAR** pa,int size) { float f = 0; int i; TCHAR* token;
if(size < 2) return NULL;
f = _ttof(pa[0]); for(i = 1;i<size;i++) f += _ttof(pa[i]);
token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%f"),f); return token; }
TCHAR* lisp_sub(TCHAR** pa,int size) { float f ; int i; TCHAR* token; if(size < 2) return NULL;
f = _ttof(pa[0]); for(i = 1;i<size;i++) f -= _ttof(pa[i]);
token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%f"),f); return token; }
TCHAR* lisp_div(TCHAR** pa,int size) { float f ; int i; TCHAR* token; if(size < 2) return NULL;
f = _ttof(pa[0]); for(i = 1;i<size;i++) f /= _ttof(pa[i]);
token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%f"),f); return token; }
TCHAR* lisp_mul(TCHAR** pa,int size) { float f ; int i; TCHAR* token; if(size < 2) return NULL;
f = _ttof(pa[0]); for(i = 1;i<size;i++) f *= _ttof(pa[i]);
token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%f"),f); return token; }
TCHAR* lisp_avg(TCHAR** pa,int size) { float f ; int i; TCHAR* token; if(size < 1) return NULL;
f = _ttof(pa[0]); for(i = 1;i<size;i++) f += _ttof(pa[i]); f /= size;
token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%f"),f); return token; }
TCHAR* lisp_min(TCHAR** pa,int size) { float min,f ; int i; TCHAR* token; if(size < 1) return NULL;
min = _ttof(pa[0]); for(i = 1;i<size;i++) { f = _ttof(pa[i]); if(f < min) min = f; }
token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%f"),min); return token; }
TCHAR* lisp_max(TCHAR** pa,int size) { float max,f ; int i; TCHAR* token; if(size < 1) return NULL;
max = _ttof(pa[0]); for(i = 1;i<size;i++) { f = _ttof(pa[i]); if(f > max) max = f; }
token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%f"),max); return token; }
TCHAR* lisp_round(TCHAR** pa,int size) { TCHAR fmt[10]; TCHAR* token;
if(size != 2) return NULL;
_stprintf(fmt,_T("%c.%df"),_T('%'),_ttoi(pa[1])); token = XdlAlloc(NUM_LEN + 1); _stprintf(token,fmt,_ttof(pa[0])); return token; }
TCHAR* lisp_abs(TCHAR** pa,int size) { TCHAR* token; float f;
if(size != 1) return NULL;
f = _ttof(pa[0]); if(f < 0) f = 0 - f; token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%f"),f); return token; }
TCHAR* lisp_fmt(TCHAR** pa,int size) { TCHAR fmt[10]; TCHAR* token; int len,i;
if(size != 3) return NULL;
_stprintf(fmt,_T("%c%d.%df"),_T('%'),_ttoi(pa[1]),_ttoi(pa[2])); token = XdlAlloc(NUM_LEN + 1); _stprintf(token,fmt,_ttof(pa[0])); len = _tcslen(token); for(i = 0;i<len;i ++) { if(token[i] == _T(' ')) token[i] = _T('0'); else break; } return token; }
TCHAR* lisp_len(TCHAR** pa,int size) { TCHAR* token;
if(size != 1) return NULL;
token = XdlAlloc(NUM_LEN + 1); _stprintf(token,_T("%d"),_tcslen(pa[0])); return token; }
TCHAR* lisp_mid(TCHAR** pa,int size) { TCHAR* token; int len,n1,n2;
if(size != 3) return NULL;
len = _tcslen(pa[0]); n1 = _ttoi(pa[1]); n2 = _ttoi(pa[2]); if(n1 >= len || n1 < 0 || n2 < 0) { return NULL; }
if(n2 > len - n1) n2 = len - n1; token = XdlAlloc(n2 + 1); _tcsncpy(token,pa[0] + n1,n2); return token; }
TCHAR* lisp_cat(TCHAR** pa,int size) { TCHAR* token; int len,i;
if(size < 1) return NULL;
len = 0; for(i=0;i<size;i++) len += _tcslen(pa[i]); token = XdlAlloc(len + 1); for(i=0;i<size;i++) _tcscat(token,pa[i]); return token; }
TCHAR* lisp_empty(TCHAR** pa,int size) { TCHAR* token; int len;
if(size < 1) return NULL;
len = _tcslen(pa[0]); token = XdlAlloc(2); if(len) token[0] = _T('0'); else token[0] = _T('1'); return token; }
TCHAR* lisp_scmp(TCHAR** pa,int size) { TCHAR* token; int rt; if(size != 2) return NULL;
rt = _tcscmp(pa[0],pa[1]); token = XdlAlloc(3); _stprintf(token,_T("%d"),rt); return token; }
TCHAR* lisp_if(TCHAR** pa,int size) { TCHAR* token; int len;
if(size != 3) return NULL; len = _ttoi(pa[0]); if(len) { len = _tcslen(pa[1]); token = XdlAlloc(len + 1); _tcscpy(token,pa[1]); }else { len = _tcslen(pa[2]); token = XdlAlloc(len + 1); _tcscpy(token,pa[2]); } return token; }
TCHAR* lisp_ltr(TCHAR** pa,int size) { TCHAR* token; int len,n1; if(size != 1) return NULL; len = _tcslen(pa[0]); for(n1=0;n1<len;n1++) { if((pa[0])[n1] != _T(' ')) break; } len -= n1; token = XdlAlloc(len + 1); _tcscpy(token,pa[0] + n1); return token; }
TCHAR* lisp_rtr(TCHAR** pa,int size) { TCHAR* token; int len,n1;
if(size != 1) return NULL; len = _tcslen(pa[0]); for(n1=len-1;n1>=0;n1--) { if((pa[0])[n1] != _T(' ')) break; } len = n1 + 1; token = XdlAlloc(len + 1); _tcsncpy(token,pa[0],len); return token; }
TCHAR* lisp_ctr(TCHAR** pa,int size) { TCHAR* token; int len,n1,n2;
if(size != 1) return NULL; len = _tcslen(pa[0]); for(n1=0;n1<len;n1++) { if((pa[0])[n1] != _T(' ')) break; } for(n2=len-1;n2>n1;n2--) { if((pa[0])[n1] != _T(' ')) break; } len = n2 - n1 + 1; token = XdlAlloc(len + 1); _tcsncpy(token,pa[0] + n1,len); return token; }
TCHAR* lisp_ncmp(TCHAR** pa,int size) { TCHAR* token; float f,f1;
if(size != 2) return NULL; token = XdlAlloc(3); f = _ttof(pa[0]); f1 = _ttof(pa[1]); if(f == f1) _tcscpy(token,_T("0")); else if(f > f1) _tcscpy(token,_T("1")); else _tcscpy(token,_T("-1")); return token; }
TCHAR* lisp_zero(TCHAR** pa,int size) { TCHAR* token;
if(size != 1) return NULL; token = XdlAlloc(2); if(_ttof(pa[0]) == 0) token[0] = _T('1'); else token[0] = _T('0'); return token; }
TCHAR* lisp_leze(TCHAR** pa,int size) { TCHAR* token;
if(size != 1) return NULL; token = XdlAlloc(2); if(_ttof(pa[0]) < 0) token[0] = _T('1'); else token[0] = _T('0'); return token; }
TCHAR* lisp_grze(TCHAR** pa,int size) { TCHAR* token;
if(size != 1) return NULL; token = XdlAlloc(2); if(_ttof(pa[0]) > 0) token[0] = _T('1'); else token[0] = _T('0'); return token; }
/************************************************************ lisp common function implement end *************************************************************/
/*定义LISP宏解析的函数实现*/ /************************************************************ lisp parse function implement begin *************************************************************/ /*test ch is blank char */ int _IsLispBlankChar(TCHAR ch) { int i = 0; while(LispBlankChar[i] != NILL) { if(ch == LispBlankChar[i]) return 1; i++; } return 0; }
/*test ch is function name terminated char*/ int _IsLispFuncNameTerm(TCHAR ch) { int i = 0; while(LispFuncNameTerm[i] != NILL) { if(ch == LispFuncNameTerm[i]) return 1; i++; } return 0; }
/*test ch is param terminated char*/ int _IsLispParamTerm(TCHAR ch) { int i = 0; while(LispParamTerm[i] != NILL) { if(ch == LispParamTerm[i]) return 1; i++; } return 0; }
/*split function name*/ void _SplitLispFuncName(TCHAR* str,int* plen) { TCHAR* token = str; *plen = 0;
while(!_IsLispFuncNameTerm(*token)) { token ++; *plen = *plen + 1; }
if(*token != _T('(')) /*no functoin name finded*/ *plen = 0; }
/*skip blank char*/ TCHAR* _SkipLispBlank(TCHAR* str) { TCHAR* token = str;
while(_IsLispBlankChar(*token)) token ++; if(*token == _T('\0')) return NULL; else return token; }
/*skip lisp one param*/ TCHAR* _SkipLispParam(TCHAR* str) { TCHAR* token = str; int quate = 0;
while(!_IsLispParamTerm(*token) || quate) { if(*token == _T('(')) quate ++; /*find one sub quate*/ else if(*token == _T(')')) quate --; /*skip one sub quate*/
token ++; if(*token == _T('\0')) break; }
if(quate || *token == _T('\0')) /*lost some quate*/ return NULL; else return token; }
/*test param type*/ int _TestLispParamType(TCHAR* str,int len) { TCHAR* token = str;
token = _SkipLispBlank(token); if(token == NULL) /*empty token*/ return lnNull; else if(token == str + len) return lnNull; /*empty token*/
if(*token == _T('\'')) /*param is const string token*/ return lnString;
if((*token >= _T('0') && *token <= _T('9')) || *token == _T('.')) /*param is const numeric token*/ return lnNumeric;
len -= (token - str); while(len--) { if(*token == _T('(')) /*param is sub lisp node*/ return lnNode; token ++; }
return lnVar; /*param is variable token*/ }
/*trim left and right blank*/ void _TrimLispToken(TCHAR* str,int len,TCHAR** strat,int* plen) { TCHAR* token; assert(str && len > 0);
token = str; while(_IsLispBlankChar(*token) && token != str + len) /*skip left blank*/ token ++; *strat = token;
token = str + len - 1; while(_IsLispBlankChar(*token) && token != str) /*count not blank char*/ token --;
*plen = (token - *strat) + 1; }
/*alloc new lisp node and initialize */ LispNode* AllocLispNode() { LispNode* pln;
pln = (LispNode*)calloc(1,sizeof(LispNode)); pln->lk.tag = lkLispNode; InitRootLink(&pln->lkParams); pln->type = lnNull; pln->data = NULL;
return pln; }
/*free lisp node and his params*/ void FreeLispNode(LINKPTR nlk) { LispNode* pln; LispNode* node; LINKPTR parm,next;
assert(nlk && nlk->tag == lkLispNode); pln = LispNodeFromLink(nlk);
parm = GetFirstLink(&pln->lkParams); while(parm) { next = GetNextLink(parm); assert(parm == DeleteLinkAt(&pln->lkParams,parm)); node = LispNodeFromLink(parm); switch(node->type) { case lnNull: free(node); break; case lnNumeric: case lnString: case lnVar: if(node->data) free(node->data); free(node); break; case lnNode: FreeLispNode(parm); break; }
parm = next; }
if(pln->data) /*free function name*/ free(pln->data); free(pln); }
/*parse lisp node*/ LINKPTR LispNodeParse(TCHAR* str,int len) { LispNode* pln; LispNode* parm; TCHAR* token = str; TCHAR* subtoken; TCHAR* nexttoken; int type,tokenlen,sublen; LINKPTR subnode;
assert(str && len >= 0);
/*parse function name*/ _SplitLispFuncName(token,&tokenlen); if(tokenlen == 0) return NULL;
_TrimLispToken(token,tokenlen,&subtoken,&sublen); /*get function name*/ /*new lisp node*/ pln = AllocLispNode(); pln->type = lnNode; pln->data = (TCHAR*)calloc(sublen + 1,sizeof(TCHAR)); _tcsncpy(pln->data,subtoken,sublen);
/*continue to parse function params*/ token = token + tokenlen; token ++; /*skip '('*/
while(*token != _T('\0')) { nexttoken = _SkipLispParam(token); if(nexttoken == NULL) /*invalid lisp node*/ { free(pln->data); free(pln); return NULL; }
tokenlen = nexttoken - token; type = _TestLispParamType(token,tokenlen); switch(type) { case lnNull: parm = AllocLispNode(); parm->type = lnNull; parm->data = NULL; InsertLinkAt(&pln->lkParams,LINK_LAST,&parm->lk); break; case lnString: parm = AllocLispNode(); parm->type = lnString; _TrimLispToken(token,tokenlen,&subtoken,&sublen); subtoken ++; /*not include first and last '\''*/ sublen -= 2; parm->data = (TCHAR*)calloc(sublen + 1,sizeof(TCHAR)); _tcsncpy(parm->data,subtoken,sublen); InsertLinkAt(&pln->lkParams,LINK_LAST,&parm->lk); break; case lnNumeric: parm = AllocLispNode(); parm->type = lnNumeric; _TrimLispToken(token,tokenlen,&subtoken,&sublen); parm->data = (TCHAR*)calloc(sublen + 1,sizeof(TCHAR)); _tcsncpy(parm->data,subtoken,sublen); InsertLinkAt(&pln->lkParams,LINK_LAST,&parm->lk); break; case lnVar: parm = AllocLispNode(); parm->type = lnVar; _TrimLispToken(token,tokenlen,&subtoken,&sublen); parm->data = (TCHAR*)calloc(sublen + 1,sizeof(TCHAR)); _tcsncpy(parm->data,subtoken,sublen); InsertLinkAt(&pln->lkParams,LINK_LAST,&parm->lk); break; case lnNode: _TrimLispToken(token,tokenlen,&subtoken,&sublen); subnode = LispNodeParse(subtoken,sublen); if(subnode) InsertLinkAt(&pln->lkParams,LINK_LAST,subnode); break; }
if(*nexttoken == _T(')')) /*last param parsed*/ break;
token = nexttoken + 1; /*skip ',' continue to parse next param*/ }
return &pln->lk; }
/*format lisp node to string token*/ int LispNodeFormat(LINKPTR nlk,TCHAR* buf,int max) { LispNode* pln; int total,len; LINKPTR parm;
assert(nlk && nlk->tag == lkLispNode); pln = LispNodeFromLink(nlk); total = 0;
len = _tcslen(pln->data) + 1; /*function name with '(' length*/ if(len > max) return -1; if(buf) _stprintf(buf + total,_T("%s("),pln->data); total += len;
/*format function params*/ parm = GetFirstLink(&pln->lkParams); while(parm) { pln = LispNodeFromLink(parm);
switch(pln->type) { case lnNull: len = 1; /*null token with ','*/ if(total + len > max) return -1; if(buf) _stprintf(buf + total,_T("%s"),_T(",")); total += len; break; case lnString: len = _tcslen(pln->data) + 2 + 1; /*string token with two '\'' and one ','*/ if(total + len > max) return -1; if(buf) _stprintf(buf + total,_T("'%s',"),pln->data); total += len; break; case lnNumeric: len = _tcslen(pln->data) + 1; /*numeric token with ','*/ if(total + len > max) return -1; if(buf) _stprintf(buf + total,_T("%s,"),pln->data); total += len; case lnVar: len = _tcslen(pln->data) + 1; /*variable token with ','*/ if(total + len > max) return -1; if(buf) _stprintf(buf + total,_T("%s,"),pln->data); total += len; break; case lnNode: len = LispNodeFormat(parm,buf + total,max - total) + 1 /*sub node with ','*/; if(len == 0 || total + len > max) return -1; if(buf) _stprintf(buf + total,_T("%s"),_T(",")); total += len; break; }
parm = GetNextLink(parm); }
buf[total] = _T(')'); /*replace last ',' with ')'*/
return total; }
/*calc lisp node and retur result string token*/ TCHAR* LispNodeCalc(LINKPTR nlk,LINKPTR ht,LispVarFetch vf,void* vfparam) { LispNode* pln; LispFuncPtr pf; LINKPTR elk,parm; int size; TCHAR** pa; TCHAR* token;
assert(nlk && nlk->tag == lkLispNode); pln = LispNodeFromLink(nlk); /*get lisp node func*/ elk = GetHashEntity(ht,pln->data,-1); if(elk == NULL) return NULL; pf = (LispFuncPtr)GetHashEntityData(elk); if(pf == NULL) return NULL;
size = LinkCount(&pln->lkParams); pa = (TCHAR**)calloc(size,sizeof(TCHAR*)); parm = GetFirstLink(&pln->lkParams); size = 0; while(parm) { pln = LispNodeFromLink(parm); switch(pln->type) { case lnNull: pa[size ++] = NULL; break; case lnString: pa[size ++] = pln->data; break; case lnNumeric: pa[size ++] = pln->data; break; case lnVar: if(vf) pa[size ++] = (*vf)(pln->data,vfparam); else pa[size ++] = NULL; break; case lnNode: pa[size ++] = LispNodeCalc(parm,ht,vf,vfparam); break; }
parm = GetNextLink(parm); }
token = (*pf)(pa,size);
parm = GetFirstLink(&pln->lkParams); size = 0; while(parm) { pln = LispNodeFromLink(parm); if(pln->type == lnNode) free(pa[size]);
size ++; parm = GetNextLink(parm); } free(pa);
return token; } /************************************************************ lisp parse function implement end *************************************************************/
/*LISP宏外部函数实现*/ /************************************************************ lisp export function implement begin *************************************************************/
/************************************************************ function: create lisp data and initialize return: lisp data link ptr *************************************************************/ LINKPTR CreateLispData(void) { LispData* pld; LINKPTR elk;
pld = (LispData*)calloc(1,sizeof(LispData)); pld->lk.tag = lkLispData; pld->ht = CreateHashTable(MAX_PRIM); pld->ln = NULL;
/*add some common lisp function*/ elk = AddHashEntity(pld->ht,PLUS,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_plus);
elk = AddHashEntity(pld->ht,SUB,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_sub);
elk = AddHashEntity(pld->ht,DIV,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_div);
elk = AddHashEntity(pld->ht,MUL,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_mul);
elk = AddHashEntity(pld->ht,AVG,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_avg);
elk = AddHashEntity(pld->ht,MIN,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_min);
elk = AddHashEntity(pld->ht,MAX,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_max);
elk = AddHashEntity(pld->ht,ROUND,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_round);
elk = AddHashEntity(pld->ht,ABS,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_abs);
elk = AddHashEntity(pld->ht,LEN,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_len);
elk = AddHashEntity(pld->ht,MID,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_mid);
elk = AddHashEntity(pld->ht,CAT,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_cat);
elk = AddHashEntity(pld->ht,FMT,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_fmt);
elk = AddHashEntity(pld->ht,EMPTY,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_empty);
elk = AddHashEntity(pld->ht,IF,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_if);
elk = AddHashEntity(pld->ht,LTR,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_ltr);
elk = AddHashEntity(pld->ht,RTR,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_rtr);
elk = AddHashEntity(pld->ht,CTR,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_ctr);
elk = AddHashEntity(pld->ht,SCMP,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_scmp);
elk = AddHashEntity(pld->ht,NCMP,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_ncmp);
elk = AddHashEntity(pld->ht,ZERO,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_zero);
elk = AddHashEntity(pld->ht,LEZE,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_leze);
elk = AddHashEntity(pld->ht,GRZE,-1,NULL,0); SetHashEntityData(elk,(unsigned int)lisp_grze); return &pld->lk; }
/************************************************************ function: destroy lisp data ptr: lisp data link ptr return: none *************************************************************/ void DestroyLispData(LINKPTR ptr) { LispData* pld;
assert(ptr && ptr->tag == lkLispData); pld = LispDataFromLink(ptr);
FreeLispNode(pld->ln); DestroyHashTable(pld->ht);
free(pld); }
/************************************************************ function: parse lisp data from string ptr: lisp data link ptr str: lisp token to parsing return: zero for success, none zero for error *************************************************************/ int LispDataParse(LINKPTR ptr,const TCHAR* str) { LispData* pld;
if(str == NULL) return 0;
assert(ptr && ptr->tag == lkLispData); pld = LispDataFromLink(ptr); pld->ln = LispNodeParse((TCHAR*)str,_tcslen(str)); if(pld->ln) return 0; else return -1; }
/************************************************************ function: format lisp data to string ptr: lisp data link ptr buf: buffer for formating max: buffer size return: -1 is error, else reutrn formated string size *************************************************************/ int LispDataFormat(LINKPTR ptr,TCHAR* buf,int max) { LispData* pld; int total = 0;
assert(ptr && ptr->tag == lkLispData); if(buf) buf[0] = _T('\0');;
pld = LispDataFromLink(ptr); if(pld->ln == NULL) return 0;
return LispNodeFormat(pld->ln,buf,max); }
/************************************************************ function: format lisp data request buffer size ptr: lisp data link ptr return: request buffer size *************************************************************/ int LispDataFormatSize(LINKPTR ptr) { LispData* pld;
assert(ptr && ptr->tag == lkLispData);
pld = LispDataFromLink(ptr); if(pld->ln == NULL) return 0;
return LispNodeFormat(pld->ln,NULL,MAX_INT); }
/************************************************************ function: calc lisp data ptr: lisp data link ptr return: result string token, it alloced by XdlAlloc and must be freeed by calling XdlFree *************************************************************/ TCHAR* LispDataCalc(LINKPTR ptr) { LispData* pld;
assert(ptr && ptr->tag == lkLispData);
pld = LispDataFromLink(ptr); if(pld->ln == NULL) /*no lisp node to calc*/ return NULL;
return LispNodeCalc(pld->ln,pld->ht,pld->vf,pld->vfparma); }
/************************************************************ function: set lisp calcing fetch outside variable data callback function ptr: lisp data link ptr vf: callback function for fetch variable data vfparam: callback function trans back param return: none *************************************************************/ void LispSetVarFetch(LINKPTR ptr,LispVarFetch vf,void* parm) { LispData* pld;
assert(ptr && ptr->tag == lkLispData);
pld = LispDataFromLink(ptr); pld->vf = vf; pld->vfparma = parm; }
/************************************************************ function: set lisp outside function ptr: lisp data link ptr funcname: lisp function name pf: lisp function ptr return: none *************************************************************/ void LispSetFunc(LINKPTR ptr,const TCHAR* funcname,LispFuncPtr pf) { LispData* pld; LINKPTR elk;
assert(ptr && ptr->tag == lkLispData); pld = LispDataFromLink(ptr); elk = AddHashEntity(pld->ht,(TCHAR*)funcname,-1,NULL,0); SetHashEntityData(elk,(unsigned int)pf); }
/************************************************************ function: get lisp outside function ptr: lisp data link ptr funcname: lisp function name return: lisp function ptr *************************************************************/ LispFuncPtr LispGetFunc(LINKPTR ptr,const TCHAR* funcname) { LispData* pld; LINKPTR elk;
assert(ptr && ptr->tag == lkLispData); pld = LispDataFromLink(ptr); elk = GetHashEntity(pld->ht,(TCHAR*)funcname,-1); if(elk == NULL) return NULL; else return (LispFuncPtr)GetHashEntityData(elk); }
/************************************************************ lisp export function implement end *************************************************************/
5、LISP宏的应用 CreateLispData用以创建LISP宏,在创建时一些常用的LISP函数被添加到函数清单中,用户也可通过LispSetFunc将自定义函数添加到函数清单中。用户通过LispSetVarFetch设置存取外部变量的回调函数,以此在LISP宏计算时动态设置变量的值。LispDataParse对LISP宏字符串进行解析,生成计算树,LispDataFormat是一逆向过程,将计算树格式化成LISP宏字符串。用户调用LispDataCalc对计算树进行递归计算,最终返回结果字符串。

|