1
0

Added tape resizing and more tests.

This commit is contained in:
Jon Michael Aanes 2018-12-28 13:01:42 +01:00
parent 97fdded6f2
commit e14eaa1dd1
2 changed files with 82 additions and 29 deletions

View File

@ -109,8 +109,6 @@
(display (f 1 5)) (display (f 1 5))
(newline) (newline)
(exit)
; Check set! ; Check set!
(set! x 10) (set! x 10)
@ -154,6 +152,24 @@
(display (reverse '(1 2 3 4 5))) (display (reverse '(1 2 3 4 5)))
(newline) (newline)
(newline)
(display "* R5RS: Test if-expressions*")
(newline)
(display "If-then exp!\n\tExpect: 6\n\tGotten: ")
(display (* 3 (if #t 2 0)))
(newline)
(display "If-else exp!\n\tExpect: 0\n\tGotten: ")
(display (* 3 (if #f 2 0)))
(newline)
(display "If-one-branch exp!\n\tExpect: Hello World\n\tGotten: ")
(if #t (display "Hello World\n"))
(display "If-one-branch exp!\n\tExpect: \n\tGotten: ")
(if #f (display "Hello World\n"))
(newline) (newline)
(display "* R5RS: Testing Eval system *") (display "* R5RS: Testing Eval system *")
(newline) (newline)
@ -184,12 +200,14 @@
(display "\n* R5RS: Lexical convention *\n") (display "\n* R5RS: Lexical convention *\n")
(display "Test case-insensitivity (required by R5RS)\n\tExpect: 20 20 20 20")
(define a-variable 20) (define a-variable 20)
(if #f (begin
(display "Test case-insensitivity (required by R5RS)\n\tExpect: 20 20 20 20\n\tGotten: ")
(display a-variable) (display " ") (display a-variable) (display " ")
(display A-variable) (display " ") (display A-variable) (display " ")
(display a-VARiable) (display " ") (display a-VARiable) (display " ")
(display A-VARIABLE) (display A-VARIABLE))
(display "Skipped test!\n"))
; Test environment set ; Test environment set
@ -207,8 +225,11 @@
; Test syntax-rules ; Test syntax-rules
(newline)
(display "* Testing syntax-rules (move to macro once implemented) *")
(newline)
(exit) (display "Attempting to define and using syntax rules.\n\tExpect: #t #f #f #f\n\tGotten: ")
(define-syntax and (define-syntax and
(syntax-rules () (syntax-rules ()
@ -217,8 +238,12 @@
((and test1 test2 ...) ((and test1 test2 ...)
(if test1 (and test2 ...) #f)))) (if test1 (and test2 ...) #f))))
(display (and #t #t)) (newline) (display (and #t #t)) (display " ")
(display (and #f #t)) (newline) (display (and #f #t)) (display " ")
(display (and #f #f)) (newline) (display (and #f #f)) (display " ")
(display (and #t #f)) (newline) (display (and #t #f)) (newline)
; TODO: Use syntax-rules to implement let and or.
(display "")

View File

@ -13,6 +13,8 @@ let /* Booleans */
var DEBUG_PRINT_TAPE : bool := false var DEBUG_PRINT_TAPE : bool := false
var DEBUG_PRINT_PARSED : bool := false var DEBUG_PRINT_PARSED : bool := false
var ALLOW_TAPE_RESIZE : bool := true
var TRIGGERED_EXIT : bool := false var TRIGGERED_EXIT : bool := false
/* Basic utility */ /* Basic utility */
@ -613,7 +615,7 @@ let /* Booleans */
, pos_r: pos } , pos_r: pos }
type vm_tape_tape = array of vm_insn type vm_tape_tape = array of vm_insn
type vm_tape = { length: int type vm_tape = { capacity: int
, filled: int , filled: int
, tape: vm_tape_tape } , tape: vm_tape_tape }
@ -739,19 +741,53 @@ let /* Booleans */
type vm_insn_list_link = { insn: vm_insn, next: vm_insn_list_link } type vm_insn_list_link = { insn: vm_insn, next: vm_insn_list_link }
type vm_insn_list = { first: vm_insn_list_link, last: vm_insn_list_link } type vm_insn_list = { first: vm_insn_list_link, last: vm_insn_list_link }
function insn_list_length (insns: vm_insn_list): int =
let var len := 0
var head := insns.first
in while head <> nil
do ( len := len + 1
; head := head.next )
; len
end
function tape_new (init_size: int): vm_tape = function tape_new (init_size: int): vm_tape =
vm_tape { length = init_size vm_tape { capacity = init_size
, filled = 0 , filled = 0
, tape = vm_tape_tape [init_size] of nil } , tape = vm_tape_tape [init_size] of nil }
function tape_resize(tape: vm_tape, new_size: int) =
let var new_tape_tape := vm_tape_tape [new_size] of nil
in for i := 0 to tape.filled - 1
do new_tape_tape[i] := tape.tape[i]
; tape.tape := new_tape_tape
end
function tape_append(tape: vm_tape, new_insns: vm_insn_list): int = function tape_append(tape: vm_tape, new_insns: vm_insn_list): int =
let var head := new_insns.first let var head := new_insns.first
var index_start := tape.filled var index_start := tape.filled
var index := index_start var index := index_start
var real_tape := tape.tape var new_insns := insn_list_length(new_insns)
/* TODO: Ensure enough space on tape for new additions. */ /* TODO: Ensure enough space on tape for new additions. */
in while head <> nil
do ( real_tape[index] := head.insn /* Check if resize is not required, and then do nothing */
in if tape.filled + new_insns <= tape.capacity
then ()
/* Check if resize is required, and allowed */
else if ALLOW_TAPE_RESIZE
then tape_resize(tape, 2 * (tape.capacity + new_insns))
/* Check if resize is required, but not allowed */
else ( print("Tape with ")
; print(int_to_string(tape.filled))
; print("/")
; print(int_to_string(tape.capacity))
; print(" instructions have exceeded its capacity. Attempt to add ")
; print(int_to_string(new_insns))
; print(" new instructions is impossible.\n"))
; while head <> nil
do ( tape.tape[index] := head.insn
; index := index + 1 ; index := index + 1
; head := head.next ) ; head := head.next )
; tape.filled := index ; tape.filled := index
@ -815,15 +851,6 @@ let /* Booleans */
; insns ; insns
end end
function insn_list_length (insns: vm_insn_list): int =
let var len := 0
var head := insns.first
in while head <> nil
do ( len := len + 1
; head := head.next )
; len
end
var ENV_EMPTY : vm_env := nil_val() var ENV_EMPTY : vm_env := nil_val()
var ENV_STD : vm_env := ENV_EMPTY var ENV_STD : vm_env := ENV_EMPTY
@ -1487,7 +1514,8 @@ let /* Booleans */
var insns_then := compile_rec(ast.val_cdr.val_cdr.val_car, can_tail_call) var insns_then := compile_rec(ast.val_cdr.val_cdr.val_car, can_tail_call)
var insns_else := if ast.val_cdr.val_cdr.val_cdr.typ = type_pair var insns_else := if ast.val_cdr.val_cdr.val_cdr.typ = type_pair
then compile_rec(ast.val_cdr.val_cdr.val_cdr.val_car, can_tail_call) then compile_rec(ast.val_cdr.val_cdr.val_cdr.val_car, can_tail_call)
else compile_rec(VALUE_UNSPECIFIED, can_tail_call) else tail_position_one( atom_to_insn(VALUE_UNSPECIFIED, ast.pos_l, ast.pos_r)
, can_tail_call)
var jump_then := sexp_ast_length(insns_then) + 1 var jump_then := sexp_ast_length(insns_then) + 1
var jump_else := sexp_ast_length(insns_else) + 1 + 1 var jump_else := sexp_ast_length(insns_else) + 1 + 1
@ -1678,7 +1706,7 @@ let /* Booleans */
end end
function optimize_vm_tape (real_tape: vm_tape): vm_tape = function optimize_vm_tape (real_tape: vm_tape): vm_tape =
let var len := real_tape.length let var len := real_tape.capacity
var tape := real_tape.tape var tape := real_tape.tape
in for index := 0 to len - 1 in for index := 0 to len - 1
do if tape[index+0].opcode = OPCODE_PUSH do if tape[index+0].opcode = OPCODE_PUSH