From 96f072cfdb5d1eac3e32dbdb15704b0a32258a37 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 14 Mar 2012 06:53:16 -0700 Subject: Implementing #H((...) ...) read/print syntax for hash tables. * hash.c (print_key_val, hash_print_op): New static functions. (hash_ops): hash_print_op wired in in place of cobj_print_op. * parser.l (HASH_H): New token recognized. * parser.y (HASH_H): New terminal symbol. (hash): New nonterminal symbol. (expr): Acquires hash as a constituent. (hash_from_notation): New static function. * txr.1: Hash syntax described. * txr.vim: Updated. --- hash.c | 41 ++++++++++++++++++++++++++++++++++++++++- parser.l | 5 +++++ parser.y | 22 ++++++++++++++++++++-- txr.1 | 14 +++++++++++++- txr.vim | 2 +- 5 files changed, 79 insertions(+), 5 deletions(-) diff --git a/hash.c b/hash.c index f8bba6bd..bc086ae9 100644 --- a/hash.c +++ b/hash.c @@ -36,6 +36,7 @@ #include "lib.h" #include "gc.h" #include "unwind.h" +#include "stream.h" #include "hash.h" typedef enum hash_flags { @@ -184,6 +185,44 @@ cnum cobj_hash_op(val obj) abort(); } +static val print_key_val(val out, val key, val value) +{ + format(out, lit(" (~s ~s)"), key, value, nao); + return nil; +} + +static void hash_print_op(val hash, val out) +{ + struct hash *h = (struct hash *) hash->co.handle; + int need_space = 0; + + put_string(lit("#H(("), out); + if (h->hash_fun == equal_hash) { + obj_print(equal_based_k, out); + need_space = 1; + } + if (h->flags != hash_weak_none) { + if (need_space) + put_string(lit(" "), out); + switch (h->flags) { + case hash_weak_both: + obj_print(weak_keys_k, out); + /* fallthrough */ + case hash_weak_vals: + obj_print(weak_vals_k, out); + break; + case hash_weak_keys: + obj_print(weak_keys_k, out); + break; + default: + break; + } + } + put_string(lit(")"), out); + maphash(curry_123_23(func_n3(print_key_val), out), hash); + put_string(lit(")"), out); +} + static void hash_mark(val hash) { struct hash *h = (struct hash *) hash->co.handle; @@ -236,7 +275,7 @@ static void hash_mark(val hash) static struct cobj_ops hash_ops = { cobj_equal_op, - cobj_print_op, + hash_print_op, cobj_destroy_free_op, hash_mark, cobj_hash_op diff --git a/parser.l b/parser.l index f7a655db..76ba8203 100644 --- a/parser.l +++ b/parser.l @@ -461,6 +461,11 @@ UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U} return '#'; } +#H { + yylval.lineno = lineno; + return HASH_H; +} + \.\. { yylval.lineno = lineno; return DOTDOT; diff --git a/parser.y b/parser.y index 9a712d64..68fe03f0 100644 --- a/parser.y +++ b/parser.y @@ -53,6 +53,7 @@ static val lit_char_helper(val litchars); static val optimize_text(val text_form); static val choose_quote(val quoted_form); static wchar_t char_from_name(wchar_t *name); +static val hash_from_notation(val notation); static val parsed_spec; @@ -72,7 +73,7 @@ static val parsed_spec; %token UNTIL COLL OUTPUT REPEAT REP SINGLE FIRST LAST EMPTY %token MOD MODLAST DEFINE TRY CATCH FINALLY %token ERRTOK /* deliberately not used in grammar */ -%token HASH_BACKSLASH HASH_SLASH DOTDOT +%token HASH_BACKSLASH HASH_SLASH DOTDOT HASH_H %token NUMBER METANUM @@ -85,7 +86,7 @@ static val parsed_spec; %type clause_parts additional_parts gather_parts additional_gather_parts %type output_clause define_clause try_clause catch_clauses_opt %type line elems_opt elems clause_parts_h additional_parts_h -%type text texts elem var var_op modifiers meta_expr vector +%type text texts elem var var_op modifiers meta_expr vector hash %type list exprs exprs_opt expr out_clauses out_clauses_opt out_clause %type repeat_clause repeat_parts_opt o_line %type o_elems_opt o_elems o_elem o_var rep_elem rep_parts_opt @@ -670,6 +671,9 @@ o_var : IDENT { $$ = list(var_s, intern(string_own($1), nil), vector : '#' list { $$ = rlcp(vector_list($2), $2); } ; +hash : HASH_H list { $$ = rlcp(hash_from_notation($2), num($1)); } + ; + list : '(' exprs ')' { $$ = rl($2, num($1)); } | '(' ')' { $$ = nil; } | '[' exprs ']' { $$ = rl(cons(dwim_s, $2), num($1)); } @@ -724,6 +728,7 @@ expr : IDENT { $$ = rl(intern(string_own($1), nil), | NUMBER { $$ = $1; } | list { $$ = $1; } | vector { $$ = $1; } + | hash { $$ = $1; } | meta_expr { $$ = $1; } | lisp_regex { $$ = cons(regex_compile(rest($1)), rest($1)); @@ -1069,6 +1074,19 @@ static wchar_t char_from_name(wchar_t *name) return L'!'; /* code meaning not found */ } +static val hash_from_notation(val notation) +{ + val hash = hashv(first(notation)); + val iter = rest(notation); + + for (; iter; iter = cdr(iter)) { + val entry = car(iter); + sethash(hash, first(entry), second(entry)); + } + + return hash; +} + val get_spec(void) { return parsed_spec; diff --git a/txr.1 b/txr.1 index b51813d2..45718727 100644 --- a/txr.1 +++ b/txr.1 @@ -4476,6 +4476,7 @@ list, which terminates nonempty lists. Function and variable bindings are dynamically scoped in TXR Lisp. However, closures do capture variables. + .SS Additional Syntax Much of the TXR Lisp syntax has been introduced in the previous sections of the @@ -4542,11 +4543,22 @@ and not a quasiquote. .SS Vectors -.IP #(...) +.IP "#(...)" A hash token followed by a list denotes a vector. For example #(1 2 a) is a three-element vector containing the numbers 1 and 2, and the symbol a. +.SS Hashes + +.IP "#H((*) ( )*)" + +The notation #H followed by a nested list syntax denotes a hash table literal. +The first item in the syntax is a list of keywords. These are the same +keywords as are used when calling the function hash to construct +a hash table. Allowed keywords are: :equal-based, :weak-keys, :weak-values. +An empty list can be specified as nil or (), which defaults to a +hash table basd on the eq function, with no weak semantics. + .SS Nested Quotes Quotes can be nested. What if it is necessary to unquote something in the diff --git a/txr.vim b/txr.vim index 4bf697ef..2baf3ae4 100644 --- a/txr.vim +++ b/txr.vim @@ -120,7 +120,7 @@ syn region txr_bracevar matchgroup=Delimiter start="@[ \t]*[*]\?{" matchgroup=De syn region txr_directive matchgroup=Delimiter start="@[ \t]*(" matchgroup=Delimiter end=")" contains=txr_keyword,txr_string,txr_list,txr_bracket,txr_mlist,txr_mbracket,txr_quasilit,txr_num,txl_ident,txl_regex,txr_string,txr_chr,txr_quote,txr_unquote,txr_splice,txr_dot,txr_dotdot,txr_ncomment,txr_nested_error -syn region txr_list contained matchgroup=Delimiter start="#\?(" matchgroup=Delimiter end=")" contains=txl_keyword,txr_string,txl_regex,txr_num,txl_ident,txr_metanum,txr_list,txr_bracket,txr_mlist,txr_mbracket,txr_quasilit,txr_chr,txr_quote,txr_unquote,txr_splice,txr_dot,txr_dotdot,txr_ncomment,txr_nested_error +syn region txr_list contained matchgroup=Delimiter start="#\?H\?(" matchgroup=Delimiter end=")" contains=txl_keyword,txr_string,txl_regex,txr_num,txl_ident,txr_metanum,txr_list,txr_bracket,txr_mlist,txr_mbracket,txr_quasilit,txr_chr,txr_quote,txr_unquote,txr_splice,txr_dot,txr_dotdot,txr_ncomment,txr_nested_error syn region txr_bracket contained matchgroup=Delimiter start="\[" matchgroup=Delimiter end="\]" contains=txl_keyword,txr_string,txl_regex,txr_num,txl_ident,txr_metanum,txr_list,txr_bracket,txr_mlist,txr_mbracket,txr_quasilit,txr_chr,txr_quote,txr_unquote,txr_splice,txr_dot,txr_dotdot,txr_ncomment,txr_nested_error -- cgit v1.2.3