-
Notifications
You must be signed in to change notification settings - Fork 0
/
parse-square-brackets.rkt
149 lines (104 loc) · 5.8 KB
/
parse-square-brackets.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
;; This file is part of Scheme
;; Copyright 2024 Damien MATTEI
;; This program 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.
;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
;; code from R6RS version
;; some optimizer procedures that parse square brackets arguments
(module parse-square-brackets racket/base
(provide parse-square-brackets-arguments-lister-syntax)
(require Scheme+/def
Scheme+/declare
Scheme+/block
Scheme+/syntax
Scheme+/slice
Scheme+/infix-with-precedence-to-prefix
Scheme+/infix
Scheme+/operators
Scheme+/operators-list
Scheme+/insert)
;; split the expression using slice as separator
(def (parse-square-brackets-arguments args-brackets creator operator-precedence operators-lst)
;;(display "parse-square-brackets-arguments : args-brackets=") (display args-brackets) (newline)
;;(define operators-lst (apply append operator-precedence)) ; this already exist in operators-list module
(when (null? args-brackets)
(return args-brackets))
(declare result partial-result) ; '() at beginning
(def (psba args) ;; parse square brackets arguments ,note: it is a tail-recursive function (see end)
;;(display "psba : args=") (display args) (newline)
;;(display "psba : partial-result =") (display partial-result) (newline)
(when (null? args)
;;(display "before !*prec") (newline)
;;(display "null args") (newline)
(if (infix? partial-result operators-lst)
($> ; then
;;(display "infix detected") (newline)
;;(display "psba : partial-result =") (display partial-result) (newline)
(append-tail-set! result (!*prec-generic-infix-parser partial-result
operator-precedence
creator)))
(begin
;;(display "NO infix detected") (newline)
(append-tail-set! result partial-result))) ; not infix
;; (display "after !*prec") (newline)
;;(display "psba when null args : result =") (display result) (newline)
;; (display "return-rec") (newline)
(return-rec result)) ;; return from all recursive calls, as it is tail recursive
(define fst (car args)) ; get the first token in the infix expression
;;(display "fst=") (display fst) (newline)
;; test here for ':' ??? for multi-dim arrays , that will remove the use of { } in [ ]
(if (datum=? slice fst) ; separator , end of infix expression
;; we have some job to do at the end of an infix expression
($> ; then
;;(display "slice detected") (newline)
;;(display "psba : partial-result =") (display partial-result) (newline)
(when (not (null? partial-result)) ;; check infix expression exist really
;;(display "not null") (newline)
;;(display "psba : result =") (display result) (newline)
;; check it is in infix, not already prefixed (we are in scheme...)
(if (infix? partial-result operators-lst) ;; operateurs quotés ou syntaxés !
(begin ; yes
;;(display "infix detected") (newline)
(append-tail-set! result (!*prec-generic-infix-parser partial-result
operator-precedence
creator))) ;; convert to prefix and store the expression
;; no
(begin
;;(display "NO infix detected") (newline)
(append-tail-set! result partial-result))) ; partial-result already atom, already infix
;;(display "psba : result =") (display result) (newline)
(set! partial-result '())) ;; empty for the next possible portion between slice operator
(insert-tail-set! result fst)) ;; append the slice operator
;; else : not slice
;; construct the list of the infix expression
(insert-tail-set! partial-result fst)) ;; not a slice operator but append it
;;(display "psba : result=") (display result) (newline)
;;(display "psba 2 : partial-result=") (display partial-result) (newline)
(psba (cdr args))) ;; end def, recurse (tail recursive) , continue with the rest of the infix token list
;;(display "parse-square-brackets-arguments : args-brackets=") (display args-brackets) (newline)
(define rs (psba args-brackets))
;;(display "parse-square-brackets-arguments : rs=") (display rs) (newline)
rs
) ;; initial call
;; (define (parse-square-brackets-arguments-lister args-brackets)
;; ;;(display "parse-square-brackets-arguments-lister : args-brackets=") (display args-brackets) (newline)
;; (parse-square-brackets-arguments args-brackets
;; (lambda (op a b) (list op a b))
;; infix-operators-lst-for-parser))
(define (parse-square-brackets-arguments-lister-syntax args-brackets)
;;(newline) (display "parse-square-brackets-arguments-lister-syntax : args-brackets=") (display args-brackets) (newline)
(when (not (list? args-brackets))
(display "parse-square-brackets-arguments-lister-syntax : WARNING , args-brackets is not a list, perheaps expander is not psyntax (Portable Syntax)") (newline)
(display "parse-square-brackets-arguments-lister-syntax : args-brackets=") (display args-brackets) (newline))
(parse-square-brackets-arguments args-brackets ;; generic procedure
(lambda (op a b) (list op a b))
infix-operators-lst-for-parser-syntax
operators-lst-syntax)) ;; defined elsewhere
) ; end module