Added tape resizing and more tests.
This commit is contained in:
parent
97fdded6f2
commit
e14eaa1dd1
47
example.scm
47
example.scm
|
|
@ -109,8 +109,6 @@
|
|||
(display (f 1 5))
|
||||
(newline)
|
||||
|
||||
(exit)
|
||||
|
||||
; Check set!
|
||||
|
||||
(set! x 10)
|
||||
|
|
@ -154,6 +152,24 @@
|
|||
(display (reverse '(1 2 3 4 5)))
|
||||
(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)
|
||||
(display "* R5RS: Testing Eval system *")
|
||||
(newline)
|
||||
|
|
@ -184,12 +200,14 @@
|
|||
|
||||
(display "\n* R5RS: Lexical convention *\n")
|
||||
|
||||
(display "Test case-insensitivity (required by R5RS)\n\tExpect: 20 20 20 20")
|
||||
(define a-variable 20)
|
||||
(display a-variable) (display " ")
|
||||
(display A-variable) (display " ")
|
||||
(display a-VARiable) (display " ")
|
||||
(display A-VARIABLE)
|
||||
(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 "Skipped test!\n"))
|
||||
|
||||
; Test environment set
|
||||
|
||||
|
|
@ -207,8 +225,11 @@
|
|||
|
||||
; 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
|
||||
(syntax-rules ()
|
||||
|
|
@ -217,8 +238,12 @@
|
|||
((and test1 test2 ...)
|
||||
(if test1 (and test2 ...) #f))))
|
||||
|
||||
(display (and #t #t)) (newline)
|
||||
(display (and #f #t)) (newline)
|
||||
(display (and #f #f)) (newline)
|
||||
(display (and #t #t)) (display " ")
|
||||
(display (and #f #t)) (display " ")
|
||||
(display (and #f #f)) (display " ")
|
||||
(display (and #t #f)) (newline)
|
||||
|
||||
; TODO: Use syntax-rules to implement let and or.
|
||||
|
||||
(display "")
|
||||
|
||||
|
|
|
|||
|
|
@ -13,6 +13,8 @@ let /* Booleans */
|
|||
var DEBUG_PRINT_TAPE : bool := false
|
||||
var DEBUG_PRINT_PARSED : bool := false
|
||||
|
||||
var ALLOW_TAPE_RESIZE : bool := true
|
||||
|
||||
var TRIGGERED_EXIT : bool := false
|
||||
|
||||
/* Basic utility */
|
||||
|
|
@ -613,7 +615,7 @@ let /* Booleans */
|
|||
, pos_r: pos }
|
||||
|
||||
type vm_tape_tape = array of vm_insn
|
||||
type vm_tape = { length: int
|
||||
type vm_tape = { capacity: int
|
||||
, filled: int
|
||||
, 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 = { 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 =
|
||||
vm_tape { length = init_size
|
||||
vm_tape { capacity = init_size
|
||||
, filled = 0
|
||||
, 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 =
|
||||
let var head := new_insns.first
|
||||
let var head := new_insns.first
|
||||
var index_start := tape.filled
|
||||
var index := index_start
|
||||
var real_tape := tape.tape
|
||||
var index := index_start
|
||||
var new_insns := insn_list_length(new_insns)
|
||||
/* 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
|
||||
; head := head.next )
|
||||
; tape.filled := index
|
||||
|
|
@ -815,15 +851,6 @@ let /* Booleans */
|
|||
; insns
|
||||
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_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_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)
|
||||
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_else := sexp_ast_length(insns_else) + 1 + 1
|
||||
|
|
@ -1678,7 +1706,7 @@ let /* Booleans */
|
|||
end
|
||||
|
||||
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
|
||||
in for index := 0 to len - 1
|
||||
do if tape[index+0].opcode = OPCODE_PUSH
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user