- Timestamp:
- 05/30/20 19:58:54 (8 months ago)
- Location:
- release/5/slib-prec/trunk
- Files:
-
- 1 added
- 1 deleted
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/slib-prec/trunk/slib-prec-grammar.scm
r38716 r38717 9 9 active-grammar active-grammar-set! 10 10 active-input-grammar active-output-grammar active-echo-grammar 11 read-syntax-setup!12 11 ; 13 12 make-grammar … … 19 18 grammar-write-tab 20 19 ; 21 grammar-id-name-set!22 20 grammar-id-name 23 21 list-of-grammar-ids … … 33 31 clear-grammars 34 32 ; 35 make-delimited-parse-grammar-reader36 33 read-sexp 37 34 write-sexp 38 35 print-using-grammar 39 flush-input-whitespace) 36 flush-input-whitespace 37 ; 38 make-delimited-parse-grammar-reader 39 make-delimited-sexp-reader 40 read-sexp-from-string) 40 41 41 42 (import scheme) 42 43 (import (chicken base)) 43 44 (import (chicken type)) 45 (import (only (srfi 1) iota)) 44 46 (import slib-prec-parse) 45 47 … … 47 49 48 50 (include "slib-compat") 49 (include "slib-grammar") 51 52 ;; 53 54 (define *grammar-ids* '()) 55 56 (define (grammar-id-name-set! id name) 57 (set! *grammar-ids* (alist-update! id name *grammar-ids* eqv?)) ) 58 59 (define (grammar-id-name id) 60 (alist-ref id *grammar-ids* eqv?) ) 61 62 (define (list-of-grammar-ids) 63 (map car *grammar-ids*) ) 64 65 (define (count-of-grammar-ids) 66 (length *grammar-ids*) ) 67 68 (define (clear-grammar-ids) 69 (set! *grammar-ids* '()) ) 70 71 ;ordered list of grammar names 72 (define (grammar-id-name-setup! names) 73 (clear-grammar-ids) 74 (for-each grammar-id-name-set! (iota (length names)) names) ) 75 76 ;; 77 78 ;;from jacal unparse.scm 79 80 (define (print-using-grammar sexp grm) 81 ;(print "[" (grammar-name grm) "] " sexp) 82 (pretty-print sexp) 83 #; ;FIXME needs most of jacal! 84 (template-print sexp (grammar-write-tab grm)) ) 85 86 ; supplies module based struct tag & other identifiers 87 (define-record grammar name reader read-tab writer write-tab) 88 (define-record-type grammar 89 (make-grammar name reader read-tab writer write-tab) 90 grammar? 91 (name grammar-name grammar-name-set!) 92 (reader grammar-reader grammar-reader-set!) 93 (read-tab grammar-read-tab grammar-read-tab-set!) 94 (writer grammar-writer grammar-writer-set!) 95 (write-tab grammar-write-tab grammar-write-tab-set!) ) 96 97 (define (grammar-copy! grm1 grm2 #!key name reader read-tab writer write-tab) 98 (grammar-name-set! grm1 (or name (grammar-name grm2))) 99 (grammar-reader-set! grm1 (or reader (grammar-reader grm2))) 100 (grammar-read-tab-set! grm1 (or read-tab (grammar-read-tab grm2))) 101 (grammar-writer-set! grm1 (or writer (grammar-writer grm2))) 102 (grammar-write-tab-set! grm1 (or write-tab (grammar-write-tab grm2))) ) 103 104 ; 105 (define *grammars* '()) 106 107 (define (defgrammar name grm) 108 (set! *grammars* (alist-update! name grm *grammars* eq?)) ) 109 110 (define (get-grammar name) 111 (alist-ref name *grammars* eq?) ) 112 113 (define (list-of-grammars) 114 (map (lambda (cell) (car cell)) *grammars*) ) 115 116 (define (count-of-grammars) 117 (length *grammars*) ) 118 119 (define (get-grammar/id id) 120 (get-grammar (grammar-id-name id)) ) 121 122 (define (clear-grammars) 123 (clear-grammar-ids) 124 (set! *grammar* '()) ) 125 126 ;; 127 128 ; 129 (define (read-sexp grm column) ((grammar-reader grm) grm column)) 130 (define (write-sexp sexp grm) ((grammar-writer grm) sexp grm)) 131 132 (define *tab-stop* 8) 133 134 ; 135 (define (flush-input-whitespace port) 136 (do ((chr (peek-char port) (peek-char port)) 137 (col 0 (case chr 138 ((#\space) (+ 1 col)) 139 ((#\tab) (modulo (+ (sub1 *tab-stop*) col) *tab-stop*)) 140 ((#\newline) 0) 141 (else col)))) 142 ((or (eof-object? chr) 143 (not (char-whitespace? chr))) 144 col) 145 (read-char port))) 146 147 ;; 148 149 (define (make-delimited-parse-grammar-reader delim) 150 (lambda (grm column #!optional (port (current-input-port))) 151 (prec:parse 152 (grammar-read-tab grm) 153 delim 154 (+ column (flush-input-whitespace port)) 155 port)) ) 156 157 (define (make-delimited-sexp-reader port delim) 158 (lambda (grm column) 159 (define temporary-grammar 160 (let ((+grammar-cache+ (make-grammar #f #f #f #f #f))) 161 (lambda (grm . args) 162 (apply grammar-copy! +grammar-cache+ grm args) 163 +grammar-cache+ ) ) ) 164 (let ((grm* (temporary-grammar grm #:reader (make-delimited-parse-grammar-reader delim)))) 165 ;ugly but SLIB prec kinda assumes 166 (parameterize ((current-input-port port)) 167 (read-sexp grm* column) ) ) ) ) 168 169 ;; 170 171 (define (read-sexp-from-string str #!optional (grm (active-input-grammar)) (column 0)) 172 (import (only (chicken port) with-input-from-string)) 173 (with-input-from-string str (cut read-sexp grm column)) ) 50 174 51 175 ;; … … 67 191 (define (active-echo-grammar) (receive (i o e) (active-grammar) e)) 68 192 69 ;;70 71 (define (read-syntax-setup!)72 (import (only (chicken base) parentheses-synonyms))73 (import (only (chicken read-syntax) set-sharp-read-syntax! set-parameterized-read-syntax!))74 (set-sharp-read-syntax! #\{75 (lambda (port)76 (parameterize ((parentheses-synonyms #f))77 (read-delimited-sexp port #\} (get-grammar/id 0) 0))))78 (set-parameterized-read-syntax! #\{79 (lambda (port id)80 (parameterize ((parentheses-synonyms #f))81 (read-delimited-sexp port #\} (get-grammar/id id) 0)))) )82 83 193 ) ;slib-prec-grammar -
release/5/slib-prec/trunk/slib-prec-parse.scm
r38716 r38717 1 1 ;;;; slib-prec-parse.scm -*-scheme-*- 2 2 ;;;; Kon Lovett, Apr '20 3 ;;;; Kon Lovett, Apr '184 3 5 4 ;; Issues -
release/5/slib-prec/trunk/slib-prec.egg
r38716 r38717 9 9 (maintainer "[[kon lovett]]") 10 10 (license "SLIB") 11 (dependencies 12 (utf8 "3.5.0")) 11 (dependencies utf8) 13 12 (test-dependencies test) 14 13 (components … … 16 15 (types-file) 17 16 (component-dependencies slib-prec-grammar) 18 (csc-options "-O3" "-d1" "- local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))17 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings")) 19 18 (extension slib-prec-grammar 20 19 (types-file) 21 20 (component-dependencies slib-prec-parse) 22 (csc-options "-O3" "-d1" "- local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))21 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings")) 23 22 (extension slib-prec-parse 24 23 (types-file) 25 24 ;suspect -strict-types might be an issue 26 (csc-options "-O3" "-d1" "- local" "-D" "utf8" "-no-procedure-checks-for-toplevel-bindings"))25 (csc-options "-O3" "-d1" "-D" "utf8" "-no-procedure-checks-for-toplevel-bindings")) 27 26 (extension slib-basic-grammars 28 27 (types-file) 29 28 (component-dependencies slib-prec-parse slib-prec-grammar) 30 (csc-options "-O3" "-d1" "- local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))29 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings")) 31 30 (extension slib-standard-grammar 32 31 (types-file) 33 32 (component-dependencies slib-prec-parse slib-prec-grammar) 34 (csc-options "-O3" "-d1" "- local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))33 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings")) 35 34 (extension slib-tex-grammar 36 35 (types-file) 37 36 (component-dependencies slib-prec-parse slib-prec-grammar) 38 (csc-options "-O3" "-d1" "- local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))37 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings")) 39 38 (extension slib-prec 40 39 (types-file) 41 40 (component-dependencies slib-prec-grammar slib-prec-parse slib-standard-grammar slib-basic-grammars) 42 (csc-options "-O3" "-d1" "- local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings")) ) )41 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings")) ) ) -
release/5/slib-prec/trunk/slib-prec.scm
r38716 r38717 1 1 ;;;; slib-prec.scm -*-scheme-*- 2 2 ;;;; Kon Lovett, Apr '20 3 ;;;; Kon Lovett, Apr '184 3 5 4 ;; Issues … … 7 6 ;; - needs a "surface notation" 8 7 9 (module slib-prec 10 11 (;export 12 read-sexp-from-string) 8 (module slib-prec () 13 9 14 10 (import scheme) … … 21 17 (import slib-prec-grammar) 22 18 (reexport slib-prec-grammar) 23 24 ;defgrammar doesn't define25 (import slib-basic-grammars)26 (import slib-standard-grammar)27 (import slib-tex-grammar)28 29 ;;30 31 (define (read-sexp-from-string str #!optional (grm (active-input-grammar)) (column 0))32 (import (only (chicken port) with-input-from-string))33 (with-input-from-string str (cut read-sexp grm column)) )34 19 35 20 ;;; -
release/5/slib-prec/trunk/tests/slib-prec-test.scm
r38716 r38717 1 ;;;; slib-prec-test.scm 1 ;;;; slib-prec-test.scm -*- scheme -*- 2 ;;;; Kon Lovett, Apr '20 2 3 3 4 (import test) … … 18 19 19 20 (define ^ expt) 21 (define mod modulo) 20 22 21 23 ;; 22 24 25 ;defgrammar doesn't `define' 26 (import slib-basic-grammars) 27 (import slib-standard-grammar) 28 (import slib-tex-grammar) 29 23 30 ;init by id-# grammar lookup 24 ;(define-constant DEFAULT-GRAMMARS '(standard disp2d tex null scheme schemepretty)) 25 (define DEFAULT-GRAMMARS '(standard disp2d tex null scheme schemepretty)) 31 (define-constant TEST-GRAMMARS '(standard disp2d tex null scheme schemepretty)) 26 32 (clear-grammar-ids) 27 (grammar-id-name-setup! DEFAULT-GRAMMARS) 28 ;(grammar-id-name-setup! `(,@DEFAULT-GRAMMARS)) 29 33 (grammar-id-name-setup! TEST-GRAMMARS) 30 34 (active-grammar-set! 'standard #f 'schemepretty) 31 35 … … 33 37 34 38 (test-group "Grammer IDs" 35 (test (length DEFAULT-GRAMMARS) (count-of-grammar-ids))39 (test (length TEST-GRAMMARS) (count-of-grammar-ids)) 36 40 (test 'standard (grammar-id-name 0)) 37 41 (test 'scheme (grammar-id-name 4))
Note: See TracChangeset
for help on using the changeset viewer.