From e48d59af292ca82e77733070cf3444ac2e0ba7df Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 10 Feb 2009 23:33:21 +0100 Subject: Guile scheme files moved to scheme/guile. --- scheme/geiser/introspection.scm | 79 ----------------------------------------- 1 file changed, 79 deletions(-) delete mode 100644 scheme/geiser/introspection.scm (limited to 'scheme/geiser/introspection.scm') diff --git a/scheme/geiser/introspection.scm b/scheme/geiser/introspection.scm deleted file mode 100644 index 4565464..0000000 --- a/scheme/geiser/introspection.scm +++ /dev/null @@ -1,79 +0,0 @@ -;; introspection.scm -- name says it all - -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz - -;; Author: Jose Antonio Ortega Ruiz -;; Start date: Sun Feb 08, 2009 18:44 - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3 of the License, or -;; (at your option) any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Comentary: - -;; Procedures introspecting on scheme objects and their properties. - -;;; Code: - -(define-module (geiser introspection) - #:export (proc-args completions) - #:use-module (system vm program) - #:use-module (ice-9 session) - #:use-module (srfi srfi-1)) - -(define (proc-args proc) - (let ((proc (and (symbol? proc) - (module-bound? (current-module) proc) - (eval proc (current-module))))) - (cond ((not proc) #f) - ((program? proc) (program-args proc)) - ((procedure? proc) (procedure-args proc)) - ((macro? proc) (macro-args proc)) - (else #f)))) - -(define (program-args program) - (let* ((arity (program-arity program)) - (arg-no (first arity)) - (opt (> (second arity) 0)) - (args (map first (take (program-bindings program) arg-no)))) - (format-args (if opt (drop-right args 1) args) - (and opt (last args)) - (program-module program)))) - -(define (procedure-args proc) - (let* ((arity (procedure-property proc 'arity)) - (req (first arity)) - (opt (third arity)) - (env (procedure-environment proc))) - (format-args (map (lambda (n) - (string->symbol (format "arg~A" (+ 1 n)))) - (iota req)) - (and opt 'rest) - (and (not (null? env)) env)))) - -(define (macro-args macro) - (let ((prog (macro-transformer macro))) - (if prog - (program-args prog) - (format-args '(...) #f #f)))) - -(define (format-args args opt module) - (list (cons 'required args) - (cons 'optional (or opt '())) - (cons 'module (if module (module-name module) '())))) - -(define (completions prefix) - (sort! (map symbol->string - (apropos-internal (string-append "^" prefix))) - string