From 97fdded6f2c07365a69c8383efb38001f74a8a4e Mon Sep 17 00:00:00 2001
From: Jon Michael Aanes <jonjmaa@gmail.com>
Date: Fri, 21 Dec 2018 21:21:55 +0100
Subject: [PATCH] Added restricted keywords and quasi-quotation output

---
 example.scm     | 16 +++++++++++++
 tigerscheme.tig | 63 ++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 71 insertions(+), 8 deletions(-)

diff --git a/example.scm b/example.scm
index 5ac1a58..8fca8b7 100644
--- a/example.scm
+++ b/example.scm
@@ -104,6 +104,13 @@
 (display (x '(2 3 4)))
 (newline)
 
+(display "Testing quasi-notation advanced!\n\tExpect: (1 `(,a ,x 3) 4 5)\n\tGotten: ")
+(define (f x y) `(,x `(,a ,x 3) 4 ,y))
+(display (f 1 5))
+(newline)
+
+(exit)
+
 ; Check set!
 
 (set! x 10)
@@ -175,6 +182,15 @@
 (display "\n")
 
 
+(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)
+
 ; Test environment set
 
 (newline)
diff --git a/tigerscheme.tig b/tigerscheme.tig
index 96add10..2c4a208 100644
--- a/tigerscheme.tig
+++ b/tigerscheme.tig
@@ -74,6 +74,32 @@ let /* Booleans */
         then ""
         else substring(str, i_start, i_end - i_start + 1) )
 
+    /* Map */
+
+    type map_link = { key : string, value : string, next: map_link }
+    type map = { first : map_link }
+    function map_add (map: map, key: string, value: string) =
+      map.first := map_link { key = key, value = value, next = map.first }
+    function map_find (map: map, key: string, default: string): string =
+      let function link_find (link: map_link): string =
+            if link = nil
+              then default
+
+            else if link.key = key
+              then link.value
+
+            else link_find(link.next)
+      in link_find(map.first)
+      end
+
+    var SYMBOL_TO_SHORT_REPR := let var M := map { first = nil }
+                                in map_add(M, "quote",            "'")
+                                 ; map_add(M, "quasiquote",       "`")
+                                 ; map_add(M, "unquote",          ",")
+                                 ; map_add(M, "unquote-splicing", ",@")
+                                 ; M
+                                end
+
     /* Source positioning */
 
     type pos = { at_char: int, line_num: int }
@@ -180,6 +206,14 @@ let /* Booleans */
             else if v.typ = type_pair & v.val_cdr = nil
               then error_value_to_string(v)
 
+            else if v.typ = type_pair
+                  & v.val_car.typ   = type_symbol
+                  & map_find(SYMBOL_TO_SHORT_REPR, v.val_car.val_s, "") <> ""
+                  & v.val_cdr.typ   = type_pair
+                  & v.val_cdr.val_cdr.typ = type_nil
+              then concat(map_find(SYMBOL_TO_SHORT_REPR, v.val_car.val_s, "")
+                         , value_to_string(v.val_cdr.val_car))
+
             else if v.typ = type_pair & v.val_cdr <> nil & v.val_cdr.typ = type_nil
                then let
                     in concat5 ( if req_paren then "(" else ""
@@ -1077,10 +1111,14 @@ let /* Booleans */
         ; env
        end
 
-
    function env_to_string (env: vm_env): string =
      value_to_string(env)
 
+   function is_reserved (symbol: string): bool =
+       symbol = "let"    | symbol = "let*" | symbol = "letrec"
+     | symbol = "lambda" | symbol = "do"   | symbol = "quote"
+     | symbol = "quasiquote" | symbol = "unquote" | symbol = "unquote-splicing"
+     | symbol = "define" | symbol = "define-syntax"
 
    /**** Compilation ****/
 
@@ -1296,10 +1334,6 @@ let /* Booleans */
                    ; single_insn(atom_to_insn(VALUE_UNSPECIFIED, ast.pos_l, ast.pos_r)) )
            end
 
-         function compile_define_syntax (ast: sexp_ast): vm_insn_list =
-           ( compile_error("Please do not compile define-syntax", ast)
-           ; single_insn(atom_to_insn(VALUE_UNSPECIFIED, ast.pos_l, ast.pos_r)))
-
          function compile_define (ast: sexp_ast): vm_insn_list =
 
            /* Standard define form: (define <variable> <expression>) */
@@ -1311,8 +1345,20 @@ let /* Booleans */
                       var pos_l := ast.pos_l
                       var pos_r := ast.pos_r
 
+                  /* Create list of instructions */
                  in app_insn (insns_body, OPCODE_SETG, 0, symbol, pos_l, pos_r)
                   ; app_insn2(insns_body, OPCODE_PUSH, VALUE_UNSPECIFIED, pos_l, pos_r)
+
+                  /* Check variable is not reserved */
+                  ; if is_reserved(symbol)
+                    then compile_error(concat5( "Attempting to define \""
+                                              , symbol
+                                              , "\".  This is not allowed, as \""
+                                              , symbol
+                                              , "\" is a reserved keyword.")
+                                      , ast)
+
+                  /* Return */
                   ; insns_body
                  end
 
@@ -1392,8 +1438,7 @@ let /* Booleans */
 
            else if datum.val_car.typ   = type_symbol
                  & datum.val_car.val_s = "quasiquote"
-             then ( compile_error("TODO: Nested quasiquote", datum)
-                  ; nil )
+             then nil
 
            else
              let var insns_car := compile_quasiquote(datum.val_car)
@@ -1464,7 +1509,9 @@ let /* Booleans */
 
              /* Syntax define statements */
            else if ast.val_car <> nil & ast.val_car.val_s = "define-syntax"
-             then compile_define_syntax(ast)
+             then ( compile_error("Please do not compile define-syntax", ast)
+                  ; single_insn(atom_to_insn(VALUE_UNSPECIFIED, ast.pos_l, ast.pos_r)))
+
 
              /* Syntax rules expression */
            else if ast.val_car <> nil & ast.val_car.val_s = "syntax-rules"