add test for typed-lambda, define-macro in s7

analysis/abstract-interpreter.sls

@@ -63,6 +63,7 @@
     (scheme-langserver analysis identifier rules s7 define-macro)
     (scheme-langserver analysis identifier rules s7 define*)
     (scheme-langserver analysis identifier rules s7 lambda*)
+    (scheme-langserver analysis identifier rules s7 typed-lambda)
 
     (scheme-langserver analysis identifier self-defined-rules router)
 
@@ -261,6 +262,9 @@
 
             [(and (equal? r '(lambda*)) (private:top-env=? 's7 top))
               (private-add-rule rules `((,lambda*-process) . ,identifier))]
+
+            [(and (equal? r '(typed-lambda)) (private:top-env=? 's7 top))
+              (private-add-rule rules `((,typed-lambda-process) . ,identifier))]
 
             [else rules])
           (route&add 

analysis/identifier/rules/s7/define-macro.sls

@@ -17,31 +17,66 @@
     (scheme-langserver virtual-file-system file-node))
 
 ; reference-identifier-type include 
-; syntax-parameter 
+; procedure parameter
 ;https://www.zenlife.tk/scheme-hygiene-macro.md
 (define (define-macro-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) dummy0 ... ) dummy1 ... ) 
+        [(_ ((? symbol? identifier) . dummy0) dummy1 ... )
           (let* ([omg-index-node (cadr (index-node-children index-node))]
-            [key-index-nodes (index-node-children omg-index-node)]
-            [reference (make-identifier-reference 
-              identifier 
-              document 
-              (car key-index-nodes) 
-              index-node
-              '()
-              'syntax-parameter
-              '()
-              '())])
+              [reference (make-identifier-reference 
+                  identifier 
+                  document 
+                  omg-index-node
+                  index-node
+                  '()
+                  'procedure
+                  '()
+                  '())])
             (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-parent index-node)  `(,reference)))]
+            (append-references-into-ordered-references-for document (index-node-parent index-node)  `(,reference))
+            (let loop ([rest dummy0])
+              (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 '()]))))

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

@@ -0,0 +1,135 @@
+(library (scheme-langserver analysis identifier rules s7 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/s7/test-define-macro.sps

@@ -0,0 +1,38 @@
+#!/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 s7 define-macro)
+    (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-macro-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/scheme/boot.scm.txt")]
+            [document (file-node-document target-file-node)]
+            [target-index-node (caddr (document-index-node-list document))])
+
+            (define-macro-process root-file-node root-library-node document target-index-node)
+
+            (test-equal #f
+                (not 
+                    (find 
+                        (lambda (reference) 
+                            (equal? 'libname (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/s7/test-typed-lambda.sps

@@ -0,0 +1,38 @@
+#!/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 s7 typed-lambda)
+    (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 "typed-lambda-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) 122 6))])
+
+            (typed-lambda-process root-file-node root-library-node document target-index-node)
+            (test-equal #f
+                (not 
+                    (find 
+                        (lambda (reference) 
+                            (equal? 'str (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))