[George Peter Staplin] Dec 6, 2007 - Years ago I created something called coop. It started out as a C precompiler that added some unique keywords for dealing with single and double linked lists. I've grown tired of maintaining and porting that compiler, and the lex and yacc code, so I created Coop2 (this time in Tcl). Oddly Coop2 doesn't yet have any commands for dealing with linked lists. This Coop2 compiler has some features I wanted to play around with, and it generates C code. Dec 11, 2007 after many revisions I'm liking this more... I updated this to the latest code. -GPS external function puts int external function printf int structure rectangle property rectangle int x y width height update define rectangle initsize {int:width ; int:height} { self width width self height height printf "initializing size to %d %d\n" width height } define rectangle move {int:x ; int:y} { self x x self y y printf "moving to %d %d\n" x y } function main {int:argc ; char *[]:argv} { declare-object r rectangle set r [object rectangle] if {>? argc 2} { puts "MAGIC" while {>? argc 0} { puts "COUNTDOWN" set argc [- argc 1] } } r initsize 200 400 r move 1 2 r destroy return 0 } int ---- # Coop2 (a compiler for the Coop2 language) # By George Peter Staplin # Based on svn revision 486. # This assumes that all pointers are of equal size. # People using segmented architectures thus can't use this, but Tcl # doesn't run on such systems either AFAIK. array set ::structures {} array set ::functions {} array set ::methods {} array set ::externals {} array set ::corewords {} array set ::frame {} set ::max_type_size 8 set ::local_count 0 set ::method_count 0 set ::current_structure "" set ::init_code { #include #include static void *coopobject (size_t s) { void *p = malloc (s); if (NULL == p) { perror ("coopobject - malloc"); abort (); } return p; } static void *coopdestroy (void *o) { /*TODO work with the _references slot to make this automatic. */ free (o); return NULL; } } #This is used to create core words/commands. proc core {name argpat body} { global corewords set corewords($name) coop$name proc coop$name $argpat $body } #All core words return a 2 element list. #The 2 element lists consists of an optional type name, and a value. #Words that don't care about the type should just return [list "" $value]. foreach op [list + - * / %] { core $op {a b} [string map [list OP $op] { global local_count lassign $a atype a lassign $b btype b incr local_count set tmp cooptmp$local_count code "int $tmp = ($a OP $b);" return [list "" $tmp] }] } #I like a ? suffix for operators like these: foreach {coreop impop} [list >? > ? value 2} { puts "value is > 2" } {