.data

	.align 3
_cINT:
	.word	0x100	# arity
	.word	3	# name
	.ascii	"Int"

	.align 2
PRINTROOT:
	.word	_nroot
	.word	0	# to be filled in
EVALROOT:
	.word	_nroot
	.word	0	# to be filled in

	.align 2
heap:

	.text
main:
	la	$gp,heap

	la	$t0,__main_ntest
	sw	$t0,($gp)

	la	$s0,PRINTROOT
	ori	$s1,$gp,0
	sw	$s1,4($s0)

	jal	driver
	addi	$gp,$gp,8

	li	$a0,'\n'
	li	$v0,11	# print_char
	syscall
	li	$v0,10	# exit
	syscall

driver:
	addi	$sp,$sp,-4
	sw	$ra,($sp)
print:
	lw	$t0,($s1)
	andi	$t0,$t0,2
	bne	$t0,$0,print_hnf
	nop
	la	$s2,EVALROOT
	addi	$s3,$s1,0
	sw	$s3,4($s2)
	jal	eval
	nop
	addi	$s1,$s3,0
print_hnf:
	lw	$t0,($s1)
	la	$t1,_cINT+2
	beq	$t0,$t1,print_int
	lw	$t1,2($t0)	# name length
	addi	$t2,$t0,6	# name
	add	$t1,$t1,$t2
print_cons:
	lw	$t3,-2($t0)	# arity
	beq	$t3,$0,print_cons_no_paren
	li	$a0,'('
	li	$v0,11	# print_char
	syscall
print_cons_no_paren:
	lb	$a0,($t2)
	li	$v0,11	# print_char
	syscall
	addi	$t2,$t2,1
	bne	$t1,$t2,print_cons_no_paren
	nop
	beq	$t3,$0,print_rewind
	li	$a0,' '
	li	$v0,11	# print_char
	syscall
	# continue with printing the arguments
	addi	$t2,$s0,1
	addi	$s0,$s1,0
	lw	$s1,4($s1)
	sw	$t2,4($s0)
	j	print
	nop

print_int:
	lw	$a0,4($s1)
	li	$v0,1	# print_int
	syscall
	j	print_rewind
	nop

print_rewind:
	la	$t5,PRINTROOT
	beq	$s0,$t5,print_rewind_root
	addi	$t0,$s0,0
	addi	$t1,$s0,0	# argument pointer
	lw	$t2,($t0)
	lw	$t2,-2($t2)	# arity
print_rewind_loop:
	addi	$t1,$t1,4
	lw	$t3,($t1)
	andi	$t4,$t3,1
	beq	$t4,$0,print_rewind_loop
	addi	$t2,$t2,-1
	# we have found the argument that was being printed
	beq	$t2,$0,print_rewind_done
	# there is a next argument to print
	li	$a0,' '
	li	$v0,11	# print_char
	syscall
	sw	$s1,($t1)
	lw	$s1,4($t1)
	sw	$t3,4($t1)
	j	print
	nop
print_rewind_done:
	# this node is fully printed; go up to the parent
	li	$a0,')'
	li	$v0,11	# print_char
	syscall
	xori	$s0,$t3,1
	sw	$s1,($t1)
	addi	$s1,$t0,0
	j	print_rewind
	nop
print_rewind_root:
	lw	$ra,($sp)
	jr	$ra
	addi	$sp,$sp,4

eval:
	lw	$t0,($s3)
	# Exit early in case of hnf
	andi	$t1,$t0,2
	bne	$t1,$0,eval_rewind
	# Walk through indirections
	la	$t1,_nindir
	bne	$t0,$t1,eval_indir_done
	addi	$t2,$s3,0
eval_indir:
	lw	$s3,4($s3)
	lw	$t0,($s3)
	beq	$t0,$t1,eval_indir
	sw	$s3,4($t2)	# update original indir; optimizes chained indirs
	# Check again for hnf
	andi	$t1,$t0,2
	bne	$t1,$0,eval_rewind
	nop
eval_indir_done:
	lw	$t1,-4($t0)	# load arity
	lw	$t2,-8($t0)	# strictness
	addi	$t3,$s3,4	# argument pointer
eval_arg_loop:
	beq	$t1,$0,eval_args_done
	andi	$t4,$t2,1
	bne	$t4,$0,eval_arg_strict
	srl	$t2,$t2,1
	addi	$t1,$t1,-1
	j	eval_arg_loop
	addi	$t3,$t3,4
eval_arg_strict:
	lw	$t4,($t3)
	lw	$t4,($t4)
	andi	$t4,$t4,2
	beq	$t4,$0,eval_arg
	addi	$t1,$t1,-1
	j	eval_arg_loop
	addi	$t3,$t3,4
eval_arg:
	lw	$t4,($t3)	# reverse pointers
	addi	$s2,$s2,1
	sw	$s2,($t3)
	addi	$s2,$s3,0
	addi	$s3,$t4,0
	j	eval		# continue evaluating argument
	nop
eval_args_done:
	jr	$t0
	nop

eval_rewind:
	la	$t4,EVALROOT
	beq	$s2,$t4,eval_rewind_root
	addi	$t0,$s2,0
	addi	$t1,$s2,0
eval_rewind_loop:
	addi	$t1,$t1,4
	lw	$t2,($t1)
	andi	$t3,$t2,1
	beq	$t3,$0,eval_rewind_loop
	nop
	xori	$s2,$t2,1
	sw	$s3,($t1)
	addi	$s3,$t0,0
	j	eval
	nop
eval_rewind_root:
	jr	$ra
	nop

	.data
cycle_error:
	.asciiz	"error: cycle in spine detected\n"
	.text
	.word	0	# strictness
	.word	1	# arity
_nroot:
	la	$a0,cycle_error
	li	$v0,4	# print_string
	syscall
	break	0

	.data
indir_error:
	.asciiz	"error: indirection evaluated\n"
	.text
	.word	0x1	# strictness
	.word	1	# arity
_nindir:
	# indirections are handled in eval
	la	$a0,indir_error
	li	$v0,4	# print_string
	syscall
	break	0