[Postfix notation
Adrian Prantl <adrian@complang.tuwien.ac.at>**20081209155737] {
hunk ./compiler.fs 17
-: c-mode 1 ; \ Compile against A-regs (clause mode)
+: c-mode 2 ; \ Compile against A-regs (clause mode)
hunk ./compiler.fs 19
+\ ----------------------------------------------------------------------
hunk ./compiler.fs 21
+\ ----------------------------------------------------------------------
hunk ./compiler.fs 71
+: Nil? ( addr u -- addr u b )
+    peek      [Char] [ = >r
+    peek-next [Char] ] = r>
+    and
+;
+
hunk ./compiler.fs 113
+
+: until] ( addr u -- addr u ) \ skip til matching ')
+    dup 0= throw \ eof
+    0 begin ( addr u cnt )
+	>r \ 2dup type cr
+	peek [? if r> 1+ >r else
+	peek ]? if r> 1- >r
+	endif endif
+        next-char r@ r> 0 =
+    until drop
+;
+
hunk ./compiler.fs 133
+: num-args ( addr u -- addr u nargs ) \ count the number of args of a functor
+    2dup next-char
+    1 >r begin 
+	skip-ws scan-tok 2drop
+	peek (? if until) endif	skip-ws
+	peek [? if until] endif	skip-ws 
+	peek ,? if r> 1+ >r next-char skip-ws endif
+    peek )? until
+    2drop r>
+;
+
hunk ./compiler.fs 168
-    next-char
-    peek ]? if next-char nil \ nil atom \ ." pushing NIL " cr
+    next-char 
+    peek ]? if next-char nil
hunk ./compiler.fs 177
-        peek |? if cons else
+        peek |? if next-char Nil? if next-char else prev-char endif
+		cons else
hunk ./compiler.fs 186
+\ ----------------------------------------------------------------------
hunk ./compiler.fs 188
+\ ----------------------------------------------------------------------
hunk ./compiler.fs 190
+\ data types
hunk ./compiler.fs 201
+\ register allocator
hunk ./compiler.fs 214
-: compile-var { addr u -- }
+: compile-var ( addr u -- ) type ."  unify_variable " cr ;
+
+: old-compile-var { addr u }
hunk ./compiler.fs 218
-	execute @ ." set_value X" . cr
+	execute @ . ."  set_value X" cr
hunk ./compiler.fs 221
-	." set_variable X" lastX . cr
+	lastX . ."  set_variable X" cr
+	
hunk ./compiler.fs 230
-	execute @ getput ." _value X" . ." , A" i . cr
+	execute @ ." X" . getput ." _value" ." , A" i . cr
hunk ./compiler.fs 233
-	getput ." _value X" lastX . ." , A" i . cr
+	." X" lastX . ." A" i . getput ." _value " cr
hunk ./compiler.fs 238
-    reg?  if ." set_value X" . drop cr else
+    reg?  if ." X" . ." put_value" drop cr else
hunk ./compiler.fs 240
-    nil?  if 2drop ." set_nil" cr else
+    nil?  if 2drop ." put_nil" cr else
hunk ./compiler.fs 251
-    nil?  if 2drop getput ." _nil A" . cr else
+    nil?  if 2drop ." A" . ." " getput ." _nil" cr else
hunk ./compiler.fs 278
-    nargs addrF uF isList? if	getput ." _list " 
-    else getput ." _structure " addrF uF type ." /" nargs .  endif
+    mode cur-mode !
hunk ./compiler.fs 280
-	." , A" mode 8 rshift . cr 
+	." A" mode 8 rshift . 
hunk ./compiler.fs 282
-	." , X" newX . cr
+	." X" newX .
hunk ./compiler.fs 284
-    mode cur-mode !
+    
+    nargs addrF uF isList? if getput ." _list " 
+    else addrF uF type ." /" nargs . getput ." _structure " endif
+    cr
hunk ./compiler.fs 300
-    ." call " addrF uF type ." /" nargs . cr
+    addrF uF type ." /" nargs . ." call" cr
hunk ./compiler.fs 338
+
+: init ( nargs -- ) 1+ X ! 0 A ! ;
+
hunk ./compiler.fs 342
+    a-mode cur-mode !
hunk ./compiler.fs 346
-	a-mode -rot
+	num-args init
+	cur-mode @ -rot
hunk ./compiler.fs 353
-	a-mode 0 addrF uF query
+	0 init
+	cur-mode @ 0 addrF uF query
hunk ./compiler.fs 360
+    c-mode cur-mode !
hunk ./compiler.fs 362
-    scan-tok 2dup type ." /?: switch_on_term ?,fail" cr { addrF uF }
-    ." ?:  try_me_else ?" cr    
+    scan-tok ." Cx Cy fail switch_on_term \ " 2dup type cr { addrF uF }
+    ." Cy Cz try_me_else" cr
hunk ./compiler.fs 365
-	c-mode -rot
+	num-args init
+	cur-mode @ -rot
hunk ./compiler.fs 372
-	a-mode 0 addrF uF head	\ push ATOM
+	0 init
+	cur-mode @ 0 addrF uF head	\ push ATOM
hunk ./compiler.fs 379
+    x-mode cur-mode !
hunk ./compiler.fs 383
-	c-mode -rot
+	num-args init
+	cur-mode @ -rot
hunk ./compiler.fs 390
-	a-mode 0 addrF uF query
+	0 init
+	cur-mode @ 0 addrF uF query
hunk ./compiler.fs 397
-    0 X !
-    0 A !
hunk ./compiler.fs 403
-	    compile-head 
+	    compile-head
hunk ./compiler.fs 409
-	." ?:  proceed ?" cr
+	." proceed" cr
hunk ./compiler.fs 434
-\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ----------------------------------------------------------------------
hunk ./compiler.fs 436
-\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+\ ----------------------------------------------------------------------
+
}