Commit 1db108e3 authored by Erick Gallesio's avatar Erick Gallesio

Added partial exports for ScmPkg

parent d176c74c
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 11-Dec-2006 14:39 (eg)
;;;; Last file update: 12-Apr-2007 21:24 (eg)
;;;; Last file update: 13-Apr-2007 15:37 (eg)
;;;;
......@@ -34,10 +34,7 @@
imports
exports
macros
syntaxes
;;// exceptions
;;// records
)
syntaxes)
(define (%new-scmpkg-package name)
(make-scmpkg-package name ; name
......@@ -49,8 +46,6 @@
'() ; exports
'() ; macros
'() ; syntaxes
;;// '() ; exceptions
;;// '() ; records
))
......@@ -79,43 +74,64 @@
(cdr lang)))
imp))))
(define (partial-import module symbols)
;; Generate code for importing only some symbols of a module
(unless (and (symbol? module)
(list? symbols)
(every symbol? symbols))
(error 'interface "bad import ~S" (cons module symbols)))
`(let ((module (find-module ',module)))
,@(map (lambda(x)`(%symbol-alias ',x ',x module)) symbols)))
(define (merge-imports-exports imp exp)
;; When we have a "from" export clauses, add its package to imports
(let ((add (filter-map (lambda(x)
(and (pair? x) (eq? (car x) 'from)
(if (= (length x) 2)
(cadr x)
(cdr x))))
exp)))
(append imp add)))
(define (do-exports lst)
(let loop ((lst lst)
(symbs '())
(aliases '()))
(cond
((null? lst)
`(begin
(export ,@symbs)
,@(map (lambda (x)
(if (null? (cdr x))
`(%module-aliases ',(car x)
(module-exports (find-module ',(car x)))
#t)
`(%module-aliases ',(car x) ',(cdr x) #t)))
aliases)))
((symbol? (car lst)) ; a symbol
(loop (cdr lst)
(cons (car lst) symbs)
aliases))
(else ; (from module ...)
(loop (cdr lst)
symbs
(cons (cdar lst) aliases))))))
(let* ((pi (in-module |ScmPkg| parse-interface))
(pkg (pi name body))
(imp (scmpkg-package-imports pkg))
(exp (reverse (scmpkg-package-exports pkg)))
(lang (scmpkg-package-language pkg))
(req (merge-imports-exports imp exp))
(allreq (find-imports lang req))
(allimp (find-imports lang imp)))
(let* ((pi (in-module |ScmPkg| parse-interface))
(pkg (pi name body))
(exp (scmpkg-package-exports pkg))
(imp (find-imports
(scmpkg-package-language pkg)
(scmpkg-package-imports pkg))))
(eprintf ")==> ~S\n" imp)
`(begin
;; Require scmpkg-support
(require "scmpkg-support")
;; Require all the imported modules
,@(map (lambda (x)
`(require-for-syntax ,(symbol->string (if (pair? x) (car x) x))))
imp)
allreq)
,@(map (lambda (x) `(require ,(symbol->string (if (pair? x) (car x) x))))
imp)
allreq)
;; Define a module for the scmpkg package
(define-module ,name
;; Imports
,@(map (lambda (x)
(if (pair? x)
(partial-import (car x) (cdr x))
`(import ,x)))
imp)
(import ,@allimp)
;; Exports
(export ,@exp)
,(do-exports exp)
;; Body
(include ,(scmpkg-package-source pkg)))
;; Provide
......@@ -144,14 +160,12 @@
(if (symbol? x)
(%push! exports x) ;; export a variable
(match-case x
((from ?mod . ?rest) ;; re-exportation
(%push! exports x))
((macro . ?rest) ;; export a macro
(%push! (scmpkg-package-macros pkg) rest))
((syntax ?args . ?-) ;; export a syntax
(%push! (scmpkg-package-syntaxes pkg) args))
;;// ((exception . ?rest) ;; export an exception
;;// (%push! (scmpkg-package-exceptions pkg) rest))
;;// ((record ?name . ?body)
;;// (%push! (scmpkg-package-records pkg) (cons name body)))
(else
(%push! exports (car x))))))
(scmpkg-package-exports pkg))
......
......@@ -21,36 +21,16 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 7-Feb-2007 11:03 (eg)
;;;; Last file update: 8-Mar-2007 16:45 (eg)
;;;; Last file update: 13-Apr-2007 14:33 (eg)
;;;;
;; ======================================================================
;; ScmPkg Runtime
;; ======================================================================
;;//(define-condition-type &type-error &message &type-error?)
;;//(include "ScmPkg.d/scmpkg-runtime.stk")
;;//
;;//
;;//(define (exception-get-message cond)
;;// (if (condition? cond)
;;// (if (condition-has-type? cond &message)
;;// (condition-ref cond 'message)
;;// (format "condition of type ~S raised" (struct-type-name (struct-type cond))))
;;// (error "bad exception ~S" cond)))
;;//
;;//
;; ======================================================================
;; The ScmPkg STklos module
;; ======================================================================
(define-module |ScmPkg|
(include "ScmPkg.d/scmpkg-languages.stk")
(include "ScmPkg.d/scmpkg-interface.stk")
; (include "ScmPkg.d/scmpkg-exception.stk")
; (include "ScmPkg.d/scmpkg-parameter.stk")
; (include "ScmPkg.d/scmpkg-define.stk")
; (include "ScmPkg.d/scmpkg-record.stk")
)
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 1-Jun-2000 12:26 (eg)
;;;; Last file update: 13-Apr-2007 11:00 (eg)
;;;; Last file update: 13-Apr-2007 14:33 (eg)
;;;;
......@@ -250,7 +250,7 @@ doc>
(cons mod res))) ; add it to our result
(error 'import "module `~S' does not exist" (car l)))))))
(define (%module-aliases module-name symbols)
(define (%module-aliases module-name symbols export?)
;; define aliases in the current module of symbols from module-name
(let ((module (find-module module-name #f)))
(unless module
......@@ -261,7 +261,11 @@ doc>
(%symbol-alias x x module)
(error 'import "symbol ~S is not exported from module ~S"
x module-name)))
symbols))))
symbols)))
;; if export? is true, export the given symbols
(when export?
(%module-export (current-module) symbols)))
;;(define-macro (import . modules)
;; (if (null? modules)
......@@ -305,7 +309,7 @@ doc>
((null? full)
;; Only partial exports
`(begin
,@(map (lambda (x) `(%module-aliases ',(car x) ',(cdr x)))
,@(map (lambda (x) `(%module-aliases ',(car x) ',(cdr x) #f))
part)))
(else
`(begin
......
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 3-Jan-2003 18:45 (eg)
* Last file update: 24-Jan-2007 10:49 (eg)
* Last file update: 13-Apr-2007 18:36 (eg)
*/
#include <sys/types.h>
......@@ -521,7 +521,7 @@ DEFINE_PRIMITIVE("socket-client?", socket_clientp, subr1, (SCM obj))
* Returns |#t| if |socket| is a server socket, otherwise returns |#f|.
doc>
*/
DEFINE_PRIMITIVE("socket-client?", socket_serverp, subr1, (SCM obj))
DEFINE_PRIMITIVE("socket-server?", socket_serverp, subr1, (SCM obj))
{
return MAKE_BOOLEAN(SOCKETP(obj) && SOCKET_TYPE(obj) == SOCKET_CLIENT);
}
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 12-Apr-2007 17:43 (eg)
* Last file update: 13-Apr-2007 12:25 (eg)
*/
// INLINER values
......@@ -435,7 +435,7 @@ static int add_global(SCM ref)
int i;
/* Search this global in the already accessed globals */
for (i = 0; i < checked_globals_used-1; i++) {
for (i = 0; i < checked_globals_used; i++) {
if (checked_globals[i] == addr) return i;
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment