Version 24 of Picol

Updated 2007-04-26 07:21:15 by suchenwi

SS: Picol (http://antirez.com/page/picol ) is a Tcl interpreter in 500 lines of C code! If you like it vote my entry on reddit here http://programming.reddit.com/info/1aft9/comments (the reddit url changed because of a reddit bug).

RS Since 2007-04-01, I'm playing with Picol at home - it's been a long while that I prefer to do a breakfast fun project in C :) Basically I'm adding features to bring it closer to Tcl (7.x - everything is a string really). Linecount is at about 1700 now. Latest additions focused on 8.5 features like apply (see below), {*}, in/ni etc.

As the regular Wiki is read-only, I made my first report in French at http://wfr.tcl.tk/Picol

Build it with either of:

 gcc -O2 -Wall -o picol picol.c
 cl /O2 /W3 -o picol.exe picol.c

Version 0.1.20 is zipped, together with test suite, at http://mini.net/files/picol0-1-20.zip - added lindex, lsearch, lsort, linsert, lreplace, pid, etc. See also About Picol. The currently supported command set (some only partially) is

 /Tcl/Picol $ picol -e 'lsort [info commands]'
 ! != % && * ** + - / < <= == > >= _l abs append array break catch clock close concat continue eof eq error eval
 exec exit expr file flush for foreach format gets glob global if in incr info interp join lappend lindex linsert
 list llength lrange lreplace lsearch lset lsort ne ni open pid proc puts pwd rand read rename return scan seek
 set setenv source split string subst switch tell time trace unset uplevel variable while ||

Here's an example how I extended Picol for simple file I/O, implementing open, gets and close:

 int picolCommandOpen(struct picolInterp *i, int argc, char **argv, void *pd) {
  char* mode = "r";
  FILE* fp = NULL;
  char buf[64];
  if (argc != 2 && argc != 3) return picolArityErr(i,argv[0]);
  if(argc == 3) mode = argv[2];
  fp = fopen(argv[1], mode);
  if(!fp) {return picolError1(i, "could not open file %s", argv[1]);}
  sprintf(buf,"%p",fp);
  return picolSetResult(i,buf);
 }

 int picolCommandGets(struct picolInterp *i, int argc, char **argv, void *pd) {
    char buf[1024];
    char* getsrc;
    FILE* fp = stdin;
    if (argc != 2 && argc != 3) return picolArityErr(i,argv[0]);
    if(!STREQ(argv[1],"stdin")) {
      sscanf(argv[1],"%p", &fp); /* caveat usor */
    }
    if(!feof(fp)) {
      getsrc = fgets(buf,sizeof(buf), fp);
      buf[strlen(buf)-1] = '\0'; /* chomp last newline */
      if (argc == 2) {
        picolSetResult(i,buf);
      } else {
        if(getsrc) {
          picolSetVar(i,argv[2],buf);
          picolSetIntResult(i,strlen(buf));
        } else {picolSetResult(i,"-1");}
      }
    } else {picolSetResult(i,"-1");}
    return PICOL_OK;
 }

 int picolCommandClose(struct picolInterp *i, int argc, char **argv, void *pd) {
   FILE *fp = NULL;
   if (argc != 2) return picolArityErr(i,argv[0]);
   sscanf(argv[1],"%p", &fp); /* caveat usor */
   fclose(fp);
   return PICOL_OK;
 }
 ...
    picolRegisterCommand(i,"open", picolCommandOpen,NULL);
    picolRegisterCommand(i,"gets", picolCommandGets,NULL);
    picolRegisterCommand(i,"close",picolCommandClose,NULL);

 int picolCommandList(struct picolInterp *i, int argc, char **argv, void *pd) {
    char buf[1024] = "";
    int a;
    for(a=1; a<argc; a++) {
      int needbraces = (strchr(argv[a],' ')!=NULL);
      if(needbraces) strcat(buf,"{");
      strcat(buf,argv[a]);
      if(needbraces) strcat(buf,"}");
      if(a < argc-1) strcat(buf," ");
    }
    return picolSetResult(i,buf);
 }

rs 2007-04-04: I couldn't resist to post this cute little clock implementation (ok, no stardate..., but only 18 lines of code):

 int picolCommandClock(struct picolInterp *i, int argc, char **argv, void *pd) {
    time_t t;
    if (argc < 2) return picolArityErr(i,argv[0]);
    if(     STREQ(argv[1],"clicks")) picolSetIntResult(i,clock());
    else if(STREQ(argv[1],"format")) {
        EXPECT_INT(argv[2]);
        t = atoi(argv[2]);
        if (argc==3 || (argc==5 && STREQ(argv[3],"-format"))) {
            char buf[128], *cp;
            struct tm* mytm = localtime(&t);
            if(argc==3) cp = "%a %b %d %H:%M:%S %Y"; else cp = argv[4];
            strftime(buf,sizeof(buf),cp,mytm);
            picolSetResult(i,buf);
        } else return picolError(i,"usage: clock format $t ?-format $fmt?");
    } else if(STREQ(argv[1],"seconds")) picolSetIntResult(i,time(&t));
    else return picolError(i,"usage: clock clicks|format|seconds ..");
    return PICOL_OK;
 }

RS 2007-04-25: Here's how I did apply in 11 lines of code :^)

 int picol_Apply(picolInterp *i, int argc, char **argv, void *pd) {
   char* procdata[2], *cp;
   char buf[MAXSTR], buf2[MAXSTR];
   ARITY2(argc >= 2, "apply {argl body} ?arg ...?");
   cp = picolParseList(argv[1],buf);
   if(!cp) return picolErr(i,"bad apply usage");
   picolParseList(cp,buf2);
   procdata[0] = buf;
   procdata[1] = buf2;
   return picolCallProc(i, argc-1, argv+1, (void*)procdata);
 }

Category Language