#comment
     This file is part of Z80 Scheme Interpreter     

     Z80 Scheme Interpreter is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
     the Free Software Foundation; either version 2 of the License, or
     (at your option) any later version.
 
     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     GNU General Public License for more details.
 
     You should have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 
     Copyright 2007, Spencer Putt
#endcomment


; input
;	hl - car
;	de - cdr
; output
;	hl - cons pair
;	bc - cons pair
list_cons:
	push de
	ex de,hl
	call alloc
	ld b,h
	ld c,l
	ld (hl+),e
	ld (hl+),d
	pop de
	ld (hl+),e
	ld (hl),d

	ld a,tag_pair
	or c
	ld c,a
	ld l,a
	ld h,b
	ret
	
	
; input
;	hl - pair
; output
;	hl - cdr of pair
list_cdr:
	assert_type(pair, hl)
list_cdr_skip:
	strip_tag(hl)
	
	; skip the car
	inc hl
	inc hl
	
	set 7,h
	ld hl,a,(hl)
	ret
	
	
	
; input
;	hl - pair
;	de - value to set cdr
; output
;	hl - pair
set_cdr!:
	assert_type(pair, hl)
set_cdr!_skip:
	push hl
	strip_tag(hl)
	
	; skip the car
	inc hl
	inc hl
	
	ld (hl+),e
	ld (hl),d
	pop hl
	ret
	
	
; input
;	hl - pair
; output
;	hl - car of pair
list_car:
	assert_type(pair, hl)
list_car_skip:
	strip_tag(hl)
	
	set 7,h
	ld hl,a,(hl)
	ret
	
; input
;	hl - pair
;	de - value to set car
; output
;	hl - pair	
set_car!:
	assert_type(pair, hl)
set_car!_skip:
	push hl
	strip_tag(hl)
	
	ld (hl+),e
	ld (hl),d
	pop hl
	ret	
	
	
; input
;	hl - list1
;	de - list2
; output
;	hl - list1 with list2 on the end
	
list_append:
	ld a,l
	cp null
	jr z,list_append_done

	push de
	push hl
	
	call list_cdr
	call list_append
	ex de,hl
	pop hl
	call list_car
	
	call list_cons
	pop de
	ret
	
list_append_done:
	ex de,hl
	ret
	
	
list_null_nz:
	ld a,l
	cp NULL
	ret
	
list_null?:	
	ld a,l
	cp NULL
	jp nz_to_bool
	
	
; input
;	hl - pair
;	de - value
; output
;	if value exists in the list
;		hl - pair beginning at member
;	otherwise
;		hl - #f
;	de - value

list_memq:

	
list_memq_loop:
	ld a,l
	and escape_mask
	cp NULL
	jr z, nz_false
	
	push hl
	call list_car
	
	push de
	call equal?
	pop de
	jr z, list_memq_found
	
	
	pop hl
	call list_cdr
	jp list_memq_loop
	
list_memq_found:			; z is set when this is called
	pop hl
	ret
	

; input
;	hl - list 1
;	de - list 2
; output
;	hl - true if equal, false if non-equal
;	z  - equal
;	nz - non equal
list_equal?:
	ld a,l
	cp null
	jr nz,_
	
	ld a,e
	cp null
	jp nz_to_bool
	
_	ld a,e
	cp null
	jr z,nz_false
	
	push de
	push hl

	call list_car
	ex de,hl
	call list_car
	
	call equal?
	
	pop hl
	pop de
	jp nz,nz_false
	
	call list_cdr
	ex de,hl
	call list_cdr
	jp list_equal?
	
list_nonequal:

nz_false:
	ld hl,false
	inc l\ dec l
	ret
	
z_true:
	ld hl,true
	cp a
	ret
	
equal?:
	ld a,l
	xor e
	and tag_mask
	jr nz,nz_false
	
	ld a,l
	and tag_mask
	cp tag_fixnum
	jp z,fixnum_equal?
	
	ld a,l
	and escape_mask
	cp tag_symbol
	jp z,symbol_equal?
	
	jp list_equal?
	
	
; input
;	hl - pointer to unevaluated lists
; output
;	hl - ((1st list elements) (2nd list elements))
;v
;(list) (list) (list))
list_zip:
	call list_null_nz
	ret z
	
	push hl
	call list_car
	call list_length
	pop hl

	ld b,a				; give b the arg count of an individual list
	ld c,0
list_zip_loop:
	ld a,c
	cp b
	jp z,list_zip_done

	push hl
	
	push bc
	call list_zip_nth_arg
	pop bc
	inc c
	
	
	ex (sp),hl
	call list_zip_loop
	pop de
	ex de,hl
	jp list_cons
	
list_zip_done:
	ld hl,null
	ret
	
	
	
; input
;	hl - list of arg lists
;	c - nth arg to zip (if bit 7 is set, case is special for named let)
; output
;	hl - list containing nth args from all arg list

;   v 
;   (a b c) (d e f) (g h i)) @ 1
; output:
;   (b e h)

list_zip_nth_arg:
	call list_null_nz
	ret z
	
	push hl
	
	call list_car
	
	ld a,c
	call list_get_nth_arg

	bit 7,c
	call z,list_car
	
	ex (sp),hl
	call list_cdr
	call list_zip_nth_arg
	ex de,hl
	pop hl
	jp list_cons
	
	
	
; input
;	hl - list
; output
;	a - length
	
list_length:
	ld c,0
list_length_loop:
	call list_null_nz
	jr z,list_length_done
	call list_cdr
	inc c
	jp list_length_loop
list_length_done:
	ld a,c
	ret

	
	
; input
;	hl - list
;	a - n
; output
;	z = got arg
;		hl - list with nth arg at front
;	nz = failed to get arg

list_get_nth_arg:
	res 7,a
	ld b,0
list_get_nth_loop:
	cp b
	ret z
	push af
	
	call list_null_nz
	jr z,list_get_nth_fail
	
	push bc
	call list_cdr
	pop bc
list_get_nth_next:
	pop af
	inc b
	jr list_get_nth_loop
	
list_get_nth_fail:
	xor a\ inc a
	ret