diff options
| -rw-r--r-- | CHANGELOG.md | 4 | ||||
| -rw-r--r-- | README.md | 20 | ||||
| -rw-r--r-- | infix-to-prefix.scm (renamed from infix-to-scheme.scm) | 72 | ||||
| -rw-r--r-- | infix-to-prefix/rule-set.scm (renamed from infix-to-scheme/rule-set.scm) | 74 |
4 files changed, 85 insertions, 85 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index 3ed6e1c..145e812 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add README.md file. - Add COPYING file. -- Add `(infix-to-scheme)` module. -- Add `(infix-to-scheme rule-set)` module. +- Add `(infix-to-prefix)` module. +- Add `(infix-to-prefix rule-set)` module. - Add CHANGELOG.md file. @@ -1,29 +1,29 @@ -# Infix-to-Scheme +# Infix-to-Prefix -Infix-to-Scheme is an R7RS library for converting infix formula to Scheme expression. +Infix-to-Prefix is an R7RS library for converting infix formula to Prefix expression. ## Usage -### Import `(infix-to-scheme)` library +### Import `(infix-to-prefix)` library -```scheme -(import (infix-to-scheme)) +```prefix +(import (infix-to-prefix)) ``` -#### `(infix->scheme expr) → <sexpr>` +#### `(infix->prefix expr) → <sexpr>` -Returns converted scheme expression if `expr` is a valid infix formula expression; otherwise, it returns`#f`. +Returns converted prefix expression if `expr` is a valid infix formula expression; otherwise, it returns`#f`. -#### `(scheme->infix expr) → <sexpr>` +#### `(prefix->infix expr) → <sexpr>` -Returns converted infix formula expression if `expr` is a valid scheme expression; otherwise, it returns`#f`. +Returns converted infix formula expression if `expr` is a valid prefix expression; otherwise, it returns`#f`. ## Downloading code with git Use git command. ```shell -git clone https://git.tojo.tokyo/infix-to-scheme.git +git clone https://git.tojo.tokyo/infix-to-prefix.git ``` ## License diff --git a/infix-to-scheme.scm b/infix-to-prefix.scm index ae2fc56..00e8cc9 100644 --- a/infix-to-scheme.scm +++ b/infix-to-prefix.scm @@ -1,29 +1,29 @@ -;;; Infix-to-Scheme --- Library for converting infix formula to Scheme expression +;;; Infix-to-Prefix --- Library for converting infix formula to Prefix expression ;;; Copyright © 2024 Masaya Tojo <masaya@tojo.tokyo> ;;; -;;; This file is part of Infix-to-Scheme. +;;; This file is part of Infix-to-Prefix. ;;; -;;; Infix-to-Scheme is free software: you can redistribute it and/or +;;; Infix-to-Prefix is free software: you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as ;;; published by the Free Software Foundation, either version 3 of the ;;; License, or (at your option) any later version. ;;; -;;; Infix-to-Scheme is distributed in the hope that it will be useful, +;;; Infix-to-Prefix 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 ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with Infix-to-Scheme. If not, see +;;; along with Infix-to-Prefix. If not, see ;;; <https://www.gnu.org/licenses/>. -(define-library (infix-to-scheme) - (export infix->scheme - scheme->infix +(define-library (infix-to-prefix) + (export infix->prefix + prefix->infix current-operator-rule-set) (import (scheme base) (scheme case-lambda) - (infix-to-scheme rule-set) + (infix-to-prefix rule-set) (only (srfi 1) car+cdr fold break! reverse! append! append-map! append-reverse!) (only (srfi 26) cut cute)) (begin @@ -35,47 +35,47 @@ (operator '- 1 (direction 'left) (identity 0 #t #t 3)) (operator '* 2 (direction 'left #t) (identity 1)) (operator '/ 2 (direction 'left) (identity 1 #t)) - (operator '^ 4 (direction 'right) #f (scheme #t 'expt))))) + (operator '^ 4 (direction 'right) #f (prefix #t 'expt))))) (define current-operator-rule-set (make-parameter (make-default-operator-rule-set))) - (define infix->scheme + (define infix->prefix (case-lambda ((expr failure) (call/cc (lambda (return) (let ((rs (current-operator-rule-set))) - (map-all-list (cute infix->scheme-1 <> rs (lambda (e) (return (failure e)))) + (map-all-list (cute infix->prefix-1 <> rs (lambda (e) (return (failure e)))) expr))))) ((expr) - (infix->scheme expr (lambda (e) #f))))) + (infix->prefix expr (lambda (e) #f))))) - (define (infix->scheme-1 expr rs fail) + (define (infix->prefix-1 expr rs fail) (cond ((and (pair? expr) (null? (cdr expr))) (car expr)) ((minimum-precedence expr rs) => (lambda (op) - (let ->scheme ((expr (list-copy expr)) + (let ->prefix ((expr (list-copy expr)) (op op)) - (define (make-scheme left op-sym right) + (define (make-prefix left op-sym right) (define (->infix left op-sym right) (append left (cons op-sym right))) (let ((left-op (minimum-precedence left rs)) (right-op (minimum-precedence right rs)) - (not-binary-only? (not (operator-scheme-binary-only? op)))) - `(,(operator-scheme-symbol op) + (not-binary-only? (not (operator-prefix-binary-only? op)))) + `(,(operator-prefix-symbol op) ,@(if (operator? left-op) (if (eqv? (operator-symbol op) (operator-symbol left-op)) (if not-binary-only? (if (and (eqv? op-sym (car left)) (pair? (cdr left)) (null? (cdr (cdr left)))) - (list (->scheme left left-op)) - (cdr (->scheme left left-op))) + (list (->prefix left left-op)) + (cdr (->prefix left left-op))) (if (operator-left? op) - (list (->scheme left left-op)) + (list (->prefix left left-op)) (fail expr))) - (list (->scheme left left-op))) + (list (->prefix left left-op))) (if (and (pair? left) (null? (cdr left))) (if (and not-binary-only? @@ -89,11 +89,11 @@ ,@(if (operator? right-op) (if (eqv? (operator-symbol op) (operator-symbol right-op)) (if not-binary-only? - (cdr (->scheme right right-op)) + (cdr (->prefix right right-op)) (if (operator-right? op) - (list (->scheme right right-op)) + (list (->prefix right right-op)) (fail expr))) - (list (->scheme right right-op))) + (list (->prefix right right-op))) (if (and (pair? right) (null? (cdr right))) (if (and not-binary-only? @@ -112,37 +112,37 @@ (rule-set-infix-ref rs (car rev-rest))) (and (pair? rev-lst) (null? (cdr rev-lst)))) - (infix->scheme-1 (append-reverse! rev-rest + (infix->prefix-1 (append-reverse! rev-rest (list `(,op-sym ,(car rev-lst)))) rs fail) - (make-scheme (reverse! rev-rest) op-sym (reverse! rev-lst))))))) + (make-prefix (reverse! rev-rest) op-sym (reverse! rev-lst))))))) (else (let-values (((lst op+rest) (break! (cute eqv? (operator-symbol op) <>) expr))) (let-values (((op rest) (car+cdr op+rest))) - (make-scheme lst op rest)))))))) + (make-prefix lst op rest)))))))) (else expr))) - (define scheme->infix + (define prefix->infix (case-lambda ((expr failure) (let ((rs (current-operator-rule-set))) (call-with-current-continuation (lambda (return) - (let-values (((result _precedence) (%scheme->infix expr rs (lambda (e) (return (failure e)))))) + (let-values (((result _precedence) (%prefix->infix expr rs (lambda (e) (return (failure e)))))) result))))) ((expr) - (scheme->infix expr (lambda (e) #f))))) + (prefix->infix expr (lambda (e) #f))))) - (define (%scheme->infix expr rs failure) + (define (%prefix->infix expr rs failure) (let ->infix ((expr expr)) (define (->infix-fst expr) (let-values (((x _) (->infix expr))) x)) (if (not (pair? expr)) (values expr -inf.0) - (let-values (((op-scheme-sym args) (car+cdr expr))) - (cond ((rule-set-scheme-ref rs op-scheme-sym) + (let-values (((op-prefix-sym args) (car+cdr expr))) + (cond ((rule-set-prefix-ref rs op-prefix-sym) => (lambda (op) (let ((p (operator-precedence op)) (op-sym (operator-symbol op))) @@ -251,8 +251,8 @@ (else (operator-precedence op))))) (else #f))) - (define (operator-scheme-binary-only? op) - (cond ((operator-scheme op) => scheme-binary-only?) + (define (operator-prefix-binary-only? op) + (cond ((operator-prefix op) => prefix-binary-only?) (else #f))) (define (wrap-when b? x) diff --git a/infix-to-scheme/rule-set.scm b/infix-to-prefix/rule-set.scm index 22ffcc3..4f8c123 100644 --- a/infix-to-scheme/rule-set.scm +++ b/infix-to-prefix/rule-set.scm @@ -1,37 +1,37 @@ -;;; Infix-to-Scheme --- Library for converting infix formula to Scheme expression +;;; Infix-to-Prefix --- Library for converting infix formula to Prefix expression ;;; Copyright © 2024 Masaya Tojo <masaya@tojo.tokyo> ;;; -;;; This file is part of Infix-to-Scheme. +;;; This file is part of Infix-to-Prefix. ;;; -;;; Infix-to-Scheme is free software: you can redistribute it and/or +;;; Infix-to-Prefix is free software: you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as ;;; published by the Free Software Foundation, either version 3 of the ;;; License, or (at your option) any later version. ;;; -;;; Infix-to-Scheme is distributed in the hope that it will be useful, +;;; Infix-to-Prefix 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 ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with Infix-to-Scheme. If not, see +;;; along with Infix-to-Prefix. If not, see ;;; <https://www.gnu.org/licenses/>. -(define-library (infix-to-scheme rule-set) +(define-library (infix-to-prefix rule-set) (export rule-set rule-set? rule-set-infix-ref - rule-set-scheme-ref + rule-set-prefix-ref operator operator? operator-symbol - operator-scheme-symbol + operator-prefix-symbol operator-precedence operator-left? operator-right? operator-associative? - operator-scheme + operator-prefix operator-identity identity @@ -46,10 +46,10 @@ direction-left? direction-associative? - scheme - scheme? - scheme-symbol - scheme-binary-only?) + prefix + prefix? + prefix-symbol + prefix-binary-only?) (import (scheme base) (scheme case-lambda) (only (srfi 128) make-eqv-comparator)) @@ -60,14 +60,14 @@ (import (only (srfi 146 hash) hashmap-ref/default hashmap-unfold)))) (begin (define-record-type <rule-set> - (make-rule-set operator-hashmap scheme-hashmap) + (make-rule-set operator-hashmap prefix-hashmap) rule-set? (operator-hashmap rule-set-operator-hashmap) - (scheme-hashmap rule-set-scheme-hashmap)) + (prefix-hashmap rule-set-prefix-hashmap)) (define (rule-set operator-list) (make-rule-set (list->operator-hashmap operator-list) - (list->scheme-hashmap operator-list))) + (list->prefix-hashmap operator-list))) (define (list->operator-hashmap ops) (hashmap-unfold null? @@ -78,11 +78,11 @@ ops (make-eqv-comparator))) - (define (list->scheme-hashmap ops) + (define (list->prefix-hashmap ops) (hashmap-unfold null? (lambda (ops) (let ((op (car ops))) - (values (operator-scheme-symbol op) + (values (operator-prefix-symbol op) (car ops)))) cdr ops @@ -91,17 +91,17 @@ (define (rule-set-infix-ref rule-set key) (hashmap-ref/default (rule-set-operator-hashmap rule-set) key #f)) - (define (rule-set-scheme-ref rule-set key) - (hashmap-ref/default (rule-set-scheme-hashmap rule-set) key #f)) + (define (rule-set-prefix-ref rule-set key) + (hashmap-ref/default (rule-set-prefix-hashmap rule-set) key #f)) (define-record-type <operator> - (make-operator symbol precedence dir identity scheme) + (make-operator symbol precedence dir identity prefix) operator? (symbol operator-symbol) (precedence operator-precedence) (dir operator-direction) (identity operator-identity) - (scheme operator-scheme)) + (prefix operator-prefix)) (define operator (case-lambda @@ -111,11 +111,11 @@ (operator symbol precedence direction #f)) ((symbol precedence direction identity) (operator symbol precedence direction identity #f)) - ((symbol precedence direction identity scheme) + ((symbol precedence direction identity prefix) (when (and identity (identity-unary? identity) (not (and direction (direction-left? direction)))) (error "operator: unary operator must be left direction" symbol)) - (make-operator symbol precedence direction identity scheme)))) + (make-operator symbol precedence direction identity prefix)))) (define-record-type <direction> (make-direction left? associative?) @@ -148,25 +148,25 @@ (cond ((operator-direction x) => direction-associative?) (else #f))) - (define (operator-scheme-symbol op) - (cond ((operator-scheme op) => (lambda (p) - (and (scheme-has-symbol? p) - (scheme-symbol p)))) + (define (operator-prefix-symbol op) + (cond ((operator-prefix op) => (lambda (p) + (and (prefix-has-symbol? p) + (prefix-symbol p)))) (else (operator-symbol op)))) - (define-record-type <scheme> - (make-scheme binary-only? has-symbol? symbol) - scheme? - (binary-only? scheme-binary-only?) - (has-symbol? scheme-has-symbol?) - (symbol scheme-symbol)) + (define-record-type <prefix> + (make-prefix binary-only? has-symbol? symbol) + prefix? + (binary-only? prefix-binary-only?) + (has-symbol? prefix-has-symbol?) + (symbol prefix-symbol)) - (define scheme + (define prefix (case-lambda ((binary-only?) - (make-scheme binary-only? #f #f)) + (make-prefix binary-only? #f #f)) ((binary-only? symbol) - (make-scheme binary-only? #t symbol)))) + (make-prefix binary-only? #t symbol)))) (define-record-type <identity> (make-identity value inv? unary? unary-precedence) |