perm filename LC0[206,LSP] blob sn#306065 filedate 1977-09-19 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	fexpr compl file ← begin scalar z
C00006 ENDMK
C⊗;
fexpr compl file ← begin scalar z;
	eval[ OUTPUT . [ DSK: . list[a file . LAP]]]
	eval[ INPUT . [DSK: . file]]
	inc[T,NIL]
	outc[T,NIL]
  loop: z ← errset read[]
	if at z then goto done
	z ← a z
	if a z eq DE then
	begin scalar prog;
		prog ← comp[ad z,add z,addd z]
		mapc[print,prog]
		outc[NIL,NIL]
		print (ad z,length prog)
		outc[T,NIL]
	end
	else print z
	go to loop
  done: outc[NIL,T]
	inc[NIL,T]
	return ENDCOMP
	end



comp[fn,vars,exp] ← [λn.((LAP,fn,SUBR)) * mkpush[n,1]
			* compexp[exp,-n,prup[vars,1]]
			* ((SUB,P,(C,0,0,n,n)))
			* ((POPJ P) NIL)]
				[length vars]

prup[vars,n] ← if n vars then NIL else [a vars . n] . prup[d vars,n+1]

mkpush[n,m] ← if n<m then NIL else (PUSH,P,m) . mkpush[n,m+1]

compexp[exp,m,vpr] ←
	if n exp then (( MOVEI 1 0 ))
	else if exp eq T then (( MOVEI 1 ( QUOTE T )))
	else if at exp then (( MOVE,1,m + d assoc[exp,vpr],P ))
	else if [a exp eq AND] ∨ [a exp eq OR] ∨ [a exp eq NOT]
		then {gensym[],gensym[]}[λl1,l2.compbool[exp,m,l1,NIL,vpr]
		   *(( MOVEI 1 ( QUOTE T )), (JRST,0,l2),l1,(MOVEI 1 0),l2 ) ]
	else if a exp eq COND then comcond[d exp,m,gensym[],vpr]
	else if a exp eq QUOTE then ((MOVEI,1,exp))
	else if at a exp then {length d exp}[λn.complis[d exp,m,vpr]
	     * loadac[1-n,1] * ((SUB,P,(C,0,0,n,n))) * ((CALL,n,(E,a exp)))]
	else if aa exp eq LAMBDA then {length d exp}[λn.complis[d exp,m,vpr]
		* compexp[adda exp,m-n,prup[ada exp,1-m]*vpr]
		* (( SUB,P,( C,0,0,n,n )))

complis[u,m,vpr] ← if n u then NIL
	else compexp[a u,m,vpr] * ((PUSH P 1)) * complis[d u,m-1,vpr]

loadac[n,k] ← if n>0 then NIL else (MOVE,k,n,P).loadac[n+1,k+1]

comcond[u,m,l,vpr] ← if n u then (l)
	else {gensym[]}[λl1.combool[aa u,m,l1,NIL,vpr] * compexp[ada u,m,vpr]
		* ((JRST,l),l1) * comcond[d u,m,l,vpr] ]

combool[p,m,l,flg,vpr] ←
	if at p then compexp[p,m,vpr] * ((if flg then JUMPN else JUMPE,1,l))
	else if a p eq AND then
		if ¬flg then compandor[d p,m,l,NIL,vpr]
		else {gensym[]}[λl1.compandor[d p,m,l1,NIL,vpr]
					 * ((JRST,0,l))	* (l1) ]
	else if a p eq OR then
		if flg then compandor[d p,m,l,T,vpr]
		else {gensym[]}[λl1.compandor[d p,m,l1,T,vpr]
					 * ((JRST,0,l))	* (l1) ]
	else if a p eq NOT then combool[ad p,m,l,¬flg,vpr]
	else compexp[p,m,vpr] * ((if flg then JUMPN else JUMPE,1,l))

compandor[u,m,l,flg,vpr] ← if n u then NIL
	else combool[a u,m,l,flg,vpr] * compandor[d u,m,l,flg,vpr]