1 (module python mzscheme
2 (require (only (lib "1.ss" "srfi") fold)
6 (provide (all-defined))
11 (define libpy (ffi-lib "python25"))
14 (get-ffi-obj "Py_Initialize" libpy (_fun -> _void)))
16 (py-initialize) ;; It is the responsibility of the module importer
17 ;; to call (py-finalize)
20 (get-ffi-obj "Py_Finalize" libpy (_fun -> _void)))
23 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 ;; Basic Python objecs
25 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 (make-ctype _pointer #f #f))
31 (get-ffi-obj "PyString_FromString" libpy
32 (_fun _string -> py/obj)))
35 (get-ffi-obj "PyInt_FromLong" libpy
36 (_fun _long -> py/obj)))
38 (define py/str->string
39 (get-ffi-obj "PyString_AsString" libpy
40 (_fun py/obj -> _string)))
42 (define py-run-simple-string
43 (get-ffi-obj "PyRun_SimpleString" libpy
44 (_fun _string -> _void)))
47 (get-ffi-obj "PyObject_CallObject" libpy
48 (_fun py/obj py/obj -> py/obj)))
51 (get-ffi-obj "PyImport_Import" libpy
52 (_fun py/obj -> py/obj)))
54 (define py/import-module
55 (get-ffi-obj "PyImport_ImportModule" libpy
56 (_fun _string -> py/obj)))
59 (get-ffi-obj "PyObject_GetAttrString" libpy
60 (_fun py/obj _string -> py/obj)))
63 (get-ffi-obj "PyObject_SetAttrString" libpy
64 (_fun py/obj _string py/obj -> _int)))
67 (get-ffi-obj "PySequence_GetItem" libpy
68 (_fun py/obj _int -> py/obj)))
70 (define py/err-occured
71 (get-ffi-obj "PyErr_Occurred" libpy
75 (get-ffi-obj "PyErr_Print" libpy
79 ;; Convert `args*' to a Python tuple
80 (define (py/tuple args*)
81 (let ((py/tuple-new (get-ffi-obj "PyTuple_New" libpy
82 (_fun _int -> py/obj)))
83 (py/tuple-set (get-ffi-obj "PyTuple_SetItem" libpy
84 (_fun py/obj _int py/obj -> _void))))
85 (let ((t (py/tuple-new (length args*))))
86 (define (set-in-tuple args i)
87 (if (not (null? args))
89 ;(display (format "-- ~a\n" (car args)))
90 (py/tuple-set t i (car args))
91 (set-in-tuple (cdr args) (+ i 1)))))
92 ;(display (format "start - ~a\n" (length args*)))
93 (set-in-tuple args* 0)
97 ;; Convert `args' to a Python list
98 (define (py/list args)
99 (let ((py/list-new (get-ffi-obj "PyList_New" libpy
100 (_fun _int -> py/obj)))
101 (py/list-append (get-ffi-obj "PyList_Append" libpy
102 (_fun py/obj py/obj -> _int))))
103 (let ((l (py/list-new 0)))
104 (define (append-car args)
105 (when (not (null? args))
106 (py/list-append l (car args))
107 (append-car (cdr args))))
112 (define py/int-as-long
113 (get-ffi-obj "PyInt_AsLong" libpy
114 (_fun py/obj -> _long)))
116 ;; The Python ``None'' object.
117 ;; Note: _Py_NoneStruct is the ``unofficial'' and ``internal'', that is
118 ;; accessible via a C macro.
120 (ffi-obj-ref "_Py_NoneStruct" libpy ))
122 ;; Attribute access for Pythobn objects.
123 ;; If the first argument is a ``string'', it is imported as module.
124 ;; eg: (py/dot "os" 'path 'join)
126 (lambda/kw (#:rest names)
127 (define (attr-ref a b)
133 (py/getattr b (symbol->string a))))
134 (fold attr-ref null names)))
136 ;; Import the Python module ``modname''
137 (define (py/mod modname)
138 (py/import (py/str modname)))
140 ;; Use Python's ``apply'' to call the given function
141 ;; eg: (py/call (py/dot "os" 'path 'join) (py/str "/usr") (py/str "share"))
143 (lambda/kw (func #:rest args)
144 (py/apply func (py/tuple args))))
146 ;; Syntax sugar for py/call
148 ;; (@ (: "os" 'path 'join) "/usr" "share"))
151 ((_ (: flist ...) arg ...)
152 (@ (py/dot flist ...) arg ...))
154 (py/apply f (py/tuple (map ss->py (list arg ...)))))))
156 ;; Convert a Scheme type to corresponding Python type.
157 ;; As fail case, return the Scheme type as such.
160 ((null? o) (py/list o))
161 ((pair? o) (py/list o))
162 ((symbol? o) (py/str (symbol->string o)))
163 ((string? o) (py/str o))
164 ((number? o) (py/int o))
168 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
169 ;; ``compiler.ast'' module
170 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
173 (let ((ast (py/import-module "compiler.ast")))
175 (lambda/kw (#:rest r)
176 (py/apply (py/getattr ast node-type)
179 ;; Syntax sugar for constructing AST nodes
181 ;; (@> Add (@> Name "a") (@> Name "b"))
182 ;; (@> And : (nodes ...))
186 (apply (ast (symbol->string (car `(node))))
187 (map ss->py c-list)))
189 (@> node : (list c1 ...)))))