From aab5226dfe937861c54729744e8add15d931f758 Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Mon, 20 Jul 2020 04:41:00 +0100
Subject: geiser -> src
---
geiser/completion.scm | 27 ------
geiser/doc.scm | 258 --------------------------------------------------
geiser/emacs.scm | 58 ------------
geiser/evaluation.scm | 144 ----------------------------
geiser/modules.scm | 104 --------------------
geiser/utils.scm | 52 ----------
geiser/xref.scm | 84 ----------------
7 files changed, 727 deletions(-)
delete mode 100644 geiser/completion.scm
delete mode 100644 geiser/doc.scm
delete mode 100644 geiser/emacs.scm
delete mode 100644 geiser/evaluation.scm
delete mode 100644 geiser/modules.scm
delete mode 100644 geiser/utils.scm
delete mode 100644 geiser/xref.scm
(limited to 'geiser')
diff --git a/geiser/completion.scm b/geiser/completion.scm
deleted file mode 100644
index d69859b..0000000
--- a/geiser/completion.scm
+++ /dev/null
@@ -1,27 +0,0 @@
-;;; completion.scm -- completing known symbols and module names
-
-;; Copyright (C) 2009, 2012 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Mon Mar 02, 2009 02:22
-
-(define-module (geiser completion)
- #:export (completions module-completions)
- #:use-module (geiser utils)
- #:use-module (geiser modules)
- #:use-module (ice-9 session)
- #:use-module (ice-9 regex))
-
-(define (completions prefix)
- (let ((prefix (string-append "^" (regexp-quote prefix))))
- (sort! (map symbol->string (apropos-internal prefix)) string<?)))
-
-(define (module-completions prefix)
- (let* ((prefix (string-append "^" (regexp-quote prefix)))
- (matcher (lambda (s) (string-match prefix s)))
- (names (filter matcher (all-modules))))
- (sort! names string<?)))
diff --git a/geiser/doc.scm b/geiser/doc.scm
deleted file mode 100644
index 9f28f7f..0000000
--- a/geiser/doc.scm
+++ /dev/null
@@ -1,258 +0,0 @@
-;;; doc.scm -- procedures providing documentation on scheme objects
-
-;; Copyright (C) 2009, 2010, 2018 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Sun Feb 08, 2009 18:44
-
-(define-module (geiser doc)
- #:export (autodoc
- symbol-documentation
- module-exports
- object-signature)
- #:use-module (geiser utils)
- #:use-module (geiser modules)
- #:use-module (system vm program)
- #:use-module (system vm debug)
- #:use-module (ice-9 session)
- #:use-module (ice-9 documentation)
- #:use-module (ice-9 regex)
- #:use-module (ice-9 format)
- #:use-module (oop goops)
- #:use-module (srfi srfi-1))
-
-(define (autodoc ids)
- (if (not (list? ids))
- '()
- (map (lambda (id) (or (autodoc* id) (list id))) ids)))
-
-(define* (autodoc* id)
- (let ((args (obj-args (symbol->object id))))
- (and args
- `(,@(signature id args)
- ("module" . ,(symbol-module id))))))
-
-(define (object-signature name obj)
- (let ((args (obj-args obj)))
- (and args (signature name args))))
-
-(define (value-str obj)
- (format #f "~:@y" obj))
-
-(define* (signature id args-list #:optional (detail #t))
- (define (arglst args kind)
- (let ((args (assq-ref args kind)))
- (cond ((or (not args) (null? args)) '())
- ((list? args) args)
- (else (list args)))))
- (define (mkargs as)
- `(("required" ,@(arglst as 'required))
- ("optional" ,@(arglst as 'optional)
- ,@(if (assq-ref as 'rest) (list "...") '()))
- ("key" ,@(arglst as 'keyword))))
- (let* ((args-list (map mkargs (if (list? args-list) args-list '())))
- (value (and (and detail (null? args-list))
- (value-str (symbol->object id)))))
- `(,id ("args" ,@args-list) ,@(if value `(("value" . ,value)) '()))))
-
-(define default-macro-args '(((required ...))))
-
-(define geiser-args-key (gensym "geiser-args-key-"))
-
-(define (obj-args obj)
- (cond ((not obj) #f)
- ((or (procedure? obj) (program? obj))
- (cond ((procedure-property obj geiser-args-key))
- ((arguments obj) =>
- (lambda (args)
- (set-procedure-property! obj geiser-args-key args)
- args))
- (else #f)))
- ((and (macro? obj) (macro-transformer obj)) => macro-args)
- ((macro? obj) default-macro-args)
- (else 'variable)))
-
-(define (program-arities prog)
- (let ((addrs (program-address-range prog)))
- (when (pair? addrs) (find-program-arities (car addrs)))))
-
-(define (arguments proc)
- (define (p-args prog)
- (let ((as (map arity-arguments-alist (or (program-arities prog) '()))))
- (and (not (null? as)) as)))
- (define (clist f) (lambda (x) (let ((y (f x))) (and y (list y)))))
- (cond ((is-a? proc <generic>) (generic-args proc))
- ((doc->args proc) => list)
- ((procedure-property proc 'arglist) => (clist arglist->args))
- ((procedure-source proc) => (clist source->args))
- ((and (program? proc) (p-args proc)))
- ((procedure-property proc 'arity) => (clist arity->args))
- (else #f)))
-
-(define (source->args src)
- (let ((formals (cadr src)))
- (cond ((list? formals) `((required . ,formals)))
- ((pair? formals)
- `((required . ,(car formals)) (rest . ,(cdr formals))))
- (else #f))))
-
-(define (macro-args tf)
- (define* (collect args #:optional (req '()))
- (cond ((null? args) (arglist->args `(,(reverse req) #f #f r #f)))
- ((symbol? args) (arglist->args `(,(reverse req) #f #f r ,args)))
- ((and (pair? args) (symbol? (car args)))
- (collect (cdr args) (cons (car args) req)))
- (else #f)))
- (let* ((pats (procedure-property tf 'patterns))
- (args (and pats (filter-map collect pats))))
- (or (and args (not (null? args)) args) default-macro-args)))
-
-(define (arity->args art)
- (define (gen-arg-names count)
- (map (lambda (x) '_) (iota (max count 0))))
- (let ((req (car art))
- (opt (cadr art))
- (rest (caddr art)))
- `(,@(if (> req 0)
- (list (cons 'required (gen-arg-names req)))
- '())
- ,@(if (> opt 0)
- (list (cons 'optional (gen-arg-names opt)))
- '())
- ,@(if rest (list (cons 'rest 'rest)) '()))))
-
-(define (arglist->args arglist)
- `((required . ,(car arglist))
- (optional . ,(cadr arglist))
- (keyword . ,(caddr arglist))
- (rest . ,(car (cddddr arglist)))))
-
-(define (doc->args proc)
- ;; Guile 2.0.9+ uses the (texinfo ...) modules to produce
- ;; `guile-procedures.txt', and the output has a single hyphen, whereas
- ;; `makeinfo' produces two hyphens.
- (define proc-rx "--? Scheme Procedure: ([^[\n]+)\n")
- (define proc-rx2 "--? Scheme Procedure: ([^[\n]+\\[[^\n]*(\n[^\n]+\\]+)?)")
- (let ((doc (object-documentation proc)))
- (and doc
- (let ((match (or (string-match proc-rx doc)
- (string-match proc-rx2 doc))))
- (and match
- (parse-signature-string (match:substring match 1)))))))
-
-(define (parse-signature-string str)
- (define opt-arg-rx "\\[([^] ]+)\\]?")
- (define opt-arg-rx2 "([^ ])+\\]+")
- (let ((tokens (string-tokenize str)))
- (if (< (length tokens) 2)
- '()
- (let loop ((tokens (cdr tokens)) (req '()) (opt '()) (rest #f))
- (cond ((null? tokens)
- `((required ,@(map string->symbol (reverse! req)))
- (optional ,@(map string->symbol (reverse! opt)))
- ,@(if rest
- (list (cons 'rest (string->symbol rest)))
- '())))
- ((string=? "." (car tokens))
- (if (not (null? (cdr tokens)))
- (loop (cddr tokens) req opt (cadr tokens))
- (loop '() req opt "rest")))
- ((or (string-match opt-arg-rx (car tokens))
- (string-match opt-arg-rx2 (car tokens)))
- => (lambda (m)
- (loop (cdr tokens)
- req
- (cons (match:substring m 1) opt)
- rest)))
- (else (loop (cdr tokens)
- (cons (car tokens) req)
- opt
- rest)))))))
-
-(define (generic-args gen)
- (define (src> src1 src2)
- (> (length (cadr src1)) (length (cadr src2))))
- (define (src m)
- (catch #t
- (lambda () (method-source m))
- (lambda (k . a) #f)))
- (let* ((methods (generic-function-methods gen))
- (srcs (filter identity (map src methods))))
- (cond ((and (null? srcs)
- (not (null? methods))
- (method-procedure (car methods))) => arguments)
- ((not (null? srcs)) (list (source->args (car (sort! srcs src>)))))
- (else '(((rest . rest)))))))
-
-(define (symbol-documentation sym)
- (let ((obj (symbol->object sym)))
- (if obj
- `(("signature" . ,(or (obj-signature sym obj #f) sym))
- ("docstring" . ,(docstring sym obj))))))
-
-(define (docstring sym obj)
- (define (valuable?)
- (not (or (macro? obj) (procedure? obj) (program? obj))))
- (with-output-to-string
- (lambda ()
- (let* ((type (cond ((macro? obj) "A macro")
- ((procedure? obj) "A procedure")
- ((program? obj) "A compiled program")
- (else "An object")))
- (modname (symbol-module sym))
- (doc (object-documentation obj)))
- (display type)
- (if modname
- (begin
- (display " in module ")
- (display modname)
- (display ".")))
- (newline)
- (if doc (begin (newline) (display doc)))
- (if (valuable?) (begin (newline)
- (display "Value:")
- (newline)
- (display " ")
- (display (value-str obj))))))))
-
-(define* (obj-signature sym obj #:optional (detail #t))
- (let ((args (obj-args obj)))
- (and args (signature sym args detail))))
-
-(define (module-exports mod-name)
- (define elt-sort (make-symbol-sort car))
- (let* ((mod (catch #t
- (lambda () (resolve-interface mod-name))
- (lambda args (resolve-module mod-name))))
- (elts (hash-fold classify-module-object
- (list '() '() '())
- (module-obarray mod)))
- (elts (map elt-sort elts))
- (subs (map (lambda (m) (list (module-name m)))
- (submodules (resolve-module mod-name #f)))))
- (list (cons "modules" subs)
- (cons "procs" (car elts))
- (cons "syntax" (cadr elts))
- (cons "vars" (caddr elts)))))
-
-(define (classify-module-object name var elts)
- (let ((obj (and (variable-bound? var)
- (variable-ref var))))
- (cond ((or (not obj) (module? obj)) elts)
- ((or (procedure? obj) (program? obj))
- (list (cons (list name `("signature" . ,(obj-signature name obj)))
- (car elts))
- (cadr elts)
- (caddr elts)))
- ((macro? obj)
- (list (car elts)
- (cons (list name `("signature" . ,(obj-signature name obj)))
- (cadr elts))
- (caddr elts)))
- (else (list (car elts)
- (cadr elts)
- (cons (list name) (caddr elts)))))))
diff --git a/geiser/emacs.scm b/geiser/emacs.scm
deleted file mode 100644
index 6f2fc29..0000000
--- a/geiser/emacs.scm
+++ /dev/null
@@ -1,58 +0,0 @@
-;;; emacs.scm -- procedures for emacs interaction: entry point
-
-;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Sun Feb 08, 2009 18:39
-
-(define-module (geiser emacs)
- #:use-module (ice-9 match)
- #:use-module (system repl command)
- #:use-module (system repl error-handling)
- #:use-module (system repl server)
- #:use-module (geiser evaluation)
- #:use-module ((geiser modules) #:renamer (symbol-prefix-proc 'ge:))
- #:use-module ((geiser completion) #:renamer (symbol-prefix-proc 'ge:))
- #:use-module ((geiser xref) #:renamer (symbol-prefix-proc 'ge:))
- #:use-module ((geiser doc) #:renamer (symbol-prefix-proc 'ge:)))
-
-(define this-module (resolve-module '(geiser emacs)))
-
-(define-meta-command ((geiser-no-values geiser) repl)
- "geiser-no-values
-No-op command used internally by Geiser."
- (values))
-
-(define-meta-command ((geiser-newline geiser) repl)
- "geiser-newline
-Meta-command used by Geiser to emit a new line."
- (newline))
-
-(define-meta-command ((geiser-eval geiser) repl (mod form args) . rest)
- "geiser-eval module form args ()
-Meta-command used by Geiser to evaluate and compile code."
- (if (null? args)
- (call-with-error-handling
- (lambda () (ge:compile form mod)))
- (let ((proc (eval form this-module)))
- (ge:eval `(,proc ,@args) mod))))
-
-(define-meta-command ((geiser-load-file geiser) repl file)
- "geiser-load-file file
-Meta-command used by Geiser to load and compile files."
- (call-with-error-handling
- (lambda () (ge:compile-file file))))
-
-
-(define-meta-command ((geiser-start-server geiser) repl)
- "geiser-start-server
-Meta-command used by Geiser to start a REPL server."
- (let* ((sock (make-tcp-server-socket #:port 0))
- (port (sockaddr:port (getsockname sock))))
- (spawn-server sock)
- (write (list 'port port))
- (newline)))
diff --git a/geiser/evaluation.scm b/geiser/evaluation.scm
deleted file mode 100644
index bdbcdd8..0000000
--- a/geiser/evaluation.scm
+++ /dev/null
@@ -1,144 +0,0 @@
-;;; evaluation.scm -- evaluation, compilation and macro-expansion
-
-;; Copyright (C) 2009, 2010, 2011, 2013, 2015 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Mon Mar 02, 2009 02:46
-
-(cond-expand
- (guile-2.2
- (define-module (geiser evaluation)
- #:export (ge:compile
- ge:eval
- ge:macroexpand
- ge:compile-file
- ge:load-file
- ge:set-warnings
- ge:add-to-load-path)
- #:use-module (geiser modules)
- #:use-module (srfi srfi-1)
- #:use-module (language tree-il)
- #:use-module (system base compile)
- #:use-module (system base message)
- #:use-module (system base pmatch)
- #:use-module (system vm program)
- #:use-module (ice-9 pretty-print)
- #:use-module (system vm loader)))
- (else
- (define-module (geiser evaluation)
- #:export (ge:compile
- ge:eval
- ge:macroexpand
- ge:compile-file
- ge:load-file
- ge:set-warnings
- ge:add-to-load-path)
- #:use-module (geiser modules)
- #:use-module (srfi srfi-1)
- #:use-module (language tree-il)
- #:use-module (system base compile)
- #:use-module (system base message)
- #:use-module (system base pmatch)
- #:use-module (system vm program)
- #:use-module (ice-9 pretty-print))))
-
-
-(define compile-opts '())
-(define compile-file-opts '())
-
-(define default-warnings '(arity-mismatch unbound-variable format))
-(define verbose-warnings `(unused-variable ,@default-warnings))
-
-(define (ge:set-warnings wl)
- (let* ((warns (cond ((list? wl) wl)
- ((symbol? wl) (case wl
- ((none nil null) '())
- ((medium default) default-warnings)
- ((high verbose) verbose-warnings)
- (else '())))
- (else '())))
- (fwarns (if (memq 'unused-variable warns)
- (cons 'unused-toplevel warns)
- warns)))
- (set! compile-opts (list #:warnings warns))
- (set! compile-file-opts (list #:warnings fwarns))))
-
-(ge:set-warnings 'none)
-
-(define (call-with-result thunk)
- (letrec* ((result #f)
- (output
- (with-output-to-string
- (lambda ()
- (with-fluids ((*current-warning-port* (current-output-port))
- (*current-warning-prefix* ""))
- (with-error-to-port (current-output-port)
- (lambda () (set! result
- (map object->string (thunk))))))))))
- (write `((result ,@result) (output . ,output)))
- (newline)))
-
-(define (ge:compile form module)
- (compile* form module compile-opts))
-
-(define (compile* form module-name opts)
- (let* ((module (or (find-module module-name) (current-module)))
- (ev (lambda ()
- (call-with-values
- (lambda ()
- (let* ((to (cond-expand (guile-2.2 'bytecode)
- (else 'objcode)))
- (cf (cond-expand (guile-2.2 load-thunk-from-memory)
- (else make-program)))
- (o (compile form
- #:to to
- #:env module
- #:opts opts))
- (thunk (cf o)))
- (start-stack 'geiser-evaluation-stack
- (eval `(,thunk) module))))
- (lambda vs vs)))))
- (call-with-result ev)))
-
-(define (ge:eval form module-name)
- (let* ((module (or (find-module module-name) (current-module)))
- (ev (lambda ()
- (call-with-values
- (lambda () (eval form module))
- (lambda vs vs)))))
- (call-with-result ev)))
-
-(define (ge:compile-file path)
- (call-with-result
- (lambda ()
- (let ((cr (compile-file path
- #:canonicalization 'absolute
- #:opts compile-file-opts)))
- (and cr
- (list (object->string (save-module-excursion
- (lambda () (load-compiled cr))))))))))
-
-(define ge:load-file ge:compile-file)
-
-(define (ge:macroexpand form . all)
- (let ((all (and (not (null? all)) (car all))))
- (with-output-to-string
- (lambda ()
- (pretty-print (tree-il->scheme (macroexpand form)))))))
-
-(define (add-to-list lst dir)
- (and (not (member dir lst))))
-
-(define (ge:add-to-load-path dir)
- (and (file-is-directory? dir)
- (let ((in-lp (member dir %load-path))
- (in-clp (member dir %load-compiled-path)))
- (when (not in-lp)
- (set! %load-path (cons dir %load-path)))
- (when (not in-clp)
- (set! %load-compiled-path (cons dir %load-compiled-path)))
- (or in-lp in-clp))))
diff --git a/geiser/modules.scm b/geiser/modules.scm
deleted file mode 100644
index 32b0f1f..0000000
--- a/geiser/modules.scm
+++ /dev/null
@@ -1,104 +0,0 @@
-;;; modules.scm -- module metadata
-
-;; Copyright (C) 2009, 2010, 2011, 2018 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Mon Mar 02, 2009 02:00
-
-(define-module (geiser modules)
- #:export (symbol-module
- program-module
- module-name?
- module-path
- find-module
- all-modules
- submodules
- module-location)
- #:use-module (geiser utils)
- #:use-module (system vm program)
- #:use-module (system vm debug)
- #:use-module (ice-9 regex)
- #:use-module (ice-9 session)
- #:use-module (srfi srfi-1))
-
-;; Return hash table mapping filename to list of modules defined in that
-;; file. H/t andy wingo.
-(define (fill-file->module-mapping! ret)
- (define (record-module m)
- (let ((f (module-filename m)))
- (hash-set! ret f (cons m (hash-ref ret f '())))))
- (define (visit-module m)
- (record-module m)
- (hash-for-each (lambda (k v) (visit-module v))
- (module-submodules m)))
- (visit-module (resolve-module '() #f))
- ret)
-
-(define file->modules (fill-file->module-mapping! (make-hash-table)))
-
-(define (program-file p)
- (let ((src (program-source p 0)))
- (and (pair? src) (cadr src))))
-
-(define (program-module p)
- (let* ((f (program-file p))
- (mods (or (hash-ref file->modules f)
- (hash-ref (fill-file->module-mapping! file->modules) f))))
- (and (pair? mods) (not (null? mods)) (car mods))))
-
-(define (module-name? module-name)
- (and (list? module-name)
- (not (null? module-name))
- (every symbol? module-name)))
-
-(define (symbol-module sym . all)
- (and sym
- (catch 'module-name
- (lambda ()
- (apropos-fold (lambda (module name var init)
- (if (eq? name sym)
- (throw 'module-name (module-name module))
- init))
- #f
- (regexp-quote (symbol->string sym))
- (if (or (null? all) (not (car all)))
- (apropos-fold-accessible (current-module))
- apropos-fold-all)))
- (lambda (key . args)
- (and (eq? key 'module-name) (car args))))))
-
-(define (module-location name)
- (make-location (module-path name) #f))
-
-(define (find-module mod-name)
- (and (module-name? mod-name)
- (resolve-module mod-name #f #:ensure #f)))
-
-(define (module-path module-name)
- (and (module-name? module-name)
- (or ((@@ (ice-9 session) module-filename) module-name)
- (module-filename (resolve-module module-name #f)))))
-
-(define (submodules mod)
- (hash-map->list (lambda (k v) v) (module-submodules mod)))
-
-(define (root-modules)
- (submodules (resolve-module '() #f)))
-
-(define (all-modules)
- (define (maybe-name m)
- (and (module-kind m) (format #f "~A" (module-name m))))
- (let* ((guile (resolve-module '(guile)))
- (roots (remove (lambda (m) (eq? m guile)) (root-modules)))
- (children (append-map all-child-modules roots)))
- (cons "(guile)" (filter-map maybe-name children))))
-
-(define* (all-child-modules mod #:optional (seen '()))
- (let ((cs (filter (lambda (m) (not (member m seen))) (submodules mod))))
- (fold (lambda (m all) (append (all-child-modules m all) all))
- (list mod)
- cs)))
diff --git a/geiser/utils.scm b/geiser/utils.scm
deleted file mode 100644
index 92ed7ae..0000000
--- a/geiser/utils.scm
+++ /dev/null
@@ -1,52 +0,0 @@
-;;; utils.scm -- utility functions
-
-;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Mon Mar 02, 2009 01:48
-
-(define-module (geiser utils)
- #:export (make-location
- symbol->object
- pair->list
- sort-symbols!
- make-symbol-sort
- gensym?)
- #:use-module (ice-9 regex))
-
-(define (symbol->object sym)
- (and (symbol? sym)
- (module-defined? (current-module) sym)
- (module-ref (current-module) sym)))
-
-(define (pair->list pair)
- (let loop ((d pair) (s '()))
- (cond ((null? d) (reverse! s))
- ((symbol? d) (reverse! (cons d s)))
- (else (loop (cdr d) (cons (car d) s))))))
-
-(define (make-location file line)
- (list (cons "file" (if (string? file) file '()))
- (cons "line" (if (number? line) (+ 1 line) '()))))
-
-(define (sort-symbols! syms)
- (let ((cmp (lambda (l r)
- (string<? (symbol->string l) (symbol->string r)))))
- (sort! syms cmp)))
-
-(define (make-symbol-sort sel)
- (let ((cmp (lambda (a b)
- (string<? (symbol->string (sel a))
- (symbol->string (sel b))))))
- (lambda (syms)
- (sort! syms cmp))))
-
-(define (gensym? sym)
- (and (symbol? sym) (gensym-name? (format #f "~A" sym))))
-
-(define (gensym-name? name)
- (and (string-match "^#[{]" name) #t))
diff --git a/geiser/xref.scm b/geiser/xref.scm
deleted file mode 100644
index 549cc94..0000000
--- a/geiser/xref.scm
+++ /dev/null
@@ -1,84 +0,0 @@
-;;; xref.scm -- cross-referencing utilities
-
-;; Copyright (C) 2009, 2010, 2020 Jose Antonio Ortega Ruiz
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the Modified BSD License. You should
-;; have received a copy of the license along with this program. If
-;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-
-;; Start date: Mon Mar 02, 2009 02:37
-
-(define-module (geiser xref)
- #:export (symbol-location
- generic-methods
- callers
- callees
- find-file)
- #:use-module (geiser utils)
- #:use-module (geiser modules)
- #:use-module (geiser doc)
- #:use-module (oop goops)
- #:use-module (system xref)
- #:use-module (system vm program))
-
-(define (symbol-location sym)
- (let ((obj (symbol->object sym)))
- (cond ((program? obj) (program-location obj))
- ((symbol-module sym) => module-location)
- (else '()))))
-
-(define (generic-methods sym)
- (let* ((gen (symbol->object sym))
- (methods (if (is-a? gen <generic>)
- (generic-function-methods gen)
- '())))
- (filter (lambda (x) (not (null? x)))
- (map (lambda (m)
- (make-xref (method-procedure m) sym (symbol-module sym)))
- methods))))
-
-(define (make-xref proc name module)
- (and proc
- `(("location" . ,(or (program-location proc) (symbol-location name)))
- ("signature" . ,(object-signature name proc))
- ("module" . ,(or module '())))))
-
-(define (program-location p)
- (cond ((not (program? p)) #f)
- ((program-source p 0) =>
- (lambda (s) (make-location (program-path p) (source:line s))))
- ((program-path p) => (lambda (s) (make-location s #f)))
- (else #f)))
-
-(define (program-path p)
- (let* ((mod (program-module p))
- (name (and (module? mod) (module-name mod))))
- (and name (module-path name))))
-
-(define (procedure-xref proc . mod-name)
- (let* ((proc-name (or (procedure-name proc) '<anonymous>))
- (mod-name (if (null? mod-name)
- (symbol-module proc-name)
- (car mod-name))))
- (make-xref proc proc-name mod-name)))
-
-(define (callers sym)
- (let ((mod (symbol-module sym #t)))
- (and mod
- (apply append (map (lambda (procs)
- (map (lambda (proc)
- (procedure-xref proc (car procs)))
- (cdr procs)))
- (procedure-callers (cons mod sym)))))))
-
-(define (callees sym)
- (let ((obj (symbol->object sym)))
- (and obj
- (map procedure-xref (procedure-callees obj)))))
-
-(define (find-file path)
- (let loop ((dirs %load-path))
- (if (null? dirs) #f
- (let ((candidate (string-append (car dirs) "/" path)))
- (if (file-exists? candidate) candidate (loop (cdr dirs)))))))
--
cgit v1.2.3