[cons fixed.
Adrian Prantl <adrian@complang.tuwien.ac.at>**20090109154435] {
hunk ./compiler.fs 2
+\ Defer VARS
hunk ./compiler.fs 11
+defer cons,
hunk ./compiler.fs 17
-: x-mode 0 ; \ Compile into X-regs
-: a-mode 1 ; \ Compile into A-regs
-: c-mode 2 ; \ Compile against A-regs (clause mode)
+: x-mode 1 ; \ Compile into X-regs
+: a-mode 2 ; \ Compile into A-regs
+: c-mode 4 ; \ Compile against A-regs (clause mode)
+
+: set? ( u bit -- b ) tuck and = ; \ check whether bit is set
hunk ./compiler.fs 170
+\ cons for the [a,b,c] syntax
+\ the difference is that ']' generates an implicit '|[]'
+: cons,' { mode addr u  -- ... mode addr u }
+    mode addr u
+    next-char 
+    peek ]? if next-char nil
+    else
+	\ Head
+	\ lowermode
+	term skip-ws
+	\ Tail
+	peek ]? if next-char nil else \ end of list
+        peek ,? if cons, else
+	    -1 throw
+	endif endif
+	2>r drop mode 2 s" ." structure mode 2r> 
+     endif
+;
+' cons,' is cons,
+
hunk ./compiler.fs 196
-	drop3rd x-mode -rot
+	\ lowermode
hunk ./compiler.fs 200
-        peek ,? if cons else
-        peek |? if next-char Nil? if next-char else prev-char endif
-		cons else
+        peek ,? if cons, else
+	peek |? if next-char term peek ]? not throw next-char else
+	 \ if next-char Nil? if next-char else prev-char endif cons else
hunk ./compiler.fs 238
-: compile-var ( addr u -- ) type ."  unify_variable " cr ;
+\ : compile-var ( addr u -- ) type ."  unify_variable " cr ;
hunk ./compiler.fs 240
-: old-compile-var { addr u }
+: compile-var { addr u }
hunk ./compiler.fs 242
-	execute @ . ."  set_value X" cr
+	execute @ ." X" . ." unify_value" cr
hunk ./compiler.fs 245
-	lastX . ."  set_variable X" cr
-	
+	." X" lastX . ." unify_variable" cr
hunk ./compiler.fs 249
-: getput ( -- ) cur-mode @ c-mode = if ." get" else ." put" endif ;
+: getput ( -- ) cur-mode @ c-mode set? if ." get" else ." put" endif ;
hunk ./compiler.fs 253
-	execute @ ." X" . getput ." _value" ." , A" i . cr
+	execute @ ." A" . ." A" i . getput ." _value" cr
hunk ./compiler.fs 255
-	newX addr u bind-new-var
-	." X" lastX . ." A" i . getput ." _value " cr
+	i addr u bind-new-var
+	\ newX addr u bind-new-var
+	\ ." X" lastX . ." A" i . getput ." _value " cr
hunk ./compiler.fs 261
-: compile-value ( i addr u -- ) 
+: compile-structval ( i addr u -- ) 
hunk ./compiler.fs 303
-    mode a-mode and a-mode = if
-	." A" mode 8 rshift . 
-    else
+    mode x-mode set? if
hunk ./compiler.fs 305
+    else
+	." A" mode 8 rshift . 
hunk ./compiler.fs 312
-    nargs [ ' compile-value for-each-arg ]
+    nargs [ ' compile-structval for-each-arg ]
hunk ./compiler.fs 363
-: init ( nargs -- ) 1+ X ! 0 A ! ;
+: init ( nargs -- )
+    1+ X !
+    0 A !
+\    table , VARS [IS] ! \ clear VARS dictionary
+;
hunk ./compiler.fs 471
+
+
}