编程手记之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对计算树进行递归计算，最终返回结果字符串。
