What	Picol
Where	https://chiselapp.com/user/dbohdan/repository/picol/ (version 0.3.4, dbohdan's fork)
	http://wiki.tcl.tk/_repo/wiki_images/picol0-1-22.zip (version 0.1.22)
Description	A tiny Tcl interpreter.
Updated	2018-04-21 (version 0.3.4)
	2007-05-01 (version 0.1.22)
License	2-clause BSD

Picol

mirror

my entry on reddit

in French

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

http://wiki.tcl.tk/_repo/wiki_images/picol0-1-22.zip

/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 ||

Development notes  edit

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);
}

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;
}

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);
}

void* picolIsPtr(char* str) {
    void* p = NULL;
    sscanf(str,"%p",&p);
    return (p && strlen(str)>=3? p: NULL);
}

https://chiselapp.com/user/dbohdan/repository/picol/

• Picol's source code has been refactored and split into an stb-style header library (picol.h) and a separate REPL that uses it (interp.c). It comes with three simple example programs that embed and extend Picol (examples/{hello,command,regexp-ext}.c) and an optional regexp extension based on Tor Andersson's [public domain] regexp library.
• Makefiles and build scripts for *nix, MinGW and MSVC are included. (Picol builds in [MSYS2] with the stock Makefile, but MinGW is preferred because it provides an implementation of glob.h.)
• You can disable features like arrays or I/O with C preprocessor macros.
• There are new commands:
  • ! (logical not)
  • ~ (binary not)
  • ^, <<, >>, |, & (bitwise operators)
  • after ms (just for waiting; Picol has no event loop)
  • cd dirName
  • file delete|isdirectory|isfile|split path.
  • glob ?-directory directory? pattern
  • lassign list ?varName ...?
  • lmap varList list command
  • lrepeat count ?element ...?
  • lreverse list
  • max number ?number ...?
  • min number ?number ...?
  • pwd
  • string map
  • try body ?on error varName handler? ?finally script?
• Some commands' functionality has been reworked or enhanced. E.g., exec returns the output of the executed process; lindex, linsert, lrange, lreplace and string range now understand end.
• Any integer can now be given in binary (0b1011), hexadecimal (0x12ab) or octal (0o777, but not 0777).
• Correctness:
  • Many commands have been modified to produce the same result as in Tcl 8.6.
  • A number of segfault-causing memory access errors and memory leaks has been fixed. (Though many undoubtedly remain.)
  • 700 lines of tests has been added. The number of tests has more than doubled.
  • Version 0.3.0 introduces pointer tracking, which prevents segfaults when using features that depend on serialized pointers: arrays, interp create|eval and the file I/O commands.

Picolibri  edit

Colibri source distribution

here

See also  edit

• Jim Tcl, a non-toy Tcl interpreter project started by SS.
• Small Tcl for other implementations of Tcl smaller than Tcl 8.x.

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References