Skip to content

Commit ee645a4

Browse files
VSteveHLVSteveHL
committed
add let1 rule for goldfish
add typed-lambda rule for goldfish
1 parent f49d17e commit ee645a4

5 files changed

Lines changed: 426 additions & 0 deletions

File tree

‎analysis/identifier/rules/goldfish/let1.sls‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
(library (scheme-langserver analysis identifier rules goldfish let1)
2+
(export
3+
let1-process
4+
let1-parameter-process)
5+
(import
6+
(chezscheme)
7+
(ufo-match)
8+
9+
(ufo-try)
10+
11+
(scheme-langserver analysis identifier reference)
12+
13+
(scheme-langserver virtual-file-system index-node)
14+
(scheme-langserver virtual-file-system library-node)
15+
(scheme-langserver virtual-file-system document)
16+
(scheme-langserver virtual-file-system file-node))
17+
18+
; reference-identifier-type include
19+
; procedure variable
20+
(define (let1-process root-file-node root-library-node document index-node)
21+
(let* ([ann (index-node-datum/annotations index-node)]
22+
[expression (annotation-stripped ann)])
23+
(try
24+
(match expression
25+
[(_ (? symbol? identifier) fuzzy ... )
26+
(let* ([identifier-index-node (cadr (index-node-children index-node))]
27+
[exclude-list (let1-parameter-process index-node identifier-index-node index-node '() document 'variable)])
28+
(index-node-excluded-references-set! identifier-index-node exclude-list)
29+
exclude-list)]
30+
[else '()])
31+
(except c
32+
[else '()]))))
33+
34+
(define (let1-parameter-process initialization-index-node index-node let-node exclude document type)
35+
(let* ([ann (index-node-datum/annotations index-node)]
36+
[expression (annotation-stripped ann)]
37+
[reference
38+
(make-identifier-reference
39+
expression
40+
document
41+
index-node
42+
initialization-index-node
43+
'()
44+
type
45+
'()
46+
'())])
47+
(index-node-references-export-to-other-node-set!
48+
index-node
49+
(append
50+
(index-node-references-export-to-other-node index-node)
51+
`(,reference)))
52+
53+
(append-references-into-ordered-references-for document let-node `(,reference))
54+
55+
`(,reference)))
56+
)

‎analysis/identifier/rules/goldfish/typed-lambda.sls‎

Lines changed: 135 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,135 @@
1+
(library (scheme-langserver analysis identifier rules goldfish typed-lambda)
2+
(export
3+
typed-lambda-process
4+
typed-parameter-process)
5+
(import
6+
(chezscheme)
7+
(ufo-match)
8+
9+
(ufo-try)
10+
11+
(scheme-langserver analysis identifier reference)
12+
13+
(scheme-langserver virtual-file-system index-node)
14+
(scheme-langserver virtual-file-system library-node)
15+
(scheme-langserver virtual-file-system document)
16+
(scheme-langserver virtual-file-system file-node))
17+
18+
; reference-identifier-type include
19+
; parameter
20+
(define (typed-lambda-process root-file-node root-library-node document index-node)
21+
(let* ([ann (index-node-datum/annotations index-node)]
22+
[expression (annotation-stripped ann)])
23+
(try
24+
(match expression
25+
[(_ (identifier **1) fuzzy ... )
26+
(let loop ([rest (index-node-children (cadr (index-node-children index-node)))])
27+
(if (not (null? rest))
28+
(let* ([identifier-index-node (car rest)]
29+
[identifier-index-node-parent (index-node-parent identifier-index-node)])
30+
(let* ([ann (index-node-datum/annotations identifier-index-node)]
31+
[expression (annotation-stripped ann)])
32+
(match expression
33+
[(? symbol? x)
34+
(typed-parameter-process index-node identifier-index-node index-node '() document)]
35+
[(? pair? y)
36+
(let* ([sub-identifier-index-node (car (index-node-children identifier-index-node))]
37+
[sub-identifier-index-node-parent (index-node-parent sub-identifier-index-node)])
38+
(typed-parameter-process index-node sub-identifier-index-node index-node '() document))]))
39+
(loop (cdr rest)))))]
40+
41+
[(_ (? symbol? identifier) fuzzy ... )
42+
(typed-parameter-process index-node (cadr (index-node-children index-node)) index-node '() document)]
43+
[(_ (identifier . rest) fuzzy ... )
44+
(let* ([omg-index-node (cadr (index-node-children index-node))]
45+
[reference (make-identifier-reference
46+
identifier
47+
document
48+
omg-index-node
49+
index-node
50+
'()
51+
'parameter
52+
'()
53+
'())])
54+
(index-node-references-export-to-other-node-set!
55+
(identifier-reference-index-node reference)
56+
(append
57+
(index-node-references-export-to-other-node (identifier-reference-index-node reference))
58+
`(,reference)))
59+
(append-references-into-ordered-references-for document index-node `(,reference))
60+
(let loop ([rest rest])
61+
(cond
62+
[(pair? rest)
63+
(let ([reference (make-identifier-reference
64+
(car rest)
65+
document
66+
omg-index-node
67+
index-node
68+
'()
69+
'parameter
70+
'()
71+
'())])
72+
(index-node-references-export-to-other-node-set!
73+
(identifier-reference-index-node reference)
74+
(append
75+
(index-node-references-export-to-other-node (identifier-reference-index-node reference))
76+
`(,reference)))
77+
(append-references-into-ordered-references-for document index-node `(,reference)))
78+
(loop (cdr rest))]
79+
[(not (null? rest))
80+
(let ([reference (make-identifier-reference
81+
rest
82+
document
83+
omg-index-node
84+
index-node
85+
'()
86+
'parameter
87+
'()
88+
'())])
89+
(index-node-references-export-to-other-node-set!
90+
(identifier-reference-index-node reference)
91+
(append
92+
(index-node-references-export-to-other-node (identifier-reference-index-node reference))
93+
`(,reference)))
94+
(append-references-into-ordered-references-for document index-node `(,reference)))]
95+
[else '()])))]
96+
[else '()])
97+
(except c
98+
[else '()]))))
99+
100+
(define (typed-parameter-process initialization-index-node index-node lambda-node exclude document )
101+
(let* ([ann (index-node-datum/annotations index-node)]
102+
[expression (annotation-stripped ann)])
103+
(if (symbol? expression)
104+
(let ([reference
105+
(make-identifier-reference
106+
expression
107+
document
108+
index-node
109+
initialization-index-node
110+
'()
111+
'parameter
112+
'()
113+
'())])
114+
(index-node-references-export-to-other-node-set!
115+
index-node
116+
(append
117+
(index-node-references-export-to-other-node index-node)
118+
`(,reference)))
119+
120+
(index-node-references-import-in-this-node-set!
121+
lambda-node
122+
(sort-identifier-references
123+
(append
124+
(index-node-references-import-in-this-node lambda-node)
125+
`(,reference))))
126+
127+
(index-node-excluded-references-set!
128+
(index-node-parent index-node)
129+
(append
130+
(index-node-excluded-references index-node)
131+
exclude
132+
`(,reference)))
133+
`(,reference))
134+
'())))
135+
)

‎tests/analysis/identifier/rules/goldfish/test-let1.sps‎

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
#!/usr/bin/env scheme-script
2+
;; -*- mode: scheme; coding: utf-8 -*- !#
3+
;; Copyright (c) 2022 WANG Zheng
4+
;; SPDX-License-Identifier: MIT
5+
#!r6rs
6+
7+
(import (rnrs (6)) (srfi :64 testing)
8+
(scheme-langserver analysis workspace)
9+
(scheme-langserver analysis identifier reference)
10+
(scheme-langserver analysis identifier rules goldfish let1)
11+
(scheme-langserver analysis identifier rules let)
12+
(scheme-langserver analysis identifier rules library-import)
13+
(scheme-langserver analysis package-manager akku)
14+
15+
(scheme-langserver util text)
16+
(scheme-langserver protocol alist-access-object)
17+
18+
(scheme-langserver virtual-file-system index-node)
19+
(scheme-langserver virtual-file-system file-node)
20+
(scheme-langserver virtual-file-system document))
21+
22+
(test-begin "let-process")
23+
(let* ( [root-file-node (init-virtual-file-system "./util" '() (lambda (fuzzy) #t))]
24+
[root-library-node '()]
25+
[target-file-node (walk-file root-file-node "./util/matrix.sls")]
26+
[document (file-node-document target-file-node)]
27+
;; a let node
28+
[root-index-node (car (document-index-node-list document))]
29+
[target-index-node (pick-index-node-from `(,root-index-node) (text+position->int (document-text document) 13 2))])
30+
31+
(let-process root-file-node root-library-node document target-index-node)
32+
(test-equal #f
33+
(not
34+
(find
35+
(lambda (reference)
36+
(equal? 'rows-count (identifier-reference-identifier reference)))
37+
(index-node-references-import-in-this-node target-index-node)))))
38+
(test-end)
39+
40+
(test-begin "let1-process")
41+
(let* ( [root-file-node (init-virtual-file-system "./tests/resources/r7rs" '() (lambda (fuzzy) #t) 's7)]
42+
[root-library-node '()]
43+
[target-file-node (walk-file root-file-node "./tests/resources/r7rs/liii/base64.scm.txt")]
44+
[document (file-node-document target-file-node)]
45+
[root-index-node (car (document-index-node-list document))]
46+
[target-index-node (pick-index-node-from `(,root-index-node) (text+position->int (document-text document) 77 2))])
47+
48+
(let1-process root-file-node root-library-node document target-index-node)
49+
(test-equal #f
50+
(not
51+
(find
52+
(lambda (reference)
53+
(equal? 'byte2base64-N (identifier-reference-identifier reference)))
54+
(index-node-references-import-in-this-node target-index-node)))))
55+
56+
57+
(test-end)
58+
59+
(exit (if (zero? (test-runner-fail-count (test-runner-get))) 0 1))

‎tests/analysis/identifier/rules/goldfish/test-typed-lambda.sps‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
#!/usr/bin/env scheme-script
2+
;; -*- mode: scheme; coding: utf-8 -*- !#
3+
;; Copyright (c) 2022 WANG Zheng
4+
;; SPDX-License-Identifier: MIT
5+
#!r6rs
6+
7+
(import (rnrs (6)) (srfi :64 testing)
8+
(scheme-langserver analysis workspace)
9+
(scheme-langserver analysis identifier reference)
10+
(scheme-langserver analysis identifier rules goldfish typed-lambda)
11+
(scheme-langserver analysis package-manager akku)
12+
13+
(scheme-langserver util text)
14+
(scheme-langserver protocol alist-access-object)
15+
16+
(scheme-langserver virtual-file-system index-node)
17+
(scheme-langserver virtual-file-system file-node)
18+
(scheme-langserver virtual-file-system document))
19+
20+
(test-begin "typed-lambda-process")
21+
(let* ( [root-file-node (init-virtual-file-system "./tests/resources/r7rs" '() (lambda (fuzzy) #t) 's7)]
22+
[root-library-node '()]
23+
[target-file-node (walk-file root-file-node "./tests/resources/r7rs/liii/base64.scm.txt")]
24+
[document (file-node-document target-file-node)]
25+
[root-index-node (car (document-index-node-list document))]
26+
[target-index-node (pick-index-node-from `(,root-index-node) (text+position->int (document-text document) 122 6))])
27+
28+
(typed-lambda-process root-file-node root-library-node document target-index-node)
29+
(test-equal #f
30+
(not
31+
(find
32+
(lambda (reference)
33+
(equal? 'str (identifier-reference-identifier reference)))
34+
(index-node-references-import-in-this-node target-index-node)))))
35+
36+
37+
(test-end)
38+
39+
(exit (if (zero? (test-runner-fail-count (test-runner-get))) 0 1))
40+

0 commit comments

Comments
 (0)