[[get/put]list
Adrian Prantl <adrian@complang.tuwien.ac.at>**20081209105940] {
hunk ./compiler.fs 2
-Create X 0 ,
+Create X 0 , \ FIXME: use a struct instead
hunk ./compiler.fs 5
+Create cur-mode 0 ,
hunk ./compiler.fs 15
-: x-mode 0 ;
-: a-mode 1 ;
+: x-mode 0 ; \ Compile into X-regs
+: a-mode 1 ; \ Compile into A-regs
+: c-mode 1 ; \ Compile against A-regs (clause mode)
hunk ./compiler.fs 89
+: 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
+;
+: IfxExp? ( addr u -- addr u b )
+    2dup scan-tok 2drop
+    peek (? if until) endif
+    skip-ws
+    Arrow?
+    -rot 2drop
+;
+
+\ \\\\\\\\\\\\\\\
+
hunk ./compiler.fs 140
+        peek |? if cons else
hunk ./compiler.fs 142
-	endif endif
+	endif endif endif
hunk ./compiler.fs 181
+: getput ( -- ) cur-mode @ c-mode = if s" get" else s" put" endif type ;
+
hunk ./compiler.fs 185
-	execute @ s" put_value X" type . s" , A" type i . cr
+	execute @ getput s" _value X" type . s" , A" type i . cr
hunk ./compiler.fs 188
-	s" put_variable X" lastX s" ," . type cr
+	getput s" _value X" type lastX . s" , A" type i . cr
hunk ./compiler.fs 206
-    nil?  if 2drop s" put_nil A" type . cr else
+    nil?  if 2drop getput s" _nil A" type . cr else
hunk ./compiler.fs 220
-        postpone newA postpone -rot
+        postpone newA postpone -rot \ narg
hunk ./compiler.fs 226
+: isList? { nargs addr u }
+     nargs 2 =
+         u 1 =
+    addr c@ [Char] . = and and
+;
+
hunk ./compiler.fs 233
-    s" put_structure " type addrF uF type s" /" type nargs .
-    mode 1 and 1 = if
+    nargs addrF uF isList? if	getput s" _list " type
+    else getput s" _structure " type addrF uF type s" /" type nargs .  endif
+    mode a-mode and a-mode = if
hunk ./compiler.fs 240
+    mode cur-mode !
hunk ./compiler.fs 247
+    mode cur-mode !
hunk ./compiler.fs 302
+: compile-head ( addr u -- addr u )
+    skip-ws
+    scan-tok 2dup type s" /?: switch_on_term ?,fail" type cr { addrF uF }
+    s" ?:  try_me_else ?" type cr    
+    peek (? if \ functor
+	c-mode -rot
+	['] args paren { addrR uR }
+	addrF uF query
+	addrR uR
+	\ push X
+    else \ atom
+	a-mode 0 addrF uF query	\ push ATOM
+	compile-arg
+    endif
+    s" ?:  proceed ?" type cr
+;
+
+: compile-body ( addr u -- addr u )
+    skip-ws
+    scan-tok { addrF uF }
+    s" ?:  trust_me_else fail" type cr
+    peek (? if \ functor
+	c-mode -rot
+	['] args paren { addrR uR }
+	addrF uF query
+	addrR uR
+	\ push X
+    else \ atom
+	a-mode 0 addrF uF query
+	\ push ATOM
+    endif
+;
+
hunk ./compiler.fs 343
-\	Ifx? not throw
-\	compile-head compile-body
+	IfxExp? if
+	    compile-head 
+	    skip-ws Arrow? next-char next-char skip-ws
+	    compile-body
+	else compile-head
+	endif
+	type
hunk ./compiler.fs 353
-\ append([], L, L).
-\ append([X|L1], L2, [X|L3]) :- append(L1, L2, L3).
+\ concatenate([], L, L).
+\ concatenate([X|L1], L2, [X|L3]) :- concatenate(L1, L2, L3).
hunk ./compiler.fs 356
-\ append/3: switch_on_term C1a, C1, C2, fail
+\ concatenate/3: switch_on_term C1a, C1, C2, fail
hunk ./compiler.fs 390
+s" :- f([X|[]])" test
+s" :- f([X|Xs])" test
+
+s" concatenate([],L,L)." test
+s" concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3)." test
}