diff options
| -rw-r--r-- | stdlib/infix.tl | 6 | ||||
| -rw-r--r-- | tests/012/infix.tl | 26 | ||||
| -rw-r--r-- | txr.1 | 12 |
3 files changed, 29 insertions, 15 deletions
diff --git a/stdlib/infix.tl b/stdlib/infix.tl index 1d8f8066..1f544006 100644 --- a/stdlib/infix.tl +++ b/stdlib/infix.tl @@ -219,7 +219,9 @@ (if (or (not ucheck) (eq (first opstack).?arity :postfix)) (infix-error oexp "operator expected before ~s" tok)) - (push tok nodestack) + (if (consp tok) + (push ^@,tok nodestack) + (push tok nodestack)) (set ucheck nil exp rest))) (whilet ((o (first opstack))) @@ -252,6 +254,8 @@ (finish-infix ^(and (,op ,*(butlast a) ,b ,*restb) ,*rest))) (((and @expr)) expr) + (((@(eq 'sys:expr) @expr)) + expr) (((@op . @args)) (identity (cons op [mapcar finish-infix args]))) ((@else) else)) diff --git a/tests/012/infix.tl b/tests/012/infix.tl index c3767272..d3e1db54 100644 --- a/tests/012/infix.tl +++ b/tests/012/infix.tl @@ -17,9 +17,9 @@ (= b) (identity b) (++ a) (inc a) (-- a) (dec a) - (= (-)) (identity (-)) - (++ (-)) (inc (-)) - (-- (-)) (dec (-))) + (= (-)) (identity @(-)) + (++ (-)) (inc @(-)) + (-- (-)) (dec @(-))) (defmacro mtest-pif-syms (:form f (var syms) . pairs) (unless (evenp (len pairs)) @@ -35,8 +35,8 @@ ^(a ,fn) :error ^(,fn) :error ^(,fn b) ^(,fn b) - ^(,fn (:)) ^(,fn (:)) - ^(,fn (: :)) ^(,fn (: :)) + ^(,fn (:)) ^@(,fn (:)) + ^(,fn (: :)) ^@(,fn (: :)) ^(,fn a + b) ^(,fn (+ a b)) ^(,fn ,fn ,fn a + b) ^(,fn (,fn (,fn (+ a b)))) ^(,fn a + b + ,fn b + c) ^(+ (,fn (+ a b)) (,fn (+ b c))) @@ -55,16 +55,16 @@ (x + -- a ** b ++ * c + d) (+ (+ x (* (expt (dec a) (pinc b)) c)) d)) (mtest-pif - ([i]) [i] - (a[i]) [a (i)] - (a[i][j]) [[a (i)] (j)] - (a[i][j][k]) [[[a (i)] (j)] (k)]) + ([i]) @[i] + (a[i]) @[a (i)] + (a[i][j]) @[[a (i)] (j)] + (a[i][j][k]) @[[[a (i)] (j)] (k)]) (mtest-pif - (x ** a[i][j][k]) (expt x [[[a (i)] (j)] (k)]) - (x ** a[i][j][k] ++) (expt x (pinc [[[a (i)] (j)] (k)])) - (x ** -- a[i][j][k]) (expt x (dec [[[a (i)] (j)] (k)])) - (x ** -- a[i + y][j ++][-- k]) (expt x (dec [[[a (i + y)] (j ++)] (-- k)]))) + (x ** a[i][j][k]) (expt x @[[[a (i)] (j)] (k)]) + (x ** a[i][j][k] ++) (expt x (pinc @[[[a (i)] (j)] (k)])) + (x ** -- a[i][j][k]) (expt x (dec @[[[a (i)] (j)] (k)])) + (x ** -- a[i + y][j ++][-- k]) (expt x (dec @[[[a (i + y)] (j ++)] (-- k)]))) (ifx (defun quadratic-roots (a b c) @@ -55455,7 +55455,17 @@ consecutive operands. Elements of .meta list which are compound expressions are not recursively processed by -.codn parse-infix . +.codn parse-infix , +and are annotated by insertion into a +.code sys:expr +form. That is to say, when +.code parse-infix +encounters a compound expression +.code "(E)" +it transforms it to +.code "@(E)" +in order to mark it as an external, non-infix expression that was +integrated into the output. .coNP Macro @ ifx .synb |