Skip to content

Add suport for adding a prefix to module exports #35

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
donaldsonjw wants to merge 4 commits into
base: master
Choose a base branch
from
Open

Add suport for adding a prefix to module exports #35

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
1b19db5
Add suport for adding a prefix to module exports
donaldsonjw Oct 19, 2019
587e152
Add support for import prefixes to bigloo interpreter
donaldsonjw Dec 1, 2019
a04e5dd
Merge remote-tracking branch 'upstream/master' into module_prefix
donaldsonjw May 15, 2020
1abbd63
Remove erroneous date method
donaldsonjw May 15, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 9 additions & 5 deletions comptime/Module/impuse.sch
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
;; ==========================================================
;; Class accessors
;; Bigloo (4.2c)
;; Inria -- Sophia Antipolis Fri Nov 6 10:55:25 CET 2015
;; (bigloo.new -classgen Module/impuse.scm)
;; Bigloo (4.3g)
;; Inria -- Sophia Antipolis Thu 05 Sep 2019 08:47:27 AM CEST
;; (bigloo -classgen Module/impuse.scm)
;; ==========================================================

;; The directives
Expand All @@ -11,7 +11,7 @@
;; import
(cond-expand ((and bigloo-class-sans (not bigloo-class-generate))
(static
(inline make-import::import module1080::symbol number1081::long mode1082::symbol vars1083::obj aliases1084::obj checksum1085::obj loc1086::obj src1087::obj decl1088::obj provide1089::pair-nil code1090::obj access1091::obj)
(inline make-import::import module1081::symbol number1082::long mode1083::symbol vars1084::obj aliases1085::obj prefix1086::obj checksum1087::obj loc1088::obj src1089::obj decl1090::obj provide1091::pair-nil code1092::obj access1093::obj)
(inline import?::bool ::obj)
(import-nil::import)
(inline import-access::obj ::import)
Expand All @@ -26,6 +26,8 @@
(inline import-loc::obj ::import)
(inline import-checksum::obj ::import)
(inline import-checksum-set! ::import ::obj)
(inline import-prefix::obj ::import)
(inline import-prefix-set! ::import ::obj)
(inline import-aliases::obj ::import)
(inline import-aliases-set! ::import ::obj)
(inline import-vars::obj ::import)
Expand All @@ -39,7 +41,7 @@
;; The definitions
(cond-expand (bigloo-class-sans
;; import
(define-inline (make-import::import module1080::symbol number1081::long mode1082::symbol vars1083::obj aliases1084::obj checksum1085::obj loc1086::obj src1087::obj decl1088::obj provide1089::pair-nil code1090::obj access1091::obj) (instantiate::import (module module1080) (number number1081) (mode mode1082) (vars vars1083) (aliases aliases1084) (checksum checksum1085) (loc loc1086) (src src1087) (decl decl1088) (provide provide1089) (code code1090) (access access1091)))
(define-inline (make-import::import module1081::symbol number1082::long mode1083::symbol vars1084::obj aliases1085::obj prefix1086::obj checksum1087::obj loc1088::obj src1089::obj decl1090::obj provide1091::pair-nil code1092::obj access1093::obj) (instantiate::import (module module1081) (number number1082) (mode mode1083) (vars vars1084) (aliases aliases1085) (prefix prefix1086) (checksum checksum1087) (loc loc1088) (src src1089) (decl decl1090) (provide provide1091) (code code1092) (access access1093)))
(define-inline (import?::bool obj::obj) ((@ isa? __object) obj (@ import module_impuse)))
(define (import-nil::import) (class-nil (@ import module_impuse)))
(define-inline (import-access::obj o::import) (-> |#!bigloo_wallow| o access))
Expand All @@ -56,6 +58,8 @@
(define-inline (import-loc-set! o::import v::obj) (set! (-> |#!bigloo_wallow| o loc) v))
(define-inline (import-checksum::obj o::import) (-> |#!bigloo_wallow| o checksum))
(define-inline (import-checksum-set! o::import v::obj) (set! (-> |#!bigloo_wallow| o checksum) v))
(define-inline (import-prefix::obj o::import) (-> |#!bigloo_wallow| o prefix))
(define-inline (import-prefix-set! o::import v::obj) (set! (-> |#!bigloo_wallow| o prefix) v))
(define-inline (import-aliases::obj o::import) (-> |#!bigloo_wallow| o aliases))
(define-inline (import-aliases-set! o::import v::obj) (set! (-> |#!bigloo_wallow| o aliases) v))
(define-inline (import-vars::obj o::import) (-> |#!bigloo_wallow| o vars))
Expand Down
63 changes: 47 additions & 16 deletions comptime/Module/impuse.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@
(mode::symbol (default 'import))
(vars (default '()))
(aliases (default '()))
(prefix (default #f))
(checksum (default #unspecified))
(loc read-only)
(src read-only)
Expand Down Expand Up @@ -123,15 +124,18 @@
;*---------------------------------------------------------------------*/
;* import-all-module ... */
;*---------------------------------------------------------------------*/
(define (import-all-module module::symbol mode src)
(define (import-all-module module::symbol prefix mode src)
(let ((mi (hashtable-get *imports* module)))
(if (import? mi)
(import-vars-set! mi 'all)
(begin
(import-vars-set! mi 'all)
(import-prefix-set! mi prefix))
(let ((loc (find-location/loc src (find-location *module-clause*))))
(register-import!
(instantiate::import
(module module)
(mode mode)
(prefix prefix)
(vars 'all)
(loc loc)
(src src)))))))
Expand All @@ -144,7 +148,7 @@
;* The CAR is the declared name of the binding and the CDR */
;* the aliased named, used in alias import clauses. */
;*---------------------------------------------------------------------*/
(define (import-1-module module::symbol var alias mode src)
(define (import-1-module module::symbol prefix var alias mode src)
(let ((mi (hashtable-get *imports* module)))
(if (import? mi)
;; patch the previous import
Expand All @@ -160,15 +164,21 @@
'nothing)
(else
(import-vars-set! mi
(cons (cons var #f) (import-vars mi))))))
(cons (cons var (if prefix (symbol-append prefix var) #f))
(import-vars mi))))))
;; register a new import
(let ((loc (find-location/loc src (find-location *module-clause*))))
(let ((loc (find-location/loc src (find-location *module-clause*)))
(aliases (if alias (list (cons var alias)) '()))
(prefixes (if (and var prefix)
(list (cons var (symbol-append prefix var)))
'())))
(register-import!
(instantiate::import
(module module)
(mode mode)
(aliases (if alias (list (cons var alias)) '()))
(vars (if alias '() (list (cons var #f))))
(prefix prefix)
(aliases (if alias aliases prefixes))
(vars (if (or prefix alias) '() (list (cons var #f))))
(loc loc)
(src src)))))))

Expand Down Expand Up @@ -196,6 +206,9 @@
;* | (variable module-name) */
;* | (variable module-name) */
;* | (variable module-name "file-name" *) */
;* | (prefix: prefix-symbol module-name)
;* | (prefix: prefix-symbol var-symbol module-name)
;* | (prefix: prefix-symbol var-symbol module-name "file-name")
;* variable ::= symbol */
;* | (symbol symbol) */
;*---------------------------------------------------------------------*/
Expand All @@ -213,13 +226,25 @@

(define (variable? v)
(or (symbol? v) (alias? v)))


(define (prefixed-import? prototype)
(and (list? prototype)
(eq? (car prototype) prefix:)
(>= (length prototype) 3)))

(define (prefix-name prototype)
(if (and (>= (length prototype) 3)
(symbol? (cadr prototype)))
(cadr prototype)
(err)))
(cond
((symbol? prototype)
;; module-name
(import-all-module prototype mode import-src))
(import-all-module prototype #f mode import-src))
((list? prototype)
(let ((inv (reverse prototype)))
(let* ((prefixed? (prefixed-import? prototype))
(prefix (if prefixed? (prefix-name prototype) #f))
(inv (reverse (if prefixed? (cddr prototype) prototype))))
(let loop ((lst inv)
(files '()))
(cond
Expand All @@ -234,15 +259,15 @@
((null? vars)
;; (module-name "file-name"+)
(if (pair? files) (module-add-access! mod files "."))
(import-all-module mod mode prototype))
(import-all-module mod prefix mode prototype))
((every variable? vars)
;; (var1 var2 ... varN module-name "file-name"*)
(when (pair? files)
(module-add-access! mod files "."))
(for-each (lambda (v)
(if (alias? v)
(import-1-module mod (cadr v) (car v) mode prototype)
(import-1-module mod v #f mode prototype)))
(import-1-module mod prefix (cadr v) (car v) mode prototype)
(import-1-module mod prefix v #f mode prototype)))
vars))
(else
(err)))))
Expand Down Expand Up @@ -459,15 +484,21 @@
;* import-everything ... */
;*---------------------------------------------------------------------*/
(define (import-everything import)
(with-access::import import (module provide src)
(with-access::import import (module prefix provide src)
(let loop ((provided provide)
(inline '())
(macro '())
(syntax '())
(expd '()))
(if (null? provided)
(values inline macro syntax expd)
(let ((p (import-parser module (car provided) #f src)))
(let* ((proto (if prefix (parse-prototype (car provided)) #f))
(alias-id (if (pair? proto)
(symbol-append prefix
(fast-id-of-id (cadr proto)
(find-location (car provided))))
#f))
(p (import-parser module (car provided) alias-id src)))
(match-case p
((? global?)
(let ((val (global-value p)))
Expand Down Expand Up @@ -495,7 +526,7 @@
;* import-wanted ... */
;*---------------------------------------------------------------------*/
(define (import-wanted import vars)
(with-access::import import (module provide src)
(with-access::import import (module prefix provide src)
(let loop ((provided provide)
(inline '())
(macro '())
Expand Down
6 changes: 3 additions & 3 deletions recette/module.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@

(module module
(include "test.sch")
(import (x import1 "import1.scm")
(import (:prefix imp1- x import1 "import1.scm")
(y z import1 "import1.scm")
(import2 "import2.scm")
((renamed-test1 import-test1) import1 "import1.scm")
Expand Down Expand Up @@ -51,9 +51,9 @@
;*---------------------------------------------------------------------*/
(define (test-modulel)
(test-module "module" "module.scm")
(test "@" (@ x import1) 1)
(test "prefix" imp1-x 1)
(test "@" (@ x import2) 2)
(test "@" (or (eq? x (@ x import1)) (eq? x (@ x import2))) #t)
(test "@" (or (eq? x (@ imp1-x import1)) (eq? x (@ x import2))) #t)
(test "inline/type" (z) 1)
(test "init/read" (init/read-test) '(init . (1 2 3 4)))
(test "rename.1" (renamed-test1) 'import-test1)
Expand Down
49 changes: 40 additions & 9 deletions runtime/Eval/evmodule.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -561,7 +561,12 @@
;*---------------------------------------------------------------------*/
;* evmodule-import! ... */
;*---------------------------------------------------------------------*/
(define (evmodule-import! mod ident path set abase loc)
(define (evmodule-import! mod ident prefix path set abase loc)

(define (prefix-binding s)
(if prefix
(symbol-append prefix s)
s))

(define (import-error msg obj)
(evcompile-error loc "eval" msg obj))
Expand All @@ -572,6 +577,15 @@
(hashtable-for-each (%evmodule-macros mod2)
(lambda (k v)
(hashtable-put! t k v))))

;; prefix exports when necessary
(when prefix
(for-each (lambda (b)
(when (or (null? set) (memq (car b) set))
(bind-alias! mod ident (prefix-binding (car b)) (car b)
loc)))
(%evmodule-exports mod2)))

;; bind variables
(for-each (lambda (b)
(when (or (null? set) (memq (car b) set))
Expand Down Expand Up @@ -614,6 +628,20 @@

(define (import-error arg)
(evcompile-error loc "eval" "Illegal `import' clause" arg))

(define (prefixed? clause)
(and (pair? clause) (eq? (car clause) :prefix)
(pair? (cdr clause)) (symbol? (cadr clause))))

(define (find-module-prefix clause)
(if (prefixed? clause)
(cadr clause)
#f))

(define (skip-prefix-if-present clause)
(if (prefixed? clause)
(cddr clause)
clause))

(define (find-module-files clause)
(cond
Expand Down Expand Up @@ -647,25 +675,28 @@
(cond
((symbol? s)
(let ((path ((bigloo-module-resolver) s '() abase)))
(evmodule-import! mod s path '() abase loc)))
(evmodule-import! mod s #f path '() abase loc)))
((or (not (pair? s))
(not (list? s))
(not (or (symbol? (car s)) (alias-pair? (car s)))))
(not (or (symbol? (car s)) (alias-pair? (car s))
(and (keyword? (car s)) (eq? (car s) :prefix)))))
(import-error s))
(else
(let ((files (find-module-files s))
(imod (find symbol? s))
(imports (find-module-imports s))
(aliases (find-module-aliases s))
(dir (or (location-dir loc) (pwd))))
(let* ((prefix (find-module-prefix s))
(s-w/out-prefix (skip-prefix-if-present s))
(files (find-module-files s-w/out-prefix))
(imod (find symbol? s-w/out-prefix))
(imports (find-module-imports s-w/out-prefix))
(aliases (find-module-aliases s-w/out-prefix))
(dir (or (location-dir loc) (pwd))))
(let ((path ((bigloo-module-resolver) imod files dir)))
(for-each (lambda (ap)
(bind-alias! mod imod
(car ap)
(cadr ap)
(or (get-source-location ap) loc)))
aliases)
(evmodule-import! mod imod path imports abase loc)))))))
(evmodule-import! mod imod prefix path imports abase loc)))))))

(if (not (list? clause))
(import-error clause)
Expand Down
10 changes: 0 additions & 10 deletions runtime/Jlib/date.java
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,16 +42,6 @@ public date( final long seconds ) {
timezone = -tmz.getRawOffset() / 1000;
}

public date( final long seconds, bool ) {
calendar = new GregorianCalendar();
final Date d = new Date();
d.setTime( seconds * 1000 );

calendar.setTime( d );
final TimeZone tmz = calendar.getTimeZone();
timezone = -tmz.getRawOffset() / 1000;
}

public date( final long nseconds, boolean _b ) {
calendar = new GregorianCalendar();
final Date d = new Date();
Expand Down