diff options
| -rw-r--r-- | ccwl/lang.scm | 64 | ||||
| -rwxr-xr-x | scripts/ccwl | 45 |
2 files changed, 66 insertions, 43 deletions
diff --git a/ccwl/lang.scm b/ccwl/lang.scm new file mode 100644 index 0000000..22eb9a7 --- /dev/null +++ b/ccwl/lang.scm @@ -0,0 +1,64 @@ +;;; ccwl --- Concise Common Workflow Language +;;; Copyright © 2026 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of ccwl. +;;; +;;; ccwl 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. +;;; +;;; ccwl 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 ccwl. If not, see <https://www.gnu.org/licenses/>. + +(define-module (ccwl lang) + #:use-module (rnrs conditions) + #:use-module (rnrs exceptions) + #:use-module (srfi srfi-1) + #:use-module (ice-9 textual-ports) + #:use-module (ccwl conditions) + #:export (ccwl-read)) + +(define (syntax-list->vector x) + "Convert syntax @var{x} of a list into syntax of a vector." + (datum->syntax #f + (syntax-case x () + ((elements ...) + #'#(elements ...))) + #:source x)) + +(define (read-hash-vector chr port) + "Read vector from @var{port}. This function is intended for use with +@code{read-hash-extend}." + (unget-char port chr) + (let ((lst (read-syntax port))) + (if (dotted-list? (syntax->datum lst)) + (raise-exception + (condition (ccwl-violation lst) + (formatted-message "Malformed vector: unexpected dotted list ~a" + (syntax->datum lst)))) + (syntax-list->vector lst)))) + +(read-hash-extend #\( read-hash-vector) + +(define* (ccwl-read #:optional (port (current-input-port))) + "Read an S-expression from @var{port}. This function wraps +@code{read-syntax} to raise read errors the way ccwl likes to handle +it." + (guard (c ((and (eq? (exception-kind c) + 'read-error) + (message-condition? c) + (irritants-condition? c)) + ;; TODO: Once https://codeberg.org/guile/guile/issues/206 + ;; is fixed, report error in source context using + ;; report-ccwl-violation. + (raise-exception + (apply formatted-message + (condition-message c) + (condition-irritants c))))) + (read-syntax port))) diff --git a/scripts/ccwl b/scripts/ccwl index bee3bef..6438e34 100755 --- a/scripts/ccwl +++ b/scripts/ccwl @@ -26,19 +26,17 @@ exec guile --no-auto-compile -e main -s "$0" "$@" ;;; Code: -(use-modules (rnrs conditions) - (rnrs exceptions) - (srfi srfi-1) +(use-modules (rnrs exceptions) (srfi srfi-26) (srfi srfi-28) (srfi srfi-37) (ice-9 match) (ice-9 exceptions) - (ice-9 textual-ports) (ccwl ccwl) (ccwl conditions) (ccwl cwl) (ccwl graphviz) + (ccwl lang) (ccwl ui) (ccwl utils)) @@ -69,45 +67,6 @@ exec guile --no-auto-compile -e main -s "$0" "$@" (acons 'output-file arg result))) %help-option)) -(define* (ccwl-read #:optional (port (current-input-port))) - "Read an S-expression from @var{port}. This function wraps -@code{read-syntax} to raise read errors the way ccwl likes to handle -it." - (guard (c ((and (eq? (exception-kind c) - 'read-error) - (message-condition? c) - (irritants-condition? c)) - ;; TODO: Once https://codeberg.org/guile/guile/issues/206 - ;; is fixed, report error in source context using - ;; report-ccwl-violation. - (raise-exception - (apply formatted-message - (condition-message c) - (condition-irritants c))))) - (read-syntax port))) - -(define (syntax-list->vector x) - "Convert syntax @var{x} of a list into syntax of a vector." - (datum->syntax #f - (syntax-case x () - ((elements ...) - #'#(elements ...))) - #:source x)) - -(define (read-hash-vector chr port) - "Read vector from @var{port}. This function is intended for use with -@code{read-hash-extend}." - (unget-char port chr) - (let ((lst (read-syntax port))) - (if (dotted-list? (syntax->datum lst)) - (raise-exception - (condition (ccwl-violation lst) - (formatted-message "Malformed vector: unexpected dotted list ~a" - (syntax->datum lst)))) - (syntax-list->vector lst)))) - -(read-hash-extend #\( read-hash-vector) - (define %compile-error (make-parameter #f)) |