source: project/release/5/slib-prec/trunk/slib-prec-parse.scm @ 39829

Last change on this file since 39829 was 39829, checked in by Kon Lovett, 5 weeks ago

fix test runner fail exit pass-thru, add test runner config

File size: 4.4 KB
Line 
1;;;; slib-prec-parse.scm  -*-scheme-*-
2;;;; Kon Lovett, Apr '20
3
4;; Issues
5;;
6;; - needs a "surface notation"
7
8(module slib-prec-parse
9
10(;export
11  ;
12  syntax-end!                 ; (set! *syn-defs* '())   => (syntax-end!)
13  syntax-begin!               ; (set! *syn-defs* ...)   => (syntax-begin! ...)
14  syntax-current              ; *syn-def*               => (syntax-current)
15  syntax-ignore-whitespace    ; *syn-ignore-whitespace* => (syntax-ignore-whitespace)
16  ;
17  char-code-limit
18  tok:decimal-digits
19  tok:upper-case
20  tok:lower-case
21  tok:whitespaces
22  tok:char-group
23  tok:read-char
24  ;
25  prec:define-grammar
26  prec:parse
27  prec:make-led
28  prec:make-nud
29  prec:delim
30  prec:nofix
31  prec:prefix
32  prec:infix
33  prec:nary
34  prec:postfix
35  prec:prestfix
36  prec:commentfix
37  prec:matchfix
38  prec:inmatchfix)
39
40(import scheme)
41(import (chicken base))
42
43;;;
44
45(cond-expand
46  (utf8
47    (import (rename scheme
48        (char-whitespace? scheme:char-whitespace?)
49        (char-alphabetic? scheme:char-alphabetic?)
50        (char-upper-case? scheme:char-upper-case?)
51        (char-lower-case? scheme:char-lower-case?)
52        (char-numeric? scheme:char-numeric?)))
53    (import (chicken foreign))
54    (import utf8)
55    (import utf8-srfi-13)
56    (import utf8-case-map)
57    (import utf8-srfi-14)
58    (import unicode-char-sets)
59
60    ;; UTF-8 char predicates
61
62    (define charset-alphabetic?)
63    (define charset-upper-case?)
64    (define charset-lower-case?)
65    (define charset-whitespace?)
66    (define charset-numeric?)
67    (define charset-hex-numeric?)
68    (let ()
69      (define ((charset-predicate cs) ch) (char-set-contains? cs ch))
70      (set! charset-alphabetic? (charset-predicate char-set:alphabetic))
71      (set! charset-upper-case? (charset-predicate char-set:uppercase))
72      (set! charset-lower-case? (charset-predicate char-set:lowercase))
73      (set! charset-whitespace? (charset-predicate char-set:white-space))
74      (set! charset-numeric? (charset-predicate char-set:digit))
75      (set! charset-hex-numeric? (charset-predicate char-set:hex-digit)) )
76    (define char-hex-numeric? charset-hex-numeric?)
77
78    ;Character range is that of a UTF-8 codepoint, not representable range
79    (define char-code-limit (foreign-value "C_CHAR_BIT_MASK" unsigned-int)))
80  (else
81    (import srfi-13)
82    (import srfi-14)
83    ; "Extended" ASCII
84    (define char-code-limit 256)) )
85
86;; SLIB Code
87
88(import (only (chicken port) call-with-output-string))
89
90(include "slib-compat")
91
92(include "strsrch")
93
94; these shouldn't be literals
95(define *prec:comment-start* 200)
96(define *prec:comment-weight* 220)
97
98(include "prec")
99
100;FIXME fixes what by duplicating `tok:read-through-comment' behavior?
101(set! prec:commentfix (lambda (tk stp match . binds)
102  ;;from tok:read-through-comment
103  (set! match (if (char? match)
104                  (string match)
105                  (prec:de-symbolfy match)))
106  (append
107   (prec:make-nud tk prec:parse-nudcomment stp match (apply append binds))
108   (prec:make-led tk *prec:comment-weight* prec:parse-ledcomment stp match (apply append binds)))))
109
110(define (syntax-begin! #!optional (base '()))   (set! *syn-defs* base))
111(define (syntax-end!)                           (set! *syn-defs* '()))
112(define (syntax-current)                        *syn-defs*)
113(define (syntax-ignore-whitespace)              *syn-ignore-whitespace*)
114
115(include "prec-setup")
116
117;;
118
119(define (make-grammar src #!optional (base '()))
120  (let* (
121    (imd (*parse-grammer-source 'make-grammar src base))
122    (grm (*eval-grammer-form 'make-grammar imd base)) )
123    (syntax-begin! base)
124    (apply prec:define-grammar grm)
125    (syntax-current) ) )
126
127; tok <kind> <args>...
128;
129; <kind>
130;
131; _f                              delim
132;
133; f                               nofix       : sop
134;
135; f_f                             commentfix  : stp match rule1 ...
136;
137; fx fy                           prefix      : sop bp rule1 ...
138; xf yf                           postfix     : sop bp
139; xfx xfy yfx yfy                 infix       : sop lbp bp rule1 ...
140; xfx xfy yfx yfy                 infix       : sop lbp bp rule1 ...
141;
142; xfs                             nary        : sop bp
143; fs                              prestfix    : sop bp rule1 ...
144;
145; fxf                             matchfix    :  sop sep match rule1 ...
146; fyf                             inmatchfix  :  sop sep match lbp rule1 ...
147
148(define (*parse-grammer-source loc src base)
149  (begin) )
150
151(define (*eval-grammer-form loc imd base)
152  (begin) )
153
154) ;slib-prec-parse
Note: See TracBrowser for help on using the repository browser.