1
0

Added restricted keywords and quasi-quotation output

This commit is contained in:
Jon Michael Aanes 2018-12-21 21:21:55 +01:00
parent 4029ce9586
commit 97fdded6f2
2 changed files with 71 additions and 8 deletions

View File

@ -104,6 +104,13 @@
(display (x '(2 3 4))) (display (x '(2 3 4)))
(newline) (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! ; Check set!
(set! x 10) (set! x 10)
@ -175,6 +182,15 @@
(display "\n") (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 ; Test environment set
(newline) (newline)

View File

@ -74,6 +74,32 @@ let /* Booleans */
then "" then ""
else substring(str, i_start, i_end - i_start + 1) ) 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 */ /* Source positioning */
type pos = { at_char: int, line_num: int } type pos = { at_char: int, line_num: int }
@ -180,6 +206,14 @@ let /* Booleans */
else if v.typ = type_pair & v.val_cdr = nil else if v.typ = type_pair & v.val_cdr = nil
then error_value_to_string(v) 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 else if v.typ = type_pair & v.val_cdr <> nil & v.val_cdr.typ = type_nil
then let then let
in concat5 ( if req_paren then "(" else "" in concat5 ( if req_paren then "(" else ""
@ -1077,10 +1111,14 @@ let /* Booleans */
; env ; env
end end
function env_to_string (env: vm_env): string = function env_to_string (env: vm_env): string =
value_to_string(env) 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 ****/ /**** Compilation ****/
@ -1296,10 +1334,6 @@ let /* Booleans */
; single_insn(atom_to_insn(VALUE_UNSPECIFIED, ast.pos_l, ast.pos_r)) ) ; single_insn(atom_to_insn(VALUE_UNSPECIFIED, ast.pos_l, ast.pos_r)) )
end 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 = function compile_define (ast: sexp_ast): vm_insn_list =
/* Standard define form: (define <variable> <expression>) */ /* Standard define form: (define <variable> <expression>) */
@ -1311,8 +1345,20 @@ let /* Booleans */
var pos_l := ast.pos_l var pos_l := ast.pos_l
var pos_r := ast.pos_r var pos_r := ast.pos_r
/* Create list of instructions */
in app_insn (insns_body, OPCODE_SETG, 0, symbol, pos_l, pos_r) 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) ; 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 ; insns_body
end end
@ -1392,8 +1438,7 @@ let /* Booleans */
else if datum.val_car.typ = type_symbol else if datum.val_car.typ = type_symbol
& datum.val_car.val_s = "quasiquote" & datum.val_car.val_s = "quasiquote"
then ( compile_error("TODO: Nested quasiquote", datum) then nil
; nil )
else else
let var insns_car := compile_quasiquote(datum.val_car) let var insns_car := compile_quasiquote(datum.val_car)
@ -1464,7 +1509,9 @@ let /* Booleans */
/* Syntax define statements */ /* Syntax define statements */
else if ast.val_car <> nil & ast.val_car.val_s = "define-syntax" 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 */ /* Syntax rules expression */
else if ast.val_car <> nil & ast.val_car.val_s = "syntax-rules" else if ast.val_car <> nil & ast.val_car.val_s = "syntax-rules"