Hi [TH1 language]
Thanking introducing to TH1 Th_InterpAndList and thListAppend() by Joe Mistachkin http://fossil-scm.org/index.html/info/810e6c1e687c161f it is possible to implement [array keys] sub-command. If expand the structure and iterate function slightly, it is possible to implement [array get] sub-command for TH1 language. [array keys] ~= big Tcl [array names] (no mode and pattern). I have a diff to get sub-commands: keys, get, set and Tclx's like [for_array_keys] command. Could you, please, take a look on that? But, there is no [for_array_keys] command there. Examples: % ./fossil test-th-eval 'set a(i) ii; array get a' i ii % ./fossil test-th-eval 'array set a {i ii j jj k kk}; array keys a' i j k % ./fossil test-th-eval 'array set a {i ii j jj k kk}; array get a' i ii j jj k kk Sergei Index: src/th.c ================================================================== --- src/th.c +++ src/th.c @@ -98,10 +98,11 @@ */ struct Th_InterpAndList { Th_Interp *interp; /* Associated interpreter context */ char **pzList; /* IN/OUT: Ptr to ptr to list */ int *pnList; /* IN/OUT: Current length of *pzList */ + int flags; /* Additional flags to context */ }; /* ** Hash table API: */ @@ -321,12 +322,18 @@ ** ** Always returns non-zero. */ static int thListAppendHashKey(Th_HashEntry *pEntry, void *pContext){ Th_InterpAndList *pInterpAndList = (Th_InterpAndList *)pContext; - Th_ListAppend(pInterpAndList->interp, pInterpAndList->pzList, - pInterpAndList->pnList, pEntry->zKey, pEntry->nKey); + if( pInterpAndList->flags & 1 ) + Th_ListAppend(pInterpAndList->interp, pInterpAndList->pzList, + pInterpAndList->pnList, pEntry->zKey, pEntry->nKey); + if( pInterpAndList->flags & 2 ){ + Th_Variable *pValue = (Th_Variable *)pEntry->pData; + Th_ListAppend(pInterpAndList->interp, pInterpAndList->pzList, + pInterpAndList->pnList, pValue->zData, pValue->nData); + } return 1; } /* ** Push a new frame onto the stack. @@ -2859,10 +2866,41 @@ } *z = '\0'; return Th_SetResult(interp, zBuf, -1); } + +/* +** Appends array essences (keys and/or values) to the specified list +** and returns TH_OK upon success. Any other return value indicates an +** error. +*/ +int Th_ListAppendArrayEssences( + Th_Interp *interp, + const char *zVar, + int nVar, + char **pzList, + int *pnList, + int flags +){ + Th_Variable *pValue; + Th_InterpAndList *p; + pValue = thFindValue(interp, zVar, nVar, 0, 1, 0, 0); + if( !pValue ) return TH_ERROR; + if( pValue->zData ){ + Th_ErrorMessage(interp, "variable is a scalar:", zVar, nVar); + return TH_ERROR; + } + p = (Th_InterpAndList *)Th_Malloc(interp, sizeof(Th_InterpAndList)); + p->interp = interp; + p->pzList = pzList; + p->pnList = pnList; + p->flags = flags; + Th_HashIterate(interp, pValue->pHash, thListAppendHashKey, p); + Th_Free(interp, p); + return TH_OK; +} /* ** Appends all currently registered command names to the specified list ** and returns TH_OK upon success. Any other return value indicates an ** error. @@ -2872,10 +2910,11 @@ interp, sizeof(Th_InterpAndList) ); p->interp = interp; p->pzList = pzList; p->pnList = pnList; + p->flags = 1; Th_HashIterate(interp, interp->paCmd, thListAppendHashKey, p); Th_Free(interp, p); return TH_OK; } @@ -2891,12 +2930,13 @@ interp, sizeof(Th_InterpAndList) ); p->interp = interp; p->pzList = pzList; p->pnList = pnList; + p->flags = 1; Th_HashIterate(interp, pFrame->paVar, thListAppendHashKey, p); Th_Free(interp, p); return TH_OK; }else{ return TH_ERROR; } } Index: src/th.h ================================================================== --- src/th.h +++ src/th.h @@ -138,10 +138,15 @@ int Th_ToInt(Th_Interp *, const char *, int, int *); int Th_ToDouble(Th_Interp *, const char *, int, double *); int Th_SetResultInt(Th_Interp *, int); int Th_SetResultDouble(Th_Interp *, double); +/* +** Function for handling array essences. +*/ +int Th_ListAppendArrayEssences(Th_Interp *, const char *, int, char **, int *, int); + /* ** Functions for handling command and variable introspection. */ int Th_ListAppendCommands(Th_Interp *, char **, int *); int Th_ListAppendVariables(Th_Interp *, char **, int *); Index: src/th_lang.c ================================================================== --- src/th_lang.c +++ src/th_lang.c @@ -16,10 +16,123 @@ int Th_WrongNumArgs(Th_Interp *interp, const char *zMsg){ Th_ErrorMessage(interp, "wrong # args: should be \"", zMsg, -1); return TH_ERROR; } + +/* +** TH Syntax: +** +** array get arrayName +** array keys arrayName +*/ +static int array_keys_command( + Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl +){ + int rc; + int flags = 1; + char *zElem = 0; + int nElem = 0; + + if( argc!=3 ){ + char *zUsage = 0; + int nUsage = 0; + Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"array ", -1); + Th_StringAppend(interp, &zUsage, &nUsage, argv[1], argl[1]); + Th_StringAppend(interp, &zUsage, &nUsage, (const char *)" arrayName", -1); + Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"", 1); + Th_WrongNumArgs(interp, zUsage); + Th_Free(interp, zUsage); + return TH_ERROR; + } + + /* quite exit like big tcl does */ + if( !Th_ExistsVar(interp, argv[2], argl[2]) ){ + Th_SetResult(interp, 0, 0); + return TH_OK; + } + + if( argv[1][0]=='g' ) flags = 3; + rc = Th_ListAppendArrayEssences( + interp, argv[2], argl[2], &zElem, &nElem, flags + ); + if( rc!=TH_OK ){ + return rc; + } + + Th_SetResult(interp, zElem, nElem); + if( zElem ) Th_Free(interp, zElem); + return TH_OK; +} + +/* +** TH Syntax: +** +** array set arrayName list +*/ +static int array_set_command( + Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl +){ + int i; + int rc; + char **azElem; + int *anElem; + int nElem; + + if( argc!=4 ){ + return Th_WrongNumArgs(interp, "array set arrayName list"); + } + + rc = Th_SplitList(interp, argv[3], argl[3], &azElem, &anElem, &nElem); + if( rc!=TH_OK ){ + return rc; + } + if( nElem%2 ){ + Th_SetResult(interp, "list must have an even number of elements", -1); + rc = TH_ERROR; + goto error_out; + } + + Th_SetResult(interp, 0, 0); + for(i=0; rc==TH_OK && i<nElem; i+=2){ + int nRes = 0; + char *zRes = 0; + Th_StringAppend(interp, &zRes, &nRes, argv[2], argl[2]); + Th_StringAppend(interp, &zRes, &nRes, "(", 1); + Th_StringAppend(interp, &zRes, &nRes, azElem[i], anElem[i]); + Th_StringAppend(interp, &zRes, &nRes, ")", 1); + rc = Th_SetVar(interp, zRes, nRes, azElem[i+1], anElem[i+1]); + if( zRes ) Th_Free(interp, zRes); + } + +error_out: + if( azElem ) Th_Free(interp, azElem); + return rc; +} + +/* +** TH Syntax: +** +** array get +** array keys +** array set +*/ +static int array_command( + Th_Interp *interp, + void *ctx, + int argc, + const char **argv, + int *argl +){ + static const Th_SubCommand aSub[] = { + { "get", array_keys_command }, + { "keys", array_keys_command }, + { "set", array_set_command }, + { 0, 0 } + }; + return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub); +} /* ** Syntax: ** ** catch script ?varname? @@ -1161,10 +1274,11 @@ struct _Command { const char *zName; Th_CommandProc xProc; void *pContext; } aCommand[] = { + {"array", array_command, 0}, {"catch", catch_command, 0}, {"expr", expr_command, 0}, {"for", for_command, 0}, {"if", if_command, 0}, {"info", info_command, 0}, _______________________________________________ fossil-users mailing list fossil-users@lists.fossil-scm.org http://lists.fossil-scm.org:8080/cgi-bin/mailman/listinfo/fossil-users
