<commit_before>;;;
;;;; Scheme dictionaries
;;;
;;
;; @created   "Tue Dec 26 15:57:18 EST 2006"
;;


(require 'srfi-69)

(define-namespace SymbolEntry "class:org.schemeway.plugins.schemescript.dictionary.SymbolEntry")


;;;
;;;; --
;;;; Default dictionaries
;;;


(define *r5rs-dictionary* (make-hash-table))
(define *kawa-dictionary* (make-hash-table))
(define *user-dictionary* (make-hash-table))

(define *all-dictionaries* (list *r5rs-dictionary* *kawa-dictionary* *user-dictionary*))


(define current-dictionary (make-parameter *user-dictionary*))


(define (dictionary-entry name proto type #!optional (level :: <int> 0) (dictionary (current-dictionary)))
  (add-dictionary-entry name (SymbolEntry:new name proto type level) dictionary))


;;;
;;;; --
;;;; User dict API
;;;


(define (add-dictionary-entry name entry #!optional (dictionary *user-dictionary*))
  (let ((current-entries (get-dictionary-entries name dictionary)))
    (set-dictionary-entries! name (cons entry current-entries) dictionary)))


(define (set-dictionary-entries! name entries #!optional (dictionary *user-dictionary*))
  (hash-table-set! dictionary name entries))


(define (get-dictionary-entries name #!optional (dictionary *user-dictionary*))
  (hash-table-ref/default dictionary name '()))


(define (get-dictionary-entries-for-resource resource #!optional (dictionary *user-dictionary*))
  (hash-table-fold dictionary
                   (lambda (key value result)
                     (append (filter (lambda (entry) 
                                       (not (eq? resource (SymbolEntry:getFile entry))))
                                     value)
                             result))
                   '()))

(define (remove-dictionary-entries-for-resources resources #!optional (dictionary *user-dictionary*))
  (let ((names (hash-table-keys dictionary)))
    (for-each (lambda (name)
                (let ((new-entries (filter (lambda (entry) 
                                             (not (memq (SymbolEntry:getFile entry) resources)))
                                           (get-dictionary-entries name))))
                  (set-dictionary-entries! name new-entries)))
              names)))


(define (find-completions prefix)
  (apply append! 
         (map (lambda (dictionary)
                (hash-table-fold dictionary
                                 (lambda (key value result)
                                   (if (starts-with prefix key)
                                       (append value result)
                                       result))
                                 '()))
              *all-dictionaries*)))


(define (add-completions-to-list (prefix :: <symbol>) (lst :: <java.util.List>))
  (for-each (cut java.util.List:add lst <>)
            (find-completions (symbol->string prefix))))


;;;
;;;; --
;;;; Now load the default dictionaries
;;;



(begin
  (parameterize ((current-dictionary *r5rs-dictionary*))
    (load-relative "r5rs.scm"))
  (parameterize ((current-dictionary *kawa-dictionary*))
    (load-relative "kawa.scm")))

<commit_msg>now uses a single dictionary (hash table)<commit_after>;;;
;;;; Scheme dictionaries
;;;
;;
;; @created   "Tue Dec 26 15:57:18 EST 2006"
;;


(require 'srfi-69)

(define-namespace SymbolEntry "class:org.schemeway.plugins.schemescript.dictionary.SymbolEntry")


;;;
;;;; --
;;;; Default dictionaries
;;;


(define *user-dictionary* (make-hash-table))


(define current-dictionary (make-parameter *user-dictionary*))


(define (dictionary-entry name proto type #!optional (level :: <int> 2) (dictionary (current-dictionary)))
  (add-dictionary-entry name (SymbolEntry:new name proto type level) dictionary))


;;;
;;;; --
;;;; User dict API
;;;


(define (add-dictionary-entry name entry #!optional (dictionary (current-dictionary)))
  (let ((current-entries (hash-table-ref/default dictionary name '())))
    (set-dictionary-entries! name (cons entry current-entries) dictionary)))


(define (set-dictionary-entries! name entries #!optional (dictionary (current-dictionary)))
  (hash-table-set! dictionary name entries))


(define (get-dictionary-entries name #!optional (dictionary (current-dictionary)))
  (synchronize-dictionary)
  (hash-table-ref/default dictionary name '()))


(define (get-dictionary-entries-for-resource resource #!optional (dictionary (current-dictionary)))
  (synchronize-dictionary)
  (hash-table-fold dictionary
                   (lambda (key value result)
                     (append (filter (lambda (entry) 
                                       (equal? resource (SymbolEntry:getFile entry)))
                                     value)
                             result))
                   '()))


(define (remove-dictionary-entries-for-resources resources #!optional (dictionary (current-dictionary)))
  (let ((names (hash-table-keys dictionary)))
    (for-each (lambda (name)
                (let ((new-entries (filter (lambda (entry) 
                                             (not (member (SymbolEntry:getFile entry) resources)))
                                           (get-dictionary-entries name))))
                  (set-dictionary-entries! name new-entries)))
              names)))


(define (find-completions prefix #!optional (dictionary (current-dictionary)))
  (synchronize-dictionary)
  (hash-table-fold dictionary
                   (lambda (key value result)
                     (if (starts-with prefix key)
                         (append value result)
                         result))
                   '()))


(define (update-dictionary-for-file (file :: <org.eclipse.core.resources.IFile>))
  (remove-dictionary-entries-for-resources (list file))
  (with-document-from-file file
    (lambda (document)
      (scan-resource file document))))


(define (scan-resource resource document)
  (clear-markers resource)
  (catch 'syntax-error
    (lambda ()
      (stx-read-all document (lambda (stx-obj) (walk-definitions resource stx-obj))))
    (lambda (key message offset len)
      (add-marker/offset! 'error resource (+ 1 (IDocument:getLineOfOffset document offset)) offset (+ offset len) message)
      #f)))


(define (synchronize-dictionary)
  (let ((updater (SchemeScriptPlugin:getDictionaryUpdater)))
    (*:processPendingResources updater #t)))


;;;
;;;; --
;;;; Now load the default dictionaries
;;;


(begin
  (load-relative "r5rs.scm")
  (load-relative "kawa.scm"))


{'fraction_non_alphanumeric': 0.14236813443286137, 'fraction_numerical': 0.0056013692235879885, 'mean_word_length': 2.5299286106534873, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 10, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 18, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '196093', 'n_tokens_mistral': 1872, 'n_tokens_neox': 1698, 'n_words': 429}