Merge pull request #37 from ufo5260987423/new-type-inference

1.1.1

Akku.manifest

@@ -1,7 +1,7 @@
 #!r6rs ; -*- mode: scheme; coding: utf-8 -*-
 (import (akku format manifest))
 
-(akku-package ("scheme-langserver" "1.1.0")
+(akku-package ("scheme-langserver" "1.1.1")
   (synopsis
    "This package is a language server protocol implementation helping scheme programming.")
   (authors "WANG Zheng")

LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2022-2023 WANG Zheng
+Copyright (c) 2022-NOW WANG Zheng
 Valid-License-Identifier: MIT
 
 Permission is hereby granted, free of charge, to any person obtaining a

README.md

@@ -1,28 +1,28 @@
 ![](./doc/figure/logo-no-background.png)
 # Scheme-langserver
->NOTE: This language server is mainly for scheme code with .scm, .ss, .sls and .sld extensions. And packages should be imported with Akku for now. And there're many many problems for type inference, I'm just fixing them, please be patient. Thank you.
+>NOTE: There're many many bugs in scheme-langserver, and parts of them may be lead from the high-level functions like identifier catching in incomplete code and type inference. I'm just fixing and appealing help from the community. Please be patient.
 
 Implementing support like autocomplete, goto definition, or documentation on hover is a significant effort for programming. However, comparing to other language like java, python, javascript and c, language server protocol implementation for lisp language are just made in a vacuum. [Geiser](https://gitlab.com/emacs-geiser), [racket langserver](https://github.com/jeapostrophe/racket-langserver) and [swish-lint](https://github.com/becls/swish-lint) etc., their works are all based on `repl`(Read-Eval-Print Loop) or keyword tokenizer instead of programming. For example, if a programmer was coding on an unaccomplished project, in which the codes were not fully runnable, [Geiser](https://gitlab.com/emacs-geiser) or any others would only complete top-level binding identifiers listed by `environment-symbols` procedure (for [Chez](https://cisco.github.io/ChezScheme/)). Which means for local bindings and unaccomplished codes, though making effort for programming is supposed of the importance mostly, [Geiser](https://gitlab.com/emacs-geiser) and its counterparts help nothing. Familiar cases occur with goto definition and many other functionalities.
 
-A primary cause is, for scheme and other lisp dialects, their abundant data sets and flexible control structures raise program analysis a big challenge. Especially the dynamic type system and macro, it seems like that scheme is mainly used for genius and meta/macro programming. But I say, no! Scheme can do many interesting things if a better programming environment was provided. And now I'll work on this.
+A primary cause is, for scheme and other lisp dialects, their abundant data sets and flexible control structures raise program analysis a big challenge. Especially the dynamic type system and macro, it seems like that scheme is mainly used for genius and meta/macro programming. But I say no. Scheme can make many interesting things if a better programming environment is provided. And now I'll work on this.
 
 This package is a language server protocol implementation helping scheme programming. It provides completion, definition and type inference. These functionalities are established on static code analysis with [r6rs standard](http://www.r6rs.org/) and some obvious rules for unaccomplished codes. This package itself and related libraries are published or going to be published with [Akku](https://akkuscm.org/), which is a package manager for Scheme. 
 
-This package also has been tested with [Chez Scheme](https://cisco.github.io/ChezScheme/) versions 9.4 and 9.5. 
+This package also has been tested with [Chez Scheme](https://cisco.github.io/ChezScheme/) versions 9.4 and 9.5. A detailed test on version 10.0.0 will be done after upgrading my laptop with nixOS.
 
 I do this open source work just in my spare time and I can contribute many splendid ideas to the community like embedding data flow analysis into scheme-langserver or many other things. And I'm continuously asking for much more donation or funding. You can click [this patreon page](https://www.patreon.com/PoorProgrammer/membership) or [爱发电](https://afdian.net/a/ufo5260987423) to donate monthly, or just donate 10 USD just once time with the following paypal link. 
 
 [![paypal](https://www.paypalobjects.com/en_US/i/btn/btn_donateCC_LG.gif)](https://www.paypal.com/paypalme/ufo5260987423/10)
 
 ## Recent Status
-I'll keep fixing bugs, profiling the code, and collecting information for my giant book(in Chinese, but if foreigners are interested in it, an English version will be considered.) on this homemade DSL and background mechanism. This will take me about 1 or 2 years. Further developments including a [VScode](https://code.visualstudio.com/) plugin and data flow analysis. But actually, I'm now setting this open source work a part-time job, and I can not guarantee a schedule.
+I'll keep fixing bugs, profiling the code, and collecting information for my giant book on homemade type inference system (in Chinese, but if foreigners are interested in it, an English version will be considered.). This will take me about 1 or 2 years. Further developments including a [VScode](https://code.visualstudio.com/) plugin and data flow analysis. But actually, I'm now setting this open source work a part-time job, and I can not guarantee a schedule.
 
-I'm now visiting [Coimbra University](https://www.google.com.hk/maps/place/University+of+Coimbra/@40.2151996,-8.4224772,13z/data=!4m6!3m5!1s0xd22f909b72d402f:0x2c4969e6ec176a72!8m2!3d40.2076394!4d-8.4260932!16zL20vMDM1NjV5?entry=ttu), would anyone want to visit me?(Please make me an appointment)
+I'm now visiting [Coimbra University](https://www.google.com.hk/maps/place/University+of+Coimbra/@40.2151996,-8.4224772,13z/data=!4m6!3m5!1s0xd22f909b72d402f:0x2c4969e6ec176a72!8m2!3d40.2076394!4d-8.4260932!16zL20vMDM1NjV5?entry=ttu), would anyone visit me? 
 
 ### Release 
-1.1.0: Type inference has been embedded into autocompletion! And it uses a homemade DSL(Domain Specific Language) making type representation and interpreting much easier.  But, I actually do not recommend anyone use this type inference in production because there are many efficiency and soundness problems which I haven't solved. A detailed outline should be referred in [documentation](#detailed-document).
+1.1.1: Scheme-langserver now releases type information used in corresponding libraries! As previous 1.1.0 version, I don't recommend anyone use such information in production because of soundness problem. A detailed outline should be referred in [documentation](#detailed-document).
 
-More details refer to [this file](./doc/release-log.md).
+Previous release refer to [this file](./doc/release-log.md).
 ## Setup
 ### Building
 #### Pre-require
@@ -173,6 +173,7 @@ send-message
 17. Code eval.
 18. Code diagnostic.
 19. Add cross-language semantic supporting. Well, would java, c, python and many other languages can be supported with an AST transformer?
+20. Extract expression/statements into a procedure()
 
 ## TODO:Contributing 
 

analysis/dependency/file-linkage.sls

@@ -20,7 +20,6 @@
     refresh-file-linkage&get-refresh-path
     get-init-reference-path)
   (import 
-    ; (rnrs)
     (chezscheme)
     (scheme-langserver analysis util)
 
@@ -48,9 +47,6 @@
     (init-maps root-library-node id->path-map path->id-map)
     (let ([matrix (make-vector (* (hashtable-size id->path-map) (hashtable-size id->path-map)))])
       (init-matrix root-library-node root-library-node path->id-map matrix)
-      ; (let ([cycle (find-cycle matrix)])
-      ;   (if (not (null? cycle))
-      ;     (raise-continuable (map (lambda (id) (hashtable-ref id->path-map id #f)) cycle))))
       (make-file-linkage path->id-map id->path-map matrix))))
 
 (define (init-maps current-library-node id->path-map path->id-map)
@@ -117,7 +113,6 @@
       (map (lambda (id) (hashtable-ref id->path-map id #f)) (linkage-matrix-from-recursive matrix from-node-id))
       '())))
 
-;; this procedure won't be trouble with graph cycle
 (define (get-init-reference-path linkage)
   (let* ([node-count (sqrt (vector-length (file-linkage-matrix linkage)))]
       [visited-ids (make-vector node-count)]

analysis/dependency/rules/library-import.sls

@@ -18,6 +18,7 @@
         [expression (annotation-stripped ann)])
       (match expression
         [('library _ **1 ) (map match-import (index-node-children index-node))]
+        [('define-library _ **1 ) (map match-import (index-node-children index-node))]
         [else (list (match-import index-node))]))))
 
 (define (match-import index-node)
@@ -39,6 +40,8 @@
         [('except (identifier **1) _ ...) identifier]
         [('prefix (identifier **1) _ ...) identifier]
         [('rename (identifier **1) _ ...) identifier]
+        [('for (identifier **1) 'run ...) identifier]
+        [('for (identifier **1) '(meta 0) ...) identifier]
         [(identifier **1) identifier]
         [else '()]))))
 )

analysis/identifier/meta.sls

@@ -7,7 +7,6 @@
      (only (chezscheme) pretty-print print-graph)
      (ufo-match)
      (scheme-langserver util binary-search)
-     (scheme-langserver util natural-order-compare)
      (scheme-langserver analysis identifier reference)
      (scheme-langserver analysis type substitutions rnrs-meta-rules)
      (scheme-langserver analysis type domain-specific-language variable))
@@ -87,7 +86,7 @@
                 (binary-search
                   (list->vector rnrs-chez-rules)
                   (lambda (target0 target1)
-                    (natural-order-compare 
+                    (string<=? 
                       (symbol->string (car target0))
                       (symbol->string (car target1))))
                   (list (identifier-reference-identifier identifier-reference))))

analysis/identifier/reference.sls

@@ -35,7 +35,7 @@
 
     (scheme-langserver util binary-search)
     (scheme-langserver util contain)
-    (scheme-langserver util natural-order-compare))
+    )
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define-record-type identifier-reference
   (fields
@@ -146,7 +146,7 @@
 (define (sort-identifier-references identifier-references)
   (sort 
     (lambda (target1 target2) 
-      (natural-order-compare 
+      (string<=?
         (symbol->string (identifier-reference-identifier target1))
         (symbol->string (identifier-reference-identifier target2))))
     identifier-references))
@@ -190,6 +190,7 @@
                 (contain? sibling index-node)
                 (match (annotation-stripped (index-node-datum/annotations grandparent))
                   [('library _ ...) (not (equal? (cadr (index-node-children grandparent)) parent))]
+                  [('define-library _ ...) (not (equal? (cadr (index-node-children grandparent)) parent))]
                   [else #f])))))])
     (if (null? parent)
       #f
@@ -198,6 +199,10 @@
           (and 
             (equal? (cadr (index-node-children parent)) index-node)
             (not (check?)))]
+        [('define-library identifier _ ...) 
+          (and 
+            (equal? (cadr (index-node-children parent)) index-node)
+            (not (check?)))]
         [('import identifier **1) (check?)]
         [('only identifier _ ...) (check?)]
         [('rename identifier _ ...) (check?)]
@@ -239,7 +244,7 @@
         (binary-search
           (list->vector reference-list)
           (lambda (reference0 reference1)
-            (natural-order-compare 
+            (string<=?
               (symbol->string (identifier-reference-identifier reference0))
               (symbol->string (identifier-reference-identifier reference1))))
           (make-identifier-reference identifier '() '() '() '() '() '() '()))])

analysis/identifier/rules/library-export.sls

@@ -27,6 +27,10 @@
         (map 
           (lambda (child-node) (match-export index-node root-file-node document library-identifiers child-node))
           (index-node-children index-node))]
+      [('define-library (library-identifiers **1) _ **1 ) 
+        (map 
+          (lambda (child-node) (match-export index-node root-file-node document library-identifiers child-node))
+          (index-node-children index-node))]
       [else '()])
     index-node))
 
@@ -72,7 +76,7 @@
                       library-identifiers
                       'pointer
                       references
-                      '()))))
+                      (apply append (map identifier-reference-type-expressions references))))))
               `(,@result ,external-index-node)))
           '()
           (cdr (index-node-children index-node)))]
@@ -93,8 +97,8 @@
                   initialization-index-node 
                   library-identifiers
                   'pointer
-                  '()
-                  '()))
+                  references
+                  (apply append (map identifier-reference-type-expressions references))))
                 references))))]
       [else '()])))
 )

analysis/identifier/rules/library-import.sls

@@ -28,6 +28,11 @@
         (map 
           (lambda (child-node) (match-import index-node root-file-node root-library-node document child-node))
           (index-node-children index-node))]
+      [('define-library _ **1 ) 
+      ; this should not use 'guard', because it follows the r7rs library mechanism(in sld)
+        (map 
+          (lambda (child-node) (match-import index-node root-file-node root-library-node document child-node))
+          (index-node-children index-node))]
       [else 
       ; this makes sense for ss/scm files
         (try
@@ -174,7 +179,7 @@
                     (identifier-reference-library-identifier reference)
                     'pointer
                     `(,reference)
-                    '())) 
+                    (identifier-reference-type-expressions reference))) 
                 imported-references)])
           ;;todo: add something to export-to-other-node for current-index-node?
           (if (null? grand-parent-index-node)
@@ -218,7 +223,7 @@
                         (identifier-reference-library-identifier reference)
                         'pointer
                         `(,reference)
-                        '())) 
+                        (identifier-reference-type-expressions reference))) 
                     current-references)])
 
               (index-node-references-import-in-this-node-set! 
@@ -283,7 +288,7 @@
                         (identifier-reference-library-identifier reference)
                         'pointer
                         `(,reference)
-                        '())) 
+                        (identifier-reference-type-expressions reference)))
                     current-references)])
 
               (index-node-references-import-in-this-node-set! 
@@ -328,6 +333,22 @@
                   (lambda (reference) 
                     (not (equal? current-external-name (identifier-reference-identifier reference))))
                   imported-references)))))]
+      [('for (library-identifier **1) import-level) 
+        (if (or
+            (equal? 'run import-level)
+            (equal? '(meta 0) import-level)
+            ; (equal? 'expand import-level)
+            ; (equal? '(meta 1) import-level)
+            )
+          (let ([tmp (filter identifier-reference? (import-references root-library-node library-identifier))])
+            (if (null? grand-parent-index-node)
+              (document-reference-list-set! 
+                document
+                (sort-identifier-references (append (document-reference-list document) tmp)))
+              (index-node-references-import-in-this-node-set! 
+                grand-parent-index-node 
+                (sort-identifier-references
+                  (append (index-node-references-import-in-this-node grand-parent-index-node) tmp))))))]
       [(library-identifier **1) 
         (let ([tmp (filter identifier-reference? (import-references root-library-node library-identifier))])
           (if (null? grand-parent-index-node)
@@ -352,6 +373,7 @@
             (lambda (index-node)
               (match (annotation-stripped (index-node-datum/annotations index-node))
                 (['library (identifier **1) _ ... ] (equal? identifier library-identifier))
+                (['define-library (identifier **1) _ ... ] (equal? identifier library-identifier))
                 (else #f)))
             candidate-index-node-list))))))
 
@@ -363,6 +385,10 @@
         (apply append (map 
           (lambda (child-node) (match-export child-node))
           (cddr (index-node-children root-index-node))))]
+      [('define-library _ **1 ) 
+        (apply append (map 
+          (lambda (child-node) (match-export child-node))
+          (cddr (index-node-children root-index-node))))]
       [else '()])))
 
 (define (match-export index-node)

analysis/identifier/rules/load.sls

@@ -42,7 +42,7 @@
                             (identifier-reference-identifier reference)
                             (identifier-reference-document reference)
                             (identifier-reference-index-node reference)
-                            index-node
+                            (identifier-reference-initialization-index-node reference)
                             library-identifier
                             (identifier-reference-type reference)
                             (identifier-reference-parents reference)
@@ -73,7 +73,7 @@
                             (identifier-reference-identifier reference)
                             (identifier-reference-document reference)
                             (identifier-reference-index-node reference)
-                            index-node
+                            (identifier-reference-initialization-index-node reference)
                             library-identifier
                             (identifier-reference-type reference)
                             (identifier-reference-parents reference)
@@ -104,7 +104,7 @@
                             (identifier-reference-identifier reference)
                             (identifier-reference-document reference)
                             (identifier-reference-index-node reference)
-                            index-node
+                            (identifier-reference-initialization-index-node reference)
                             library-identifier
                             (identifier-reference-type reference)
                             (identifier-reference-parents reference)

analysis/package-manager/akku.sls

@@ -4,7 +4,7 @@
     (chezscheme)
     (scheme-langserver util io)
     (scheme-langserver virtual-file-system file-node)
-    (only (srfi :13 strings) string-prefix? string-contains string-index-right string-index string-take string-drop string-drop-right))
+    (only (srfi :13 strings) string-suffix? string-prefix? string-contains string-index-right string-index string-take string-drop string-drop-right))
 
 ;This list-path should be like scheme-langserver/.akku/list, it's generated by AKKU and listed all *available* packaged installed by AKKU.
 (define (generate-akku-acceptable-file-filter list-path)
@@ -24,6 +24,18 @@
     (lambda (path)
       (cond 
         [(string-contains path "/.git/") #f]
+        [(string-suffix? ".ikarus.sls" path) #f]
+        [(string-suffix? ".mosh.sls" path) #f]
+        [(string-suffix? ".mzscheme.sls" path) #f]
+        [(string-suffix? ".guile.sls" path) #f]
+        [(string-suffix? ".loko.sls" path) #f]
+        [(string-suffix? ".nmosh.sls" path) #f]
+        [(string-suffix? ".vicare.sls" path) #f]
+        [(string-suffix? ".ypsilon.sls" path) #f]
+        [(string-suffix? ".digamma.sls" path) #f]
+        [(string-suffix? ".sagittarius.sls" path) #f]
+        [(string-suffix? ".ironscheme.sls" path) #f]
+        [(string-suffix? ".larceny.sls" path) #f]
         [(equal? path akku-path) #t]
         [(equal? path akku-lib-path) #t]
         [(and (string-prefix? akku-path path) (not (string-prefix? akku-lib-path path))) #f]