diff options
| -rw-r--r-- | README.md | 7 | ||||
| -rw-r--r-- | example.txt | 66 | ||||
| -rw-r--r-- | plusplus.s | 326 |
3 files changed, 395 insertions, 4 deletions
@@ -28,11 +28,10 @@ said to be in the 'branch delay slot'. For example, this does not loop endlessly even though the body of `main_loop_delay` seems empty: ``` - lui $2,0xf - ori $5,0xffff + lui $1,0xf main_loop_delay: - bne $2,$0,main_loop_delay - addiu $2,-1 + bne $1,$0,main_loop_delay + addiu $1,-1 ``` Also note that when the file ends with a branch/jump, a `nop` *must* follow to diff --git a/example.txt b/example.txt new file mode 100644 index 0000000..b83c606 --- /dev/null +++ b/example.txt @@ -0,0 +1,66 @@ +(data (Tuple a b) + (Tuple a b)) +(data (List a) + Nil + (Cons a (List a))) +(type String (List Char)) + +(fun readline : (List Char) + (case getc + '\n' -> Nil + c -> c : readline)) + +(fun length (xs : (List a)) : Int + (length_acc 0 xs)) +(fun length_acc (n : Int) (xs : (List a)) : Int + (case xs + Nil -> n + Cons _ xs -> length_acc (+ n 1) xs)) + +(data Type + (Type String) + (TypeVar String) + (TypeApp Type Type)) + +(data ConstructorDef + (ConstructorDef String (List Type))) + +(data BasicValue + (BVInt Int) + (BVChar Char)) + +(data Pattern + WildCard + (BasicValuePattern BasicValue) + (IdentPattern String) + (ConstructorPattern String (List Pattern))) + +(data CaseAlternative + (CaseAlternative Pattern Expression)) + +(data Expression + (Ident String) + (Case Expression (List CaseAlternative)) + (ExpApp Expression Expression)) + +(data Definition + (DataDef String (List String) (List ConstructorDef)) + (FunDef String (List (Tuple String Type)) Type Expression)) + +(fun list_ast : Definition + (DataDef + (Cons 'L' (Cons 'i' (Cons 's' (Cons 't' Nil)))) + (Cons (Cons 'a' Nil) Nil) + (Cons (ConstructorDef (Cons 'N' (Cons 'i' (Cons 'l' Nil))) Nil) + (Cons (ConstructorDef (Cons 'C' (Cons 'o' (Cons 'n' (Cons 's' Nil)))) (Cons (TypeVar (Cons 'a' Nil)) (Cons (TypeApp (Type (Cons 'L' (Cons 'i' (Cons 's' (Cons 't' Nil))))) (TypeVar (Cons 'a' Nil))) Nil))) + Nil)))) +(fun length_acc_ast : Definition + (FunDef + (Cons 'l' (Cons 'e' (Cons 'n' (Cons 'g' (Cons 't' (Cons 'h' (Cons '_' (Cons 'a' (Cons 'c' (Cons 'c' Nil)))))))))) + (Cons (Tuple (Cons 'n' Nil) (Type (Cons 'I' (Cons 'n' (Cons 't' Nil))))) + (Cons (Tuple (Cons 'x' (Cons 's' Nil)) (TypeApp (Type (Cons 'L' (Cons 'i' (Cons 's' (Cons 't' Nil))))) (TypeVar (Cons 'a' Nil)))) + Nil)) + (Case (Ident (Cons 'x' (Cons 's' Nil))) + (Cons (CaseAlternative (ConstructorPattern (Cons 'N' (Cons 'i' (Cons 'l' Nil))) Nil) (Ident (Cons 'n' Nil))) + (Cons (CaseAlternative (ConstructorPattern (Cons 'C' (Cons 'o' (Cons 'n' (Cons 's' Nil)))) (Cons WildCard (Cons (IdentPattern (Cons 'x' (Cons 's' Nil))) Nil))) ()) + Nil))))) diff --git a/plusplus.s b/plusplus.s new file mode 100644 index 0000000..d347a7f --- /dev/null +++ b/plusplus.s @@ -0,0 +1,326 @@ +#define $hp $gp +#define $print_back $s0 +#define $print_front $s1 +#define $eval_back $s2 +#define $eval_front $s3 + + .data + .align 2 +CONS: + .word 2 # arity + .word 4 # name + .ascii "Cons" + + .align 2 +NIL: + .word 0 # arity + .word 3 # name + .ascii "Nil" + + .align 2 +INT: + .word 0x100 # arity + .word 3 # name + .ascii "Int" + + .align 2 +PRINTROOT: + .word root + .word 0 # to be filled in +EVALROOT: + .word root + .word 0 # to be filled in + + .align 2 +heap: + + .text +main: + la $gp,heap + + # NIL @ hp[0] + la $t0,NIL+2 + sw $t0,($gp) + # INT 5 @ hp[4] + la $t0,INT+2 + sw $t0,4($gp) + ori $t0,$0,5 + sw $t0,8($gp) + # x = cons (INT 5) NIL @ hp[12] + la $t0,cons + sw $t0,12($gp) + addi $t0,$gp,4 + sw $t0,16($gp) + addi $t0,$gp,0 + sw $t0,20($gp) + # y = plusplus x x @ hp[24] + la $t0,plusplus + sw $t0,24($gp) + addi $t0,$gp,12 + sw $t0,28($gp) + sw $t0,32($gp) + # z = plusplus y y @ hp[36] + la $t0,plusplus + sw $t0,36($gp) + addi $t0,$gp,24 + sw $t0,40($gp) + sw $t0,44($gp) + # a = plusplus z z @ hp[48] + la $t0,plusplus + sw $t0,48($gp) + addi $t0,$gp,36 + sw $t0,52($gp) + sw $t0,56($gp) + + la $s0,PRINTROOT + addi $s1,$gp,48 # node to eval + sw $s1,4($s0) + + jal driver + addi $gp,$gp,60 + + 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,INT+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,indir + 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 +root: + 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 +indir: + # indirections are handled in eval + la $a0,indir_error + li $v0,4 # print_string + syscall + break 0 + + .word 0x1 # strict in 1st argument + .word 2 # arity +plusplus: + lw $t0,4($s3) # xs + lw $t1,($t0) + la $t2,NIL+2 + beq $t1,$t2,plusplus_nil + nop + # TODO check heap space + lw $t1,4($t0) # hd xs + lw $t2,8($t0) # tl xs + lw $t3,8($s3) # ys + # Build node: (++ (tl xs) ys) + la $t0,plusplus + sw $t0,($gp) + sw $t2,4($gp) + sw $t3,8($gp) + # Build node: CONS (hd xs) (++ (tl xs) ys) + la $t0,CONS+2 + sw $t0,12($gp) + sw $t1,16($gp) + sw $gp,20($gp) + # Update front and heap pointers + addi $s3,$gp,12 + j eval + addi $gp,$gp,24 +plusplus_nil: + # indirect to second argument + la $t0,indir + sw $t0,($s3) + lw $t0,8($s3) + sw $t0,4($s3) + addi $s3,$t0,0 + j eval + nop + + .word 0x3 # strict in 1st and 2nd argument + .word 2 # arity +cons: + # TODO check heap space + # Create new CONS node with same arguments + la $t0,CONS+2 + lw $t1,4($s3) + lw $t2,8($s3) + sw $t0,($gp) + sw $t1,4($gp) + sw $t2,8($gp) + # Overwrite original cons node with indirection + la $t0,indir + sw $t0,($s3) + sw $gp,4($s3) + # Update front and heap pointers + addi $s3,$gp,0 + j eval + addi $gp,$gp,12 |