From 3345a52824c2ae0e6ffe64ec7e07609d1bc362ef Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 24 Oct 2012 14:50:16 -0400 Subject: [PATCH 3/3] Implement SRFI-105 curly infix expressions. * libguile/private-options.h: Add SCM_CURLY_INFIX_P macro, and increment SCM_N_READ_OPTIONS. * libguile/read.c (sym_nfx, sym_bracket_list, sym_bracket_apply): New symbols. (scm_read_opts): Add curly-infix reader option. (scm_t_read_opts): Add curly_infix_p and neoteric_p fields. (init_read_options): Initialize new fields. (CHAR_IS_DELIMITER): Add '{', '}', '[', and ']' as delimiters if curly_infix_p is set. (set_port_square_brackets_p, set_port_curly_infix_p): New functions. (scm_read_expression_1): New internal static function, which contains the code that was previously in 'scm_read_expression'. Handle curly braces when curly_infix_p is set. If curly_infix_p is set and square_brackets_p is unset, follow the Kawa convention: [...] => ($bracket-list$ ...) (scm_read_expression): New function body to handle neoteric expressions where appropriate. (scm_read_shebang): Handle the new reader directives: '#!curly-infix' and the non-standard '#!curly-infix-and-bracket-lists'. (scm_read_sexp): Handle curly infix lists. * module/ice-9/boot-9.scm (%cond-expand-features): Add srfi-105 feature identifier. * doc/ref/srfi-modules.texi (SRFI-105): Add stub doc for SRFI-105. * doc/ref/api-evaluation.texi (Scheme Read): Add documentation for the 'curly-infix' read option, and the '#!curly-infix' and '#!curly-infix-and-bracket-lists' reader directives. * doc/ref/api-options.texi (Runtime Options): Add 'curly-infix' to the list of read options. * test-suite/Makefile.am: Add tests/srfi-105.test. * test-suite/tests/srfi-105.test: New file. --- doc/ref/api-evaluation.texi | 7 +- doc/ref/api-options.texi | 1 + doc/ref/srfi-modules.texi | 51 ++++++++++ libguile/private-options.h | 3 +- libguile/read.c | 221 ++++++++++++++++++++++++++++++++++++++-- module/ice-9/boot-9.scm | 3 +- test-suite/Makefile.am | 1 + test-suite/tests/srfi-105.test | 131 ++++++++++++++++++++++++ 8 files changed, 404 insertions(+), 14 deletions(-) create mode 100644 test-suite/tests/srfi-105.test diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi index c7bf97a..2c26ae8 100644 --- a/doc/ref/api-evaluation.texi +++ b/doc/ref/api-evaluation.texi @@ -338,12 +338,17 @@ r6rs-hex-escapes no Use R6RS variable-length character and string hex escape square-brackets yes Treat `[' and `]' as parentheses, for R6RS compatibility. hungry-eol-escapes no In strings, consume leading whitespace after an escaped end-of-line. +curly-infix no Support SRFI-105 curly infix expressions. @end smalllisp Note that Guile also includes a preliminary mechanism for setting read options on a per-port basis. For instance, the @code{case-insensitive} read option is set (or unset) on the port when the reader encounters the -@code{#!fold-case} or @code{#!no-fold-case} reader directives. There is +@code{#!fold-case} or @code{#!no-fold-case} reader directives. +Similarly, the @code{#!curly-infix} reader directive sets the +@code{curly-infix} read option on the port, and the +@code{#!curly-infix-and-bracket-lists} sets @code{curly-infix} and +unsets @code{square-brackets} on the port (@pxref{SRFI-105}). There is currently no other way to access or set the per-port read options. The boolean options may be toggled with @code{read-enable} and diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi index f635978..1734318 100644 --- a/doc/ref/api-options.texi +++ b/doc/ref/api-options.texi @@ -390,6 +390,7 @@ r6rs-hex-escapes no Use R6RS variable-length character and string hex escape square-brackets yes Treat `[' and `]' as parentheses, for R6RS compatibility. hungry-eol-escapes no In strings, consume leading whitespace after an escaped end-of-line. +curly-infix no Support SRFI-105 curly infix expressions. scheme@@(guile-user) [1]> (read-enable 'case-insensitive) $2 = (square-brackets keywords #f case-insensitive positions) scheme@@(guile-user) [1]> ,q diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index ba701a2..f50e4df 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -54,6 +54,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-69:: Basic hash tables. * SRFI-88:: Keyword objects. * SRFI-98:: Accessing environment variables. +* SRFI-105:: Curly-infix expressions. @end menu @@ -4469,6 +4470,56 @@ Returns the names and values of all the environment variables as an association list in which both the keys and the values are strings. @end deffn +@node SRFI-105 +@subsection SRFI-105 Curly-infix expressions. +@cindex SRFI-105 +@cindex curly-infix +@cindex curly-infix-and-bracket-lists + +Guile's built-in reader includes support for SRFI-105 curly-infix +expressions. See @uref{http://srfi.schemers.org/srfi-105/srfi-105.html, +the specification of SRFI-105}. Some examples: + +@example +@{n <= 5@} @result{} (<= n 5) +@{a + b + c@} @result{} (+ a b c) +@{a * @{b + c@}@} @result{} (* a (+ b c)) +@{(- a) / b@} @result{} (/ (- a) b) +@{-(a) / b@} @result{} (/ (- a) b) as well +@{(f a b) + (g h)@} @result{} (+ (f a b) (g h)) +@{f(a b) + g(h)@} @result{} (+ (f a b) (g h)) as well +@{f[a b] + g(h)@} @result{} (+ ($bracket-apply$ f a b) (g h)) +'@{a + f(b) + x@} @result{} '(+ a (f b) x) +@{length(x) >= 6@} @result{} (>= (length x) 6) +@{n-1 + n-2@} @result{} (+ n-1 n-2) +@{n * factorial@{n - 1@}@} @result{} (* n (factorial (- n 1))) +@{@{a > 0@} and @{b >= 1@}@} @result{} (and (> a 0) (>= b 1)) +@{f@{n - 1@}(x)@} @result{} ((f (- n 1)) x) +@{a . z@} @result{} ($nfx$ a . z) +@{a + b - c@} @result{} ($nfx$ a + b - c) +@end example + +To enable curly-infix expressions within a file, place the reader +directive @code{#!curly-infix} before the first use of curly-infix +notation. To globally enable curly-infix expressions in Guile's reader, +set the @code{curly-infix} read option. + +Guile also implements the following non-standard extension to SRFI-105: +if @code{curly-infix} is enabled but the @code{square-brackets} read +option is turned off, then lists within square brackets are read as +normal lists but with the special symbol @code{$bracket-list$} added to +the front. To enable this combination of read options within a file, +use the reader directive @code{#!curly-infix-and-bracket-lists}. For +example: + +@example +[a b] @result{} ($bracket-list$ a b) +[a . b] @result{} ($bracket-list$ a . b) +@end example + + +For more information on reader options, @xref{Scheme Read}. + @c srfi-modules.texi ends here @c Local Variables: diff --git a/libguile/private-options.h b/libguile/private-options.h index 9d2d43c..ed0f314 100644 --- a/libguile/private-options.h +++ b/libguile/private-options.h @@ -67,7 +67,8 @@ SCM_INTERNAL scm_t_option scm_read_opts[]; #define SCM_R6RS_ESCAPES_P scm_read_opts[4].val #define SCM_SQUARE_BRACKETS_P scm_read_opts[5].val #define SCM_HUNGRY_EOL_ESCAPES_P scm_read_opts[6].val +#define SCM_CURLY_INFIX_P scm_read_opts[7].val -#define SCM_N_READ_OPTIONS 6 +#define SCM_N_READ_OPTIONS 7 #endif /* PRIVATE_OPTIONS */ diff --git a/libguile/read.c b/libguile/read.c index 1ec7325..498887f 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -63,6 +63,11 @@ SCM_SYMBOL (scm_keyword_prefix, "prefix"); SCM_SYMBOL (scm_keyword_postfix, "postfix"); SCM_SYMBOL (sym_nil, "nil"); +/* SRFI-105 curly infix expression support */ +SCM_SYMBOL (sym_nfx, "$nfx$"); +SCM_SYMBOL (sym_bracket_list, "$bracket-list$"); +SCM_SYMBOL (sym_bracket_apply, "$bracket-apply$"); + scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "copy", 0, "Copy source code expressions." }, @@ -78,6 +83,8 @@ scm_t_option scm_read_opts[] = { "Treat `[' and `]' as parentheses, for R6RS compatibility."}, { SCM_OPTION_BOOLEAN, "hungry-eol-escapes", 0, "In strings, consume leading whitespace after an escaped end-of-line."}, + { SCM_OPTION_BOOLEAN, "curly-infix", 0, + "Support SRFI-105 curly infix expressions."}, { 0, }, }; @@ -98,6 +105,8 @@ struct t_read_opts { unsigned int r6rs_escapes_p : 1; unsigned int square_brackets_p : 1; unsigned int hungry_eol_escapes_p : 1; + unsigned int curly_infix_p : 1; + unsigned int neoteric_p : 1; }; typedef struct t_read_opts scm_t_read_opts; @@ -214,7 +223,9 @@ scm_i_read_hash_procedures_set_x (SCM value) #define CHAR_IS_DELIMITER(c) \ (CHAR_IS_R5RS_DELIMITER (c) \ - || (((c) == ']' || (c) == '[') && opts->square_brackets_p)) + || (((c) == ']' || (c) == '[') && (opts->square_brackets_p \ + || opts->curly_infix_p)) \ + || (((c) == '}' || (c) == '{') && opts->curly_infix_p)) /* Exponent markers, as defined in section 7.1.1 of R5RS, ``Lexical Structure''. */ @@ -402,7 +413,10 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) { int c; SCM tmp, tl, ans = SCM_EOL; - const int terminating_char = ((chr == '[') ? ']' : ')'); + const int curly_list_p = (chr == '{') && opts->curly_infix_p; + const int terminating_char = ((chr == '{') ? '}' + : ((chr == '[') ? ']' + : ')')); /* Need to capture line and column numbers here. */ long line = SCM_LINUM (port); @@ -434,7 +448,8 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) { SCM new_tail; - if (c == ')' || (c == ']' && opts->square_brackets_p)) + if (c == ')' || (c == ']' && opts->square_brackets_p) + || ((c == '}' || c == ']') && opts->curly_infix_p)) scm_i_input_error (FUNC_NAME, port, "in pair: mismatched close paren: ~A", scm_list_1 (SCM_MAKE_CHAR (c))); @@ -451,7 +466,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) if (terminating_char != c) scm_i_input_error (FUNC_NAME, port, "in pair: missing close paren", SCM_EOL); - goto exit; + break; } new_tail = scm_cons (tmp, SCM_EOL); @@ -459,7 +474,53 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) tl = new_tail; } - exit: + if (curly_list_p) + { + int len = scm_ilength (ans); + + /* (len == 0) case is handled above */ + if (len == 1) + /* Return directly to avoid re-annotating the element's source + location with the position of the outer brace. Also, it + might not be possible to annotate the element. */ + return scm_car (ans); /* {e} => e */ + else if (len == 2) + ; /* Leave the list unchanged: {e1 e2} => (e1 e2) */ + else if (len >= 3 && (len & 1)) + { + SCM op = scm_cadr (ans); + + /* Verify that all infix operators (odd indices) are 'equal?' */ + for (tl = scm_cdddr (ans); ; tl = scm_cddr (tl)) + { + if (scm_is_null (tl)) + { + /* Convert simple curly-infix list to prefix: + {a b ...} => ( a b ...) */ + tl = ans; + while (scm_is_pair (scm_cdr (tl))) + { + tmp = scm_cddr (tl); + SCM_SETCDR (tl, tmp); + tl = tmp; + } + ans = scm_cons (op, ans); + break; + } + else if (scm_is_false (scm_equal_p (op, scm_car (tl)))) + { + /* Mixed curly-infix list: {e ...} => ($nfx$ e ...) */ + ans = scm_cons (sym_nfx, ans); + break; + } + } + } + else + /* Mixed curly-infix (possibly improper) list: + {e . tail} => ($nfx$ e . tail) */ + ans = scm_cons (sym_nfx, ans); + } + return maybe_annotate_source (ans, port, opts, line, column); } #undef FUNC_NAME @@ -1278,6 +1339,10 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port) static void set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts, int value); +static void set_port_square_brackets_p (SCM port, scm_t_read_opts *opts, + int value); +static void set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, + int value); static SCM scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) @@ -1304,6 +1369,13 @@ scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) set_port_case_insensitive_p (port, opts, 1); else if (0 == strcmp ("no-fold-case", name)) set_port_case_insensitive_p (port, opts, 0); + else if (0 == strcmp ("curly-infix", name)) + set_port_curly_infix_p (port, opts, 1); + else if (0 == strcmp ("curly-infix-and-bracket-lists", name)) + { + set_port_curly_infix_p (port, opts, 1); + set_port_square_brackets_p (port, opts, 0); + } else break; @@ -1600,8 +1672,8 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, #undef FUNC_NAME static SCM -scm_read_expression (SCM port, scm_t_read_opts *opts) -#define FUNC_NAME "scm_read_expression" +scm_read_expression_1 (SCM port, scm_t_read_opts *opts) +#define FUNC_NAME "scm_read_expression_1" { while (1) { @@ -1617,10 +1689,42 @@ scm_read_expression (SCM port, scm_t_read_opts *opts) case ';': (void) scm_read_semicolon_comment (chr, port); break; + case '{': + if (opts->curly_infix_p) + { + if (opts->neoteric_p) + return scm_read_sexp (chr, port, opts); + else + { + SCM expr; + + /* Enable neoteric expressions within curly braces */ + opts->neoteric_p = 1; + expr = scm_read_sexp (chr, port, opts); + opts->neoteric_p = 0; + return expr; + } + } + else + return scm_read_mixed_case_symbol (chr, port, opts); case '[': - if (!opts->square_brackets_p) - return (scm_read_mixed_case_symbol (chr, port, opts)); - /* otherwise fall through */ + if (opts->square_brackets_p) + return scm_read_sexp (chr, port, opts); + else if (opts->curly_infix_p) + { + /* The syntax of neoteric expressions requires that '[' be + a delimiter when curly-infix is enabled, so it cannot + be part of an unescaped symbol. We might as well do + something useful with it, so we adopt Kawa's convention: + [...] => ($bracket-list$ ...) */ + long line = SCM_LINUM (port); + int column = SCM_COL (port) - 1; + return maybe_annotate_source + (scm_cons (sym_bracket_list, scm_read_sexp (chr, port, opts)), + port, opts, line, column); + } + else + return scm_read_mixed_case_symbol (chr, port, opts); case '(': return (scm_read_sexp (chr, port, opts)); case '"': @@ -1643,6 +1747,11 @@ scm_read_expression (SCM port, scm_t_read_opts *opts) case ')': scm_i_input_error (FUNC_NAME, port, "unexpected \")\"", SCM_EOL); break; + case '}': + if (opts->curly_infix_p) + scm_i_input_error (FUNC_NAME, port, "unexpected \"}\"", SCM_EOL); + else + return scm_read_mixed_case_symbol (chr, port, opts); case ']': if (opts->square_brackets_p) scm_i_input_error (FUNC_NAME, port, "unexpected \"]\"", SCM_EOL); @@ -1667,6 +1776,74 @@ scm_read_expression (SCM port, scm_t_read_opts *opts) } #undef FUNC_NAME +static SCM +scm_read_expression (SCM port, scm_t_read_opts *opts) +#define FUNC_NAME "scm_read_expression" +{ + if (!opts->neoteric_p) + return scm_read_expression_1 (port, opts); + else + { + long line = 0; + int column = 0; + SCM expr; + + if (opts->record_positions_p) + { + /* We need to get the position of the first non-whitespace + character in order to correctly annotate neoteric + expressions. For example, for the expression 'f(x)', the + first call to 'scm_read_expression_1' reads the 'f' (which + cannot be annotated), and then we later read the '(x)' and + use it to construct the new list (f x). */ + int c = flush_ws (port, opts, (char *) NULL); + if (c == EOF) + return SCM_EOF_VAL; + scm_ungetc (c, port); + line = SCM_LINUM (port); + column = SCM_COL (port); + } + + expr = scm_read_expression_1 (port, opts); + + /* 'expr' is the first component of the neoteric expression. Now + we loop, and as long as the next character is '(', '[', or '{', + (without any intervening whitespace), we use it to construct a + new expression. For example, f{n - 1}(x) => ((f (- n 1)) x). */ + for (;;) + { + int chr = scm_getc (port); + + if (chr == '(') + /* e(...) => (e ...) */ + expr = scm_cons (expr, scm_read_sexp (chr, port, opts)); + else if (chr == '[') + /* e[...] => ($bracket-apply$ e ...) */ + expr = scm_cons (sym_bracket_apply, + scm_cons (expr, + scm_read_sexp (chr, port, opts))); + else if (chr == '{') + { + SCM arg = scm_read_sexp (chr, port, opts); + + if (scm_is_null (arg)) + expr = scm_list_1 (expr); /* e{} => (e) */ + else + expr = scm_list_2 (expr, arg); /* e{...} => (e {...}) */ + } + else + { + if (chr != EOF) + scm_ungetc (chr, port); + break; + } + maybe_annotate_source (expr, port, opts, line, column); + } + return expr; + } +} +#undef FUNC_NAME + /* Actual reader. */ @@ -1975,8 +2152,9 @@ SCM_SYMBOL (sym_port_read_options, "port-read-options"); #define READ_OPTION_R6RS_ESCAPES_P 8 #define READ_OPTION_SQUARE_BRACKETS_P 10 #define READ_OPTION_HUNGRY_EOL_ESCAPES_P 12 +#define READ_OPTION_CURLY_INFIX_P 14 -#define READ_OPTIONS_NUM_BITS 14 +#define READ_OPTIONS_NUM_BITS 16 #define READ_OPTIONS_INHERIT_ALL ((1UL << READ_OPTIONS_NUM_BITS) - 1) #define READ_OPTIONS_MAX_VALUE READ_OPTIONS_INHERIT_ALL @@ -2015,6 +2193,24 @@ set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts, int value) set_port_read_option (port, READ_OPTION_CASE_INSENSITIVE_P, value); } +/* Set OPTS and PORT's square_brackets_p option according to VALUE. */ +static void +set_port_square_brackets_p (SCM port, scm_t_read_opts *opts, int value) +{ + value = !!value; + opts->square_brackets_p = value; + set_port_read_option (port, READ_OPTION_SQUARE_BRACKETS_P, value); +} + +/* Set OPTS and PORT's curly_infix_p option according to VALUE. */ +static void +set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, int value) +{ + value = !!value; + opts->curly_infix_p = value; + set_port_read_option (port, READ_OPTION_CURLY_INFIX_P, value); +} + /* Initialize OPTS based on PORT's read options and the global read options. */ static void @@ -2063,8 +2259,11 @@ init_read_options (SCM port, scm_t_read_opts *opts) RESOLVE_BOOLEAN_OPTION (R6RS_ESCAPES_P, r6rs_escapes_p); RESOLVE_BOOLEAN_OPTION (SQUARE_BRACKETS_P, square_brackets_p); RESOLVE_BOOLEAN_OPTION (HUNGRY_EOL_ESCAPES_P, hungry_eol_escapes_p); + RESOLVE_BOOLEAN_OPTION (CURLY_INFIX_P, curly_infix_p); #undef RESOLVE_BOOLEAN_OPTION + + opts->neoteric_p = 0; } void diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index d679f6e..4b111aa 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -3716,7 +3716,7 @@ module '(ice-9 q) '(make-q q-length))}." ;;; ;;; Currently, the following feature identifiers are supported: ;;; -;;; guile r5rs srfi-0 srfi-4 srfi-6 srfi-13 srfi-14 srfi-55 srfi-61 +;;; guile r5rs srfi-0 srfi-4 srfi-6 srfi-13 srfi-14 srfi-55 srfi-61 srfi-105 ;;; ;;; Remember to update the features list when adding more SRFIs. ;;; @@ -3735,6 +3735,7 @@ module '(ice-9 q) '(make-q q-length))}." srfi-39 ;; parameterize srfi-55 ;; require-extension srfi-61 ;; general cond clause + srfi-105 ;; curly infix expressions )) ;; This table maps module public interfaces to the list of features. diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 168e799..a843fcd 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -136,6 +136,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/srfi-67.test \ tests/srfi-69.test \ tests/srfi-88.test \ + tests/srfi-105.test \ tests/srfi-4.test \ tests/srfi-9.test \ tests/statprof.test \ diff --git a/test-suite/tests/srfi-105.test b/test-suite/tests/srfi-105.test new file mode 100644 index 0000000..c0de5ad --- /dev/null +++ b/test-suite/tests/srfi-105.test @@ -0,0 +1,131 @@ +;;;; srfi-105.test --- Test suite for Guile's SRFI-105 reader. -*- scheme -*- +;;;; +;;;; Copyright (C) 2012 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-srfi-105) + #:use-module (test-suite lib) + #:use-module (srfi srfi-1)) + +#!curly-infix + +(with-test-prefix "curly-infix" + (pass-if (equal? '{n <= 5} '(<= n 5))) + (pass-if (equal? '{x + 1} '(+ x 1))) + (pass-if (equal? '{a + b + c} '(+ a b c))) + (pass-if (equal? '{x ,op y ,op z} '(,op x y z))) + (pass-if (equal? '{x eqv? `a} '(eqv? x `a))) + (pass-if (equal? '{'a eq? b} '(eq? 'a b))) + (pass-if (equal? '{n-1 + n-2} '(+ n-1 n-2))) + (pass-if (equal? '{a * {b + c}} '(* a (+ b c)))) + (pass-if (equal? '{a + {b - c}} '(+ a (- b c)))) + (pass-if (equal? '{{a + b} - c} '(- (+ a b) c))) + (pass-if (equal? '{{a > 0} and {b >= 1}} '(and (> a 0) (>= b 1)))) + (pass-if (equal? '{} '())) + (pass-if (equal? '{5} '5)) + (pass-if (equal? '{- x} '(- x))) + (pass-if (equal? '{length(x) >= 6} '(>= (length x) 6))) + (pass-if (equal? '{f(x) + g(y) + h(z)} '(+ (f x) (g y) (h z)))) + (pass-if (equal? '{(f a b) + (g h)} '(+ (f a b) (g h)))) + (pass-if (equal? '{f(a b) + g(h)} '(+ (f a b) (g h)))) + (pass-if (equal? '{a + f(b) + x} '(+ a (f b) x))) + (pass-if (equal? '{(- a) / b} '(/ (- a) b))) + (pass-if (equal? '{-(a) / b} '(/ (- a) b))) + (pass-if (equal? '{cos(q)} '(cos q))) + (pass-if (equal? '{e{}} '(e))) + (pass-if (equal? '{pi{}} '(pi))) + (pass-if (equal? '{'f(x)} '(quote (f x)))) + ;;(pass-if (equal? '#1=f(#1#) '#1=(f #1#))) + + (pass-if (equal? '{ (f (g h(x))) } '(f (g (h x))))) + (pass-if (equal? '{#(1 2 f(a) 4)} '#(1 2 (f a) 4))) + (pass-if (equal? '{ (f #;g(x) h(x)) } '(f (h x)))) + + (pass-if (equal? '{ (f #(g h(x))) } '(f #(g (h x))))) + (pass-if (equal? '{ (f '(g h(x))) } '(f '(g (h x))))) + (pass-if (equal? '{ (f `(g h(x))) } '(f `(g (h x))))) + (pass-if (equal? '{ (f #'(g h(x))) } '(f #'(g (h x))))) + (pass-if (equal? '{ (f #2((g) (h(x)))) } '(f #2((g) ((h x)))))) + + (pass-if (equal? '{(map - ns)} '(map - ns))) + (pass-if (equal? '{map(- ns)} '(map - ns))) + (pass-if (equal? '{n * factorial{n - 1}} '(* n (factorial (- n 1))))) + (pass-if (equal? '{2 * sin{- x}} '(* 2 (sin (- x))))) + + (pass-if (equal? '{3 + 4 +} '($nfx$ 3 + 4 +))) + (pass-if (equal? '{3 + 4 + 5 +} '($nfx$ 3 + 4 + 5 +))) + (pass-if (equal? '{a . z} '($nfx$ a . z))) + (pass-if (equal? '{a + b - c} '($nfx$ a + b - c))) + + (pass-if (equal? '{read(. options)} '(read . options))) + + (pass-if (equal? '{a(x)(y)} '((a x) y))) + (pass-if (equal? '{x[a]} '($bracket-apply$ x a))) + (pass-if (equal? '{y[a b]} '($bracket-apply$ y a b))) + + (pass-if (equal? '{f(g(x))} '(f (g x)))) + (pass-if (equal? '{f(g(x) h(x))} '(f (g x) (h x)))) + + + (pass-if (equal? '{} '())) + (pass-if (equal? '{e} 'e)) + (pass-if (equal? '{e1 e2} '(e1 e2))) + + (pass-if (equal? '{a . t} '($nfx$ a . t))) + (pass-if (equal? '{a b . t} '($nfx$ a b . t))) + (pass-if (equal? '{a b c . t} '($nfx$ a b c . t))) + (pass-if (equal? '{a b c d . t} '($nfx$ a b c d . t))) + (pass-if (equal? '{a + b +} '($nfx$ a + b +))) + (pass-if (equal? '{a + b + c +} '($nfx$ a + b + c +))) + (pass-if (equal? '{q + r * s} '($nfx$ q + r * s))) + ;;(pass-if (equal? '#1={a + . #1#} '($nfx$ . #1=(a + . #1#)))) + + (pass-if (equal? '{e()} '(e))) + (pass-if (equal? '{e{}} '(e))) + (pass-if (equal? '{e(1)} '(e 1))) + (pass-if (equal? '{e{1}} '(e 1))) + (pass-if (equal? '{e(1 2)} '(e 1 2))) + (pass-if (equal? '{e{1 2}} '(e (1 2)))) + (pass-if (equal? '{f{n - 1}} '(f (- n 1)))) + (pass-if (equal? '{f{n - 1}(x)} '((f (- n 1)) x))) + (pass-if (equal? '{f{n - 1}{y - 1}} '((f (- n 1)) (- y 1)))) + (pass-if (equal? '{f{- x}[y]} '($bracket-apply$ (f (- x)) y))) + (pass-if (equal? '{g{- x}} '(g (- x)))) + (pass-if (equal? '{( . e)} 'e)) + + (pass-if (equal? '{e[]} '($bracket-apply$ e))) + (pass-if (equal? '{e[1 2]} '($bracket-apply$ e 1 2))) + (pass-if (equal? '{e[1 . 2]} '($bracket-apply$ e 1 . 2)))) + + +#!curly-infix-and-bracket-lists + +(with-test-prefix "curly-infix-and-bracket-lists" + ;; Verify that these neoteric expressions still work properly + ;; when the 'square-brackets' read option is unset (which is done by + ;; the '#!curly-infix-and-bracket-lists' reader directive above). + (pass-if (equal? '{e[]} '($bracket-apply$ e))) + (pass-if (equal? '{e[1 2]} '($bracket-apply$ e 1 2))) + (pass-if (equal? '{e[1 . 2]} '($bracket-apply$ e 1 . 2))) + + ;; The following expressions are not actually part of SRFI-105, but + ;; they are handled when the 'curly-infix' read option is set and the + ;; 'square-brackets' read option is unset. This is a non-standard + ;; extension of SRFI-105, and follows the convention of GNU Kawa. + (pass-if (equal? '[] '($bracket-list$))) + (pass-if (equal? '[a] '($bracket-list$ a))) + (pass-if (equal? '[a b] '($bracket-list$ a b))) + (pass-if (equal? '[a . b] '($bracket-list$ a . b)))) -- 1.7.10.4