1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
;; -*-theme-d-*-
;; Copyright (C) 2025 Tommi Höynälänmaa
;; Distributed under GNU Lesser General Public License version 3,
;; see file doc/LGPL-3.
(define-body (standard-library plugins)
(import (standard-library string-utilities)
(standard-library object-string-conversion))
(add-method load-module
(unchecked-prim-proc load-module ((:uniform-list <symbol>))
(:alt-maybe <module>) nonpure))
(define-simple-method load-plugin
(((l-s-plugin (:uniform-list <symbol>))) <module> nonpure)
(let ((mod (load-module l-s-plugin)))
(match-type mod
((<boolean>)
(raise (make-rte-exception 'plugin-not-found
(list (cons 'l-s-plugin l-s-plugin)))))
((mod1 <module>)
(if (and (module-var-exists? mod1 'theme-d-plugin)
(equal? (module-ref mod1 'theme-d-plugin) #t))
mod1
(raise (make-rte-exception 'not-a-plugin-file
(list (cons 'l-s-plugin l-s-plugin)))))))))
(add-method module-var-exists?
(unchecked-prim-proc module-var-exists? (<module> <symbol>) <boolean> pure))
(add-method module-ref
(prim-proc module-ref (<module> <symbol>) <object> pure))
;; Procedures _i_dyn-call-proc and _i_dyn-apply-proc should work with
;; procedures returning nothing.
(add-method dyn-call
(prim-proc _i_dyn-call-proc (<object> (rest <object>)) <object> nonpure))
(add-method dyn-call-no-result
(unchecked-prim-proc _i_dyn-call-proc (<object> (rest <object>)) <none> nonpure))
(add-method dyn-apply
(prim-proc _i_dyn-apply-proc (<object> <list>) <object> nonpure))
(add-method dyn-apply-no-result
(unchecked-prim-proc _i_dyn-apply-proc (<object> <list>) <none> nonpure))
(define-simple-method get-exported-var-name
(((s-source-name <symbol>)) <symbol> pure)
(string->symbol
(string-append
"_x_"
(symbol->string s-source-name))))
(define-simple-method get-exported-ngp-name
(((s-source-name <symbol>)) <symbol> pure)
(string->symbol
(string-append
"_n_"
(symbol->string s-source-name))))
(define-simple-method get-exported-vgp-name
(((s-source-name <symbol>)) <symbol> pure)
(string->symbol
(string-append
"_v_"
(symbol->string s-source-name))))
(define-simple-method plugin-exported-normal-vars
(((plugin <module>)) (:uniform-list <symbol>) pure)
(cast (:uniform-list <symbol>)
(module-ref plugin 'l-exported-normal-vars)))
(define-simple-method plugin-exported-ngps
(((plugin <module>)) (:uniform-list <symbol>) pure)
(cast (:uniform-list <symbol>)
(module-ref plugin 'l-exported-ngps)))
(define-simple-method plugin-exported-vgps
(((plugin <module>)) (:uniform-list <symbol>) pure)
(cast (:uniform-list <symbol>)
(module-ref plugin 'l-exported-vgps))))
|
