Added tape resizing and more tests.

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 " ")
+(if #f (begin
-(display A-variable) (display " ")
+  (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 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 #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)
 
+; TODO: Use syntax-rules to implement let and or.
+
+(display "")
+

tigerscheme.tig

@@ -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
          var index_start := tape.filled
          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. */
-     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