From 0ae419a6fce825b093c7c26405bd680ab7a0d977 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Thu, 12 Sep 2024 10:07:48 +0900 Subject: Rename from unit to identity and modify prefix interface --- qklib/infix.scm | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) (limited to 'qklib/infix.scm') diff --git a/qklib/infix.scm b/qklib/infix.scm index cdbc055..2ea093b 100644 --- a/qklib/infix.scm +++ b/qklib/infix.scm @@ -25,12 +25,12 @@ (define (make-default-operator-rule-set) (rule-set (list - (operator '= 0 #f #f (prefix '= #f)) - (operator '+ 1 (direction 'left #t) (unit 0) (prefix '+ #t)) - (operator '- 1 (direction 'left) (unit 0 #t #t)) - (operator '* 2 (direction 'left #t) (unit 1)) - (operator '/ 2 (direction 'left) (unit 1 #t) (prefix '/)) - (operator '^ 3 (direction 'right) #f (prefix 'expt #t))))) + (operator '= 0) + (operator '+ 1 (direction 'left #t) (identity 0)) + (operator '- 1 (direction 'left) (identity 0 #t #t)) + (operator '* 2 (direction 'left #t) (identity 1)) + (operator '/ 2 (direction 'left) (identity 1 #t)) + (operator '^ 3 (direction 'right) #f (prefix #t 'expt))))) (define current-operator-rule-set (make-parameter (make-default-operator-rule-set))) @@ -51,12 +51,12 @@ ((and (pair? expr) (null? (cdr (cdr expr))) (rule-set-infix-ref rs (car expr))) => (lambda (op) - (if (operator-unit-unary? op) + (if (operator-identity-unary? op) (let ((arg (car (cdr expr))) - (unit (operator-unit op))) + (identity (operator-identity op))) (if (rule-set-infix-ref rs arg) (fail expr) - (if (unit-inv? unit) + (if (identity-inv? identity) expr arg))) (fail expr)))) @@ -142,18 +142,18 @@ (let ((p (operator-precedence op)) (op-sym (operator-symbol op))) (cond ((null? args) - (cond ((and (not (operator-unit-inv? op)) - (operator-unit op)) - => (lambda (u) (values (unit-value u) -inf.0))) + (cond ((and (not (operator-identity-inv? op)) + (operator-identity op)) + => (lambda (u) (values (identity-value u) -inf.0))) (else (failure expr)))) ((null? (cdr args)) (let-values (((r-expr r-p) (->infix (car args)))) - (cond ((operator-unit op) + (cond ((operator-identity op) => (lambda (u) - (if (unit-inv? u) - (if (unit-unary? u) + (if (identity-inv? u) + (if (identity-unary? u) (values `(,op-sym ,r-expr) -inf.0) - (values `(,(unit-value (operator-unit op)) + (values `(,(identity-value (operator-identity op)) ,op-sym ,@(if (or (operator-right? op) (operator-associative? op)) @@ -224,12 +224,12 @@ #f result)))) - (define (operator-unit-inv? x) - (cond ((operator-unit x) => (cut unit-inv? <>)) + (define (operator-identity-inv? x) + (cond ((operator-identity x) => (cut identity-inv? <>)) (else #f))) - (define (operator-unit-unary? op) - (cond ((operator-unit op) => unit-unary?) + (define (operator-identity-unary? op) + (cond ((operator-identity op) => identity-unary?) (else #f))) (define (operator-prefix-binary-only? op) -- cgit v1.2.3