#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

scrap	= sp_save

; input
;	hl - pointer to arg list
;	de - environment
; output
;	hl - closure

#comment
Closure memory will be set up like this:

cons cell with	car = (env . formals)
		cdr = code pointer

#endcomment
 

;        v
;(lambda (args ...) body)
make_closure:
	;break()
	
	push hl
	call build_closure_free_env
	
	pop hl
	push hl
	
	push de

	call handle_quote

	ex de,hl			; de gets formals
	pop hl				; hl gets free env
	
	call list_cons			; put the env at the beginning
	ex de,hl
	
	pop hl
	call next_arg
	jp nz,err_syntax
	ex de,hl
	
	call list_cons
	
	ld a,l
	or tag_closure
	ld l,a
	ret

	
; input
;	bc - closure
;	hl - arglist			; pair
; output
;	hl - result of applying closure
#comment
Any screwing around with tail/nontail
must be done before messing with this
I'm referring to removing args off of the
env if you were wondering
#endcomment
apply_closure:
	assert_type(closure, bc)
	
apply_closure_skip:
	strip_tag(bc)
	
	push bc
	push hl				; save values list
	
	ld a,(bc+)\ ld l,a
	ld a,(bc+)\ ld h,a		; hl gets (env . formals)			
	
	ld e,l
	ld d,h
	call list_car
	ex de,hl
	call list_cdr			; hl gets formals

	pop bc				; restore values list
	
	; hl = list of arg names
	; bc = list of arg values
	; de = env
	xor a
closure_env_loop:
	push af
	call list_null_nz
	jp z,closure_env_done
	
	ld a,l
	and tag_mask
	cp tag_pair
	jp nz,closure_arglist		; if it's not a pair, it's an arglist
	
	
	push hl
	push bc
	
	push bc
	call list_car			; hl = name
	ex (sp),hl
	call list_car

	ld c,l\ ld b,h
	pop hl
	
	call extend_env
	
	pop hl
	ld a,l
	and tag_mask
	cp tag_pair
	call z,list_cdr
	ld c,l\ ld b,h
	pop hl
	call list_cdr
	
	pop af
	inc a				; increase frame size
	jp closure_env_loop

; input
;	de - env
;	hl - argument name
;	bc - argument list
closure_arglist:
	pop af
	inc a
	push af

	call extend_env			; map all arguments to one arg name
	
; input
;	de - env	
closure_env_done:
	pop af
	pop hl				; restore closure address
	inc hl\ inc hl
	ld b,(hl+)
	ld h,(hl)
	ld l,b
	jp handle_begin
	
	
; input
;	hl - expression
; 	de - environment
; output
;	de - new environment containing bound free vars
#comment
If a var cannot be found in the given env, it is bound to (void).
This is an indication to letrec and define to rebind that variable
later

#endcomment
build_closure_free_env:

	push de
	ld de, empty_env
	call find_free_lambda
	
	ld de,empty_env
	ld (scrap),de			; use the global env as the base
	pop de
	
; hl	- list containing free vars
build_free_loop:
	ld a,l
	cp null
	jr z, build_free_done
	
	push hl
	call list_car
	
	push de
	call apply_env
	;jp nz,err_var
	
	push bc
	ex (sp),hl
	pop bc				; ex bc,hl
	
	ld de,(scrap)
	call extend_env_raw
	ld (scrap),de
	pop de
	
	pop hl
	call list_cdr
	jp build_free_loop
	
build_free_done:
	ld de,(scrap)
	ret
#comment
	ex de,hl
	call pretty_print
	bcall(_getkey)
	bjump(_JForceCmdNoChar)
#endcomment