[More bugfixes.
Adrian Prantl <adrian@complang.tuwien.ac.at>**20090121161333] {
hunk ./compiler.fs 25
+: 3dup { a b c } a b c a b c ;
hunk ./compiler.fs 186
+\ collect all arguments of a functor
hunk ./compiler.fs 266
-    get-current { old }
-    VARS set-current
-    \ ." --> binding " 2dup type ."  to " rot dup . -rot cr
-    nextname create , \  alloc and initialize
-    old set-current
+    2dup find-var if \ update
+	nip nip execute !
+    else  \ bind new
+	get-current { old }
+	VARS set-current
+	\ ." --> binding " 2dup type ."  to " rot dup . -rot cr
+	nextname create , \  alloc and initialize
+	old set-current
+    endif
hunk ./compiler.fs 278
-\ : compile-var ( addr u -- ) type ."  unify_variable " cr ;
+: ->ar ( u -- u ) FutureArg nand ;
+
+: unify-temporary ( addr u )
+    newX -rot bind-new-var
+    ." Y" lastX . ." unify_variable" cr
+;
+
+: future-arg? ( u -- u b ) dup FutureArg set? ;
hunk ./compiler.fs 287
-: compile-var { addr u }
+: compile-var-struct { i addr u }
hunk ./compiler.fs 290
-	FutureArg dup set? if
-	    \ store real arg
-	    FutureArg nand dup addr u bind-new-var
-	    ." A" . ." unify_variable" cr
-	else ." Y" . ." unify_value" cr endif
+ 	future-arg? if \ needed in future Ax
+	    dup ->ar i < if   \ Ax is not live any more
+		\ use the target Ax register directly
+		->ar ." A" . ." unify_variable" cr
+	    else drop addr u unify-temporary endif
+	else ->ar ." Y" . ." unify_value" cr endif
hunk ./compiler.fs 297
-	newX addr u bind-new-var
-	." Y" lastX . ." unify_variable" cr
+	addr u unify-temporary
hunk ./compiler.fs 301
-: getput ( -- ) cur-mode @ c-mode set? if ." get" else ." put" endif ;
+: head? ( -- b ) cur-mode @ c-mode set? ;
+: getput ( -- ) head? if ." get" else ." put" endif ;
+
+
+: copy-temporary { i addr u -- }
+    newX addr u bind-new-var
+    ." Y" lastX . ." A" i . getput ." _variable " cr
+;
hunk ./compiler.fs 311
-    addr u find-var if \  already alloc'd
-	execute @ dup
-	FutureArg nand
-	i = if drop \ skip indent. copy
-	else ." Y" . ." A" i FutureArg nand . getput ." _value" cr endif
-    else \  create new
-	\ i addr u bind-new-var
-	
-	newX addr u bind-new-var
-	." Y" lastX . ." A" i . getput ." _value " cr
+    addr u find-var if  \  already alloc'd
+	execute @
+	future-arg? head? nand if
+	    drop \ ignore
+	    i addr u copy-temporary
+	else
+	    ->ar dup i = if
+		drop \ skip (identical) copy
+	    else ." Y" . ." A" i . getput ." _value" cr endif
+	endif
+    else  \  create/use new temporary
+	i addr u copy-temporary
hunk ./compiler.fs 327
-    reg?  if ." X" . ." put_value" drop cr else
-    var?  if compile-var else
-    nil?  if 2drop ." put_nil" cr else
+    reg?  if ." X" . ." put_value???" 2drop cr else
+    var?  if compile-var-struct else
+    nil?  if 3drop ." put_nil" cr else
hunk ./compiler.fs 332
-    drop
hunk ./compiler.fs 335
+    \ 3dup ."                      \ compiling " type ." , #" . cr
hunk ./compiler.fs 433
-    1+ X !
+    2 + X !
hunk ./compiler.fs 486
-    x-mode cur-mode !
+    a-mode cur-mode !
hunk ./compiler.fs 502
-: compile ( addr u -- )
+: compile-clause ( addr u -- )
hunk ./compiler.fs 511
-	    begin
+	    begin 
hunk ./compiler.fs 549
-    compile
+    compile-clause
}