summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-05-02 17:51:34 +0200
committerAndy Wingo <wingo@pobox.com>2008-05-02 17:51:34 +0200
commit0a8a9780b8ea829af0e06578541fe9a1fb71530c (patch)
tree2b1b66e877ccbf6b0f1935e96c67238374c218d0 /module
parent6649bc04364be26666caa6395900265736d67a98 (diff)
downloadguile-0a8a9780b8ea829af0e06578541fe9a1fb71530c.tar.gz
remove module.scm
* module/system/base/module.scm: Removed module.scm, as it was unused (see 9419ff9ae91c93983972797e607e135ecd1233bb).
Diffstat (limited to 'module')
-rw-r--r--module/system/base/Makefile.am2
-rw-r--r--module/system/base/module.scm218
2 files changed, 1 insertions, 219 deletions
diff --git a/module/system/base/Makefile.am b/module/system/base/Makefile.am
index 0313a5e8c..0b756998a 100644
--- a/module/system/base/Makefile.am
+++ b/module/system/base/Makefile.am
@@ -1,4 +1,4 @@
-SOURCES = compile.scm language.scm module.scm
+SOURCES = compile.scm language.scm
## syntax.scm
GOBJECTS = $(SOURCES:%.scm=%.go)
diff --git a/module/system/base/module.scm b/module/system/base/module.scm
deleted file mode 100644
index 28ffa4c26..000000000
--- a/module/system/base/module.scm
+++ /dev/null
@@ -1,218 +0,0 @@
-;;; Module system
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; This program 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 2, or (at your option)
-;; any later version.
-;;
-;; This program 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; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(define-module (system base module)
- :use-module (oop goops)
- :use-syntax (system base syntax)
- :use-module (system base language)
- :use-module (ice-9 regex)
- :use-module (ice-9 common-list))
-
-(define (expand-file-name file dir)
- (string-append dir "/" file))
-
-
-;;;
-;;; Environment
-;;;
-
-(dynamic-call "scm_init_envs" (dynamic-link "libguilevm.so"))
-
-(export env-identifier)
-(define-generic env-identifier)
-(define-generic env-bound?)
-(define-generic env-ref)
-(define-generic env-set!)
-(define-generic env-define)
-
-(export global-ref)
-
-(define (global-ref identifier)
- (let loop ((e *root-package*) (l (identifier->list identifier)))
- (cond ((null? l) e)
- (else (loop (env-ref e (car l)) (cdr l))))))
-
-(define (load-env identifier)
- (let ((x (global-ref identifier))) x.env))
-
-(define (identifier->list identifier)
- (let loop ((s (symbol->string identifier)) (l '()))
- (let ((m (string-match "::" s)))
- (if m
- (loop (match:suffix m) (cons (string->symbol (match:prefix m)) l))
- (reverse! (cons (string->symbol s) l))))))
-
-(define-public (identifier-split identifier)
- (let ((m (string-match "::([^:]*)$" (symbol->string identifier))))
- (if m
- (values (string->symbol (match:prefix m))
- (string->symbol (match:substring m 1)))
- (values #f identifier))))
-
-
-;;;
-;;; Modules
-;;;
-
-(define-vm-class <vmodule> (<env>)
- (env (make-env))
- (bootcode))
-
-(export make-vmodule)
-
-(define (make-vmodule)
- (make <vmodule>))
-
-(define-method (env-identifier (m <vmodule>))
- (env-identifier m.env))
-
-(define-method (env-define (m <vmodule>) (s <symbol>) v)
- (env-define m.env s v))
-
-
-;;;
-;;; Packages
-;;;
-
-(define *package-def* "GPKG.def")
-
-(define-vm-class <package> (<env>)
- (env (make-env)))
-
-(define-method (env-bound? (p <package>) (s <symbol>))
- (if (not (env-bound? p.env s))
- (cond ((package-lookup p s) => (lambda (v) (env-define p.env s v) #t))
- (else #f))))
-
-(define-method (env-ref (p <package>) (s <symbol>))
- (env-bound? p s)
- (env-ref p.env s))
-
-(define-method (env-define (p <package>) (s <symbol>) (c <env>))
- (env-define p.env s c)
- (let ((id (cond ((env-identifier p.env) =>
- (lambda (id)
- (string->symbol (format #f "~A::~A" id s))))
- (else s))))
- (set-env-identifier! c.env id)))
-
-(define (try-load-package dir)
- (if (and (file-exists? dir) (file-is-directory? dir))
- (if (file-exists? (expand-file-name *package-def* dir))
- (make-custom-package dir)
- (make-plain-package dir))
- #f))
-
-;; plain package
-
-(define-vm-class <plain-package> (<package>)
- directory)
-
-(define (make-plain-package dir)
- (make <plain-package> :directory dir))
-
-(define-method (package-lookup (p <plain-package>) (s <symbol>))
- (let ((file (expand-file-name (string-downcase! (symbol->string s))
- p.directory)))
- (or (try-load-package file)
- (try-load-vmodule file))))
-
-(define (try-load-vmodule file)
- (or (try-load-compiled-vmodule file)
- (try-load-source-vmodule file)))
-
-(define (try-load-compiled-vmodule file) #f)
-
-(define (try-load-source-vmodule file) #f)
-
-;; custom package
-
-(define-vm-class <custom-package> (<package>)
- directory name category version author modules)
-
-(define (make-custom-package dir)
- (call-with-input-file (expand-file-name *package-def* dir)
- (lambda (p)
- (apply make <custom-package> :directory dir :name (cdr (read p))))))
-
-(define-method (package-lookup (p <custom-package>) (s <symbol>))
- (and-let* ((entry (assq-ref p.modules s)))
- (let ((module (make-vmodule)))
- (env-define p s module)
- (let* ((file (expand-file-name (car entry) p.directory))
- (code (load-file-in file module (lookup-language (cadr entry)))))
- (set! module.bootcode code))
- module)))
-
-;; multi package
-
-(define-vm-class <multi-package> (<package>)
- packages)
-
-(define (make-multi-package dirs)
- (let ((packages (pick id (map try-load-package dirs))))
- (make <multi-package> :packages packages)))
-
-(define-method (package-lookup (p <multi-package>) (s <symbol>))
- (list-fold (lambda (p d)
- (let ((c (and (env-bound? p s) (env-ref p s))))
- (if c (if d (error "Module name conflict" d c) c) d)))
- #f p.packages))
-
-
-;;;
-;;; Guile old module
-;;;
-
-(define (import-old-module! m module)
- (hash-fold (lambda (k v d) (env-define m k (variable-ref v)))
- #f (module-obarray module)))
-
-
-;;;
-;;; Current modules
-;;;
-
-(export current-vmodule set-current-vmodule!
- current-evaluator set-current-evaluator!)
-
-(define *current-vmodule* #f)
-(define (current-vmodule) *current-vmodule*)
-(define (set-current-vmodule! m) (set! *current-vmodule* m))
-
-(define *current-evaluator* #f)
-(define (current-evaluator) *current-evaluator*)
-(define (set-current-evaluator! e) (set! *current-evaluator* e))
-
-
-;;;
-;;; Standard modules/packages
-;;;
-
-(define *root-package*
- (make-multi-package '("/usr/local/share/guile/site")))
-
-(let ((user (make-vmodule)))
- (env-define *root-package* 'user user))
-
-(let ((core (make-vmodule)))
- (env-define *root-package* 'core core)
- (hash-fold (lambda (s v d) (env-define core s v)) #f (builtin-bindings)))