From 0ae419a6fce825b093c7c26405bd680ab7a0d977 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Thu, 12 Sep 2024 10:07:48 +0900
Subject: Rename from unit to identity and modify prefix interface

---
 qklib/infix/rule-set.scm | 67 +++++++++++++++++++++++++-----------------------
 1 file changed, 35 insertions(+), 32 deletions(-)

(limited to 'qklib/infix/rule-set.scm')

diff --git a/qklib/infix/rule-set.scm b/qklib/infix/rule-set.scm
index 80ad5e4..96f08cc 100644
--- a/qklib/infix/rule-set.scm
+++ b/qklib/infix/rule-set.scm
@@ -27,13 +27,13 @@
           operator-right?
           operator-associative?
           operator-prefix
-          operator-unit
+          operator-identity
 
-          unit
-          unit?
-          unit-value
-          unit-inv?
-          unit-unary?
+          identity
+          identity?
+          identity-value
+          identity-inv?
+          identity-unary?
 
           direction
           direction?
@@ -89,12 +89,12 @@
       (hashmap-ref/default (rule-set-prefix-hashmap rule-set) key #f))
 
     (define-record-type <operator>
-      (make-operator symbol precedence dir unit prefix)
+      (make-operator symbol precedence dir identity prefix)
       operator?
       (symbol operator-symbol)
       (precedence operator-precedence)
       (dir operator-direction)
-      (unit operator-unit)
+      (identity operator-identity)
       (prefix operator-prefix))
 
     (define operator
@@ -103,10 +103,10 @@
          (operator symbol precedence #f))
         ((symbol precedence direction)
          (operator symbol precedence direction #f))
-        ((symbol precedence direction unit)
-         (operator symbol precedence direction unit #f))
-        ((symbol precedence direction unit prefix)
-         (make-operator symbol precedence direction unit prefix))))
+        ((symbol precedence direction identity)
+         (operator symbol precedence direction identity #f))
+        ((symbol precedence direction identity prefix)
+         (make-operator symbol precedence direction identity prefix))))
 
     (define-record-type <direction>
       (make-direction left? associative?)
@@ -140,31 +140,34 @@
             (else #f)))
 
     (define (operator-prefix-symbol op)
-      (cond ((operator-prefix op) => prefix-symbol)
+      (cond ((operator-prefix op) => (lambda (p)
+                                       (and (prefix-has-symbol? p)
+                                            (prefix-symbol p))))
             (else (operator-symbol op))))
 
     (define-record-type <prefix>
-      (make-prefix symbol binary-only?)
+      (make-prefix binary-only? has-symbol? symbol)
       prefix?
-      (symbol prefix-symbol)
-      (binary-only? prefix-binary-only?))
+      (binary-only? prefix-binary-only?)
+      (has-symbol? prefix-has-symbol?)
+      (symbol prefix-symbol))
 
     (define prefix
       (case-lambda
-        ((symbol)
-         (prefix symbol #f))
-        ((symbol binary-only?)
-         (make-prefix symbol binary-only?))))
-
-    (define-record-type <unit>
-      (make-unit value inv? unary?)
-      unit?
-      (value unit-value)
-      (inv? unit-inv?)
-      (unary? unit-unary?))
-
-    (define unit
+        ((binary-only?)
+         (make-prefix binary-only? #f #f))
+        ((binary-only? symbol)
+         (make-prefix binary-only? symbol #t))))
+
+    (define-record-type <identity>
+      (make-identity value inv? unary?)
+      identity?
+      (value identity-value)
+      (inv? identity-inv?)
+      (unary? identity-unary?))
+
+    (define identity
       (case-lambda
-        ((value) (unit value #f))
-        ((value inv?) (unit value inv? #f))
-        ((value inv? unary?) (make-unit value inv? unary?))))))
+        ((value) (identity value #f))
+        ((value inv?) (identity value inv? #f))
+        ((value inv? unary?) (make-identity value inv? unary?))))))
-- 
cgit v1.2.3