add some rules for goldfish

analysis/identifier/rules/goldfish/define-case-class.sls

@@ -0,0 +1,79 @@
+(library (scheme-langserver analysis identifier rules goldfish define-case-class)
+  (export 
+    define-case-class-process
+    define-case-class-parameter-process)
+  (import 
+    (chezscheme) 
+    (ufo-match)
+
+    (ufo-try)
+
+    (scheme-langserver analysis identifier reference)
+
+    (scheme-langserver virtual-file-system index-node)
+    (scheme-langserver virtual-file-system library-node)
+    (scheme-langserver virtual-file-system document)
+    (scheme-langserver virtual-file-system file-node))
+
+; reference-identifier-type include 
+; parameter 
+(define (define-case-class-process root-file-node root-library-node document index-node)
+  (let* ([ann (index-node-datum/annotations index-node)]
+      [expression (annotation-stripped ann)])
+    (try
+      (match expression
+        [(_ _name (identifier **1) fuzzy ... )
+          (let loop ([rest (index-node-children (caddr (index-node-children index-node)))])
+            (if (not (null? rest))
+              (let* ([identifier-index-node (car rest)]
+                  [identifier-index-node-parent (index-node-parent identifier-index-node)])
+                (let* ([ann (index-node-datum/annotations identifier-index-node)]
+                  [expression (annotation-stripped ann)])
+                  (match expression
+                    [(? symbol? x)
+                      (define-case-class-parameter-process index-node identifier-index-node index-node '() document)]
+                    [(? pair? y)
+                      (let* ([sub-identifier-index-node (car (index-node-children identifier-index-node))]
+                        [sub-identifier-index-node-parent (index-node-parent sub-identifier-index-node)])
+                        (define-case-class-parameter-process index-node sub-identifier-index-node index-node '() document))]))
+                (loop (cdr rest)))))]
+        [else '()])
+      (except c
+        [else '()]))))
+
+(define (define-case-class-parameter-process initialization-index-node index-node lambda-node exclude document )
+  (let* ([ann (index-node-datum/annotations index-node)]
+      [expression (annotation-stripped ann)])
+    (if (symbol? expression)
+      (let ([reference 
+            (make-identifier-reference
+              expression
+              document
+              index-node
+              initialization-index-node
+              '()
+              'parameter
+              '()
+              '())])
+        (index-node-references-export-to-other-node-set! 
+          index-node
+          (append 
+            (index-node-references-export-to-other-node index-node)
+            `(,reference)))
+
+        (index-node-references-import-in-this-node-set! 
+          lambda-node
+          (sort-identifier-references 
+            (append 
+              (index-node-references-import-in-this-node lambda-node)
+              `(,reference))))
+
+        (index-node-excluded-references-set! 
+          (index-node-parent index-node)
+          (append 
+            (index-node-excluded-references index-node)
+            exclude
+            `(,reference)))
+        `(,reference))
+      '())))
+)

analysis/identifier/rules/goldfish/let1.sls

@@ -0,0 +1,56 @@
+(library (scheme-langserver analysis identifier rules goldfish let1)
+  (export 
+    let1-process
+    let1-parameter-process)
+  (import 
+    (chezscheme) 
+    (ufo-match)
+
+    (ufo-try)
+
+    (scheme-langserver analysis identifier reference)
+
+    (scheme-langserver virtual-file-system index-node)
+    (scheme-langserver virtual-file-system library-node)
+    (scheme-langserver virtual-file-system document)
+    (scheme-langserver virtual-file-system file-node))
+
+; reference-identifier-type include 
+; procedure variable 
+(define (let1-process root-file-node root-library-node document index-node)
+  (let* ([ann (index-node-datum/annotations index-node)]
+      [expression (annotation-stripped ann)])
+    (try
+      (match expression
+        [(_ (? symbol? identifier) fuzzy ... )
+          (let* ([identifier-index-node (cadr (index-node-children index-node))]
+                 [exclude-list (let1-parameter-process index-node identifier-index-node index-node '() document 'variable)])
+            (index-node-excluded-references-set! identifier-index-node exclude-list)
+            exclude-list)]
+        [else '()])
+      (except c
+        [else '()]))))
+
+(define (let1-parameter-process initialization-index-node index-node let-node exclude document type)
+  (let* ([ann (index-node-datum/annotations index-node)]
+      [expression (annotation-stripped ann)]
+      [reference 
+        (make-identifier-reference
+          expression
+          document
+          index-node
+          initialization-index-node
+          '()
+          type
+          '()
+          '())])
+    (index-node-references-export-to-other-node-set! 
+      index-node
+      (append 
+        (index-node-references-export-to-other-node index-node)
+          `(,reference)))
+
+    (append-references-into-ordered-references-for document let-node `(,reference))
+
+    `(,reference)))
+)

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

@@ -0,0 +1,135 @@
+(library (scheme-langserver analysis identifier rules goldfish typed-lambda)
+  (export 
+    typed-lambda-process
+    typed-parameter-process)
+  (import 
+    (chezscheme) 
+    (ufo-match)
+
+    (ufo-try)
+
+    (scheme-langserver analysis identifier reference)
+
+    (scheme-langserver virtual-file-system index-node)
+    (scheme-langserver virtual-file-system library-node)
+    (scheme-langserver virtual-file-system document)
+    (scheme-langserver virtual-file-system file-node))
+
+; reference-identifier-type include 
+; parameter 
+(define (typed-lambda-process root-file-node root-library-node document index-node)
+  (let* ([ann (index-node-datum/annotations index-node)]
+      [expression (annotation-stripped ann)])
+    (try
+      (match expression
+        [(_ (identifier **1) fuzzy ... )
+          (let loop ([rest (index-node-children (cadr (index-node-children index-node)))])
+            (if (not (null? rest))
+              (let* ([identifier-index-node (car rest)]
+                  [identifier-index-node-parent (index-node-parent identifier-index-node)])
+                (let* ([ann (index-node-datum/annotations identifier-index-node)]
+                  [expression (annotation-stripped ann)])
+                  (match expression
+                    [(? symbol? x)
+                      (typed-parameter-process index-node identifier-index-node index-node '() document)]
+                    [(? pair? y)
+                      (let* ([sub-identifier-index-node (car (index-node-children identifier-index-node))]
+                        [sub-identifier-index-node-parent (index-node-parent sub-identifier-index-node)])
+                        (typed-parameter-process index-node sub-identifier-index-node index-node '() document))]))
+                (loop (cdr rest)))))]
+
+        [(_ (? symbol? identifier) fuzzy ... ) 
+          (typed-parameter-process index-node (cadr (index-node-children index-node)) index-node '() document)]
+        [(_ (identifier . rest) fuzzy ... ) 
+          (let* ([omg-index-node (cadr (index-node-children index-node))]
+              [reference (make-identifier-reference 
+                  identifier 
+                  document 
+                  omg-index-node
+                  index-node
+                  '()
+                  'parameter
+                  '()
+                  '())])
+            (index-node-references-export-to-other-node-set! 
+              (identifier-reference-index-node reference)
+              (append 
+                (index-node-references-export-to-other-node (identifier-reference-index-node reference))
+                `(,reference)))
+            (append-references-into-ordered-references-for document index-node `(,reference))
+            (let loop ([rest rest])
+              (cond 
+                [(pair? rest) 
+                  (let ([reference (make-identifier-reference 
+                      (car rest)
+                      document 
+                      omg-index-node
+                      index-node
+                      '()
+                      'parameter
+                      '()
+                      '())])
+                    (index-node-references-export-to-other-node-set! 
+                      (identifier-reference-index-node reference)
+                      (append 
+                        (index-node-references-export-to-other-node (identifier-reference-index-node reference))
+                        `(,reference)))
+                    (append-references-into-ordered-references-for document index-node `(,reference)))
+                  (loop (cdr rest))]
+                [(not (null? rest)) 
+                  (let ([reference (make-identifier-reference 
+                      rest
+                      document 
+                      omg-index-node
+                      index-node
+                      '()
+                      'parameter
+                      '()
+                      '())])
+                    (index-node-references-export-to-other-node-set! 
+                      (identifier-reference-index-node reference)
+                      (append 
+                        (index-node-references-export-to-other-node (identifier-reference-index-node reference))
+                        `(,reference)))
+                    (append-references-into-ordered-references-for document index-node `(,reference)))]
+                [else '()])))]
+        [else '()])
+      (except c
+        [else '()]))))
+
+(define (typed-parameter-process initialization-index-node index-node lambda-node exclude document )
+  (let* ([ann (index-node-datum/annotations index-node)]
+      [expression (annotation-stripped ann)])
+    (if (symbol? expression)
+      (let ([reference 
+            (make-identifier-reference
+              expression
+              document
+              index-node
+              initialization-index-node
+              '()
+              'parameter
+              '()
+              '())])
+        (index-node-references-export-to-other-node-set! 
+          index-node
+          (append 
+            (index-node-references-export-to-other-node index-node)
+            `(,reference)))
+
+        (index-node-references-import-in-this-node-set! 
+          lambda-node
+          (sort-identifier-references 
+            (append 
+              (index-node-references-import-in-this-node lambda-node)
+              `(,reference))))
+
+        (index-node-excluded-references-set! 
+          (index-node-parent index-node)
+          (append 
+            (index-node-excluded-references index-node)
+            exclude
+            `(,reference)))
+        `(,reference))
+      '())))
+)

tests/analysis/identifier/rules/goldfish/test-define-case-class.sps

@@ -0,0 +1,42 @@
+#!/usr/bin/env scheme-script
+;; -*- mode: scheme; coding: utf-8 -*- !#
+;; Copyright (c) 2025 WANG Zheng, HUANG zengqian
+;; SPDX-License-Identifier: MIT
+#!r6rs
+
+(import (rnrs (6)) (srfi :64 testing) 
+    (scheme-langserver analysis workspace)
+    (scheme-langserver analysis identifier reference)
+    (scheme-langserver analysis identifier rules goldfish define-case-class)
+    (scheme-langserver analysis identifier rules let)
+    (scheme-langserver analysis identifier rules library-import)
+    (scheme-langserver analysis package-manager akku)
+
+    (scheme-langserver util text)
+    (scheme-langserver protocol alist-access-object)
+
+    (scheme-langserver virtual-file-system index-node)
+    (scheme-langserver virtual-file-system file-node)
+    (scheme-langserver virtual-file-system document))
+
+(test-begin "define-case-class-process")
+    (let* ( [root-file-node (init-virtual-file-system "./tests/resources/r7rs" '() (lambda (fuzzy) #t) 's7)]
+            [root-library-node '()]
+            [target-file-node (walk-file root-file-node "./tests/resources/r7rs/liii/rich-vector.scm.txt")]
+            [document (file-node-document target-file-node)]
+            [root-index-node (car (document-index-node-list document))]
+            [target-index-node (pick-index-node-from `(,root-index-node) (text+position->int (document-text document) 22 0))])
+
+            (define-case-class-process root-file-node root-library-node document target-index-node)
+
+            (test-equal #f
+                (not 
+                    (find 
+                        (lambda (reference) 
+                            (equal? 'data (identifier-reference-identifier reference)))
+                        (index-node-references-import-in-this-node target-index-node)))))
+
+
+(test-end)
+
+(exit (if (zero? (test-runner-fail-count (test-runner-get))) 0 1))

tests/analysis/identifier/rules/goldfish/test-define-class.sps

@@ -0,0 +1,41 @@
+#!/usr/bin/env scheme-script
+;; -*- mode: scheme; coding: utf-8 -*- !#
+;; Copyright (c) 2025 WANG Zheng, HUANG zengqian
+;; SPDX-License-Identifier: MIT
+#!r6rs
+
+(import (rnrs (6)) (srfi :64 testing) 
+    (scheme-langserver analysis workspace)
+    (scheme-langserver analysis identifier reference)
+    (scheme-langserver analysis identifier rules goldfish define-case-class)
+    (scheme-langserver analysis identifier rules let)
+    (scheme-langserver analysis identifier rules library-import)
+    (scheme-langserver analysis package-manager akku)
+
+    (scheme-langserver util text)
+    (scheme-langserver protocol alist-access-object)
+
+    (scheme-langserver virtual-file-system index-node)
+    (scheme-langserver virtual-file-system file-node)
+    (scheme-langserver virtual-file-system document))
+
+(test-begin "define-case-class-process")
+    (let* ( [root-file-node (init-virtual-file-system "./tests/resources/r7rs" '() (lambda (fuzzy) #t) 's7)]
+            [root-library-node '()]
+            [target-file-node (walk-file root-file-node "./tests/resources/r7rs/liii/logging.scm.txt")]
+            [document (file-node-document target-file-node)]
+            [root-index-node (car (document-index-node-list document))]
+            [target-index-node (pick-index-node-from `(,root-index-node) (text+position->int (document-text document) 32 4))])
+
+            (define-case-class-process root-file-node root-library-node document target-index-node)
+
+            (test-equal #f
+                (not 
+                    (find 
+                        (lambda (reference) 
+                            (equal? 'log-path (identifier-reference-identifier reference)))
+                        (index-node-references-import-in-this-node target-index-node)))))
+
+(test-end)
+
+(exit (if (zero? (test-runner-fail-count (test-runner-get))) 0 1))

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

@@ -0,0 +1,41 @@
+#!/usr/bin/env scheme-script
+;; -*- mode: scheme; coding: utf-8 -*- !#
+;; Copyright (c) 2025 WANG Zheng, HUANG zengqian
+;; SPDX-License-Identifier: MIT
+#!r6rs
+
+(import (rnrs (6)) (srfi :64 testing) 
+    (scheme-langserver analysis workspace)
+    (scheme-langserver analysis identifier reference)
+    (scheme-langserver analysis identifier rules goldfish let1)
+    (scheme-langserver analysis identifier rules let)
+    (scheme-langserver analysis identifier rules library-import)
+    (scheme-langserver analysis package-manager akku)
+
+    (scheme-langserver util text)
+    (scheme-langserver protocol alist-access-object)
+
+    (scheme-langserver virtual-file-system index-node)
+    (scheme-langserver virtual-file-system file-node)
+    (scheme-langserver virtual-file-system document))
+
+(test-begin "let1-process")
+    (let* ( [root-file-node (init-virtual-file-system "./tests/resources/r7rs" '() (lambda (fuzzy) #t) 's7)]
+            [root-library-node '()]
+            [target-file-node (walk-file root-file-node "./tests/resources/r7rs/liii/base64.scm.txt")]
+            [document (file-node-document target-file-node)]
+            [root-index-node (car (document-index-node-list document))]
+            [target-index-node (pick-index-node-from `(,root-index-node) (text+position->int (document-text document) 77 2))])
+
+            (let1-process root-file-node root-library-node document target-index-node)
+            (test-equal #f
+                (not 
+                    (find 
+                        (lambda (reference) 
+                            (equal? 'byte2base64-N (identifier-reference-identifier reference)))
+                        (index-node-references-import-in-this-node target-index-node)))))
+
+
+(test-end)
+
+(exit (if (zero? (test-runner-fail-count (test-runner-get))) 0 1))