%%HP: T(3)A(R)F(.);
C$ 2076 ::
$ "local v1.1 J M O'Donnell
see local.doc for copyright"
DROP 
 CODE
* analyse lam envs
* for each env
*   op names of lams
*   op # lams
* op # env
	GOSBVL	=SAVPTR
* get point to point to lam env
	D0=(5)	(=addrTEMPENV)+2
* deref to ver dep point to env
	C=DAT0	A
	D0=C
* C saves addr of nxt lam env
	C=DAT0	A
* count # of lam envs in B
	B=0	A
NEWLEV D0=C
* A blck size
	A=DAT0	A
	?A#0	A
	GOYES	MORE
* op # blcks & exit
	A=B	A
	GOSBVL	=PUSH#ALOOP
MORE
* set D blck id
	D0=D0+	5
	D=C	A
	C=DAT0	A
	CDEX	A
* update C to nxt env
* & A saves ptr to this env
	ACEX	A
	C=C+A	A
* skip undo stack
	?D#0	A
	GOYES	NEWLEV
* count this env
	B=B+1	A
	GOSUB	NAMES
	GOTO	NEWLEV
NAMES
* for blck at A
*   op lam names
*   op # lam
* save rgstrs
	ABEX	A
	R1=A	A
	R2=C	A
	A=B	A
* count # lam in B
	B=0	A
NXTNAM 
* A ptr addr name
* R2 addr nxt blck
	A=A+CON A,10
	C=R2	A
	?C=A	A
	GOYES	EXTNAM
	B=B+1	A
* C addr name
	D0=A	A
	C=DAT0	A
* save rgstrs
	R4=C	A
	R0=A	A
	A=B	A
	R3=A	A
* push anything
	GOSBVL	=PUSH#
	GOSBVL	=SAVPTR
* restore rgstrs
	A=R3	A
	B=A	A
	A=R0	A
	C=R4	A
* replace anything
* with name
	DAT1=C	A
	GOTO	NXTNAM
EXTNAM
* push # \Gl
	A=B	A
	R0=A	A
	GOSBVL	=PUSH#
	GOSBVL	=SAVPTR
* restore rgstrs
	C=R2	A
	A=R1	A
	B=A	A
	RTN
 ENDCODE
* all the info is on stack
* but one item per entry
* change to one list per env
 NULL{} { NULLLAM NULLLAM } BIND
 2GETLAM 0 #> IT
 ::
  2GETLAM #1+ 1
  DO
   NULL{} SWAP 0
   DO
   :: SWAP >TCOMP
   ;
   LOOP
   2GETLAM INDEX@ #-+1 #>HXS HXS>$ >TAG 1GETLAM
   SWAP >TCOMP 1PUTLAM
  LOOP
 ; 
 1GETLAM INNERCOMP #>HXS $ "local envs" >TAG
 ABND
;