python.ss

   1 (module python mzscheme
   2   (require (only (lib "1.ss" "srfi") fold)
   3            (lib "foreign.ss")
   4            (lib "kw.ss"))
   5
   6   (provide (all-defined))
   7
   8
   9   (unsafe!)
  10
  11   (define libpy (ffi-lib "python25"))
  12
  13   (define py-initialize
  14     (get-ffi-obj "Py_Initialize" libpy (_fun -> _void)))
  15
  16   (py-initialize)  ;; It is the responsibility of the module importer
  17                    ;; to call (py-finalize)
  18
  19   (define py-finalize
  20     (get-ffi-obj "Py_Finalize" libpy (_fun -> _void)))
  21
  22
  23   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24   ;; Basic Python objecs
  25   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26
  27   (define py/obj
  28     (make-ctype _pointer #f #f))
  29
  30   (define py/str
  31     (get-ffi-obj "PyString_FromString" libpy
  32                  (_fun _string -> py/obj)))
  33
  34   (define py/int
  35     (get-ffi-obj "PyInt_FromLong" libpy
  36                  (_fun _long -> py/obj)))
  37
  38   (define py/str->string
  39     (get-ffi-obj "PyString_AsString" libpy
  40                  (_fun py/obj -> _string)))
  41
  42   (define py-run-simple-string
  43     (get-ffi-obj "PyRun_SimpleString" libpy
  44                  (_fun _string -> _void)))
  45
  46   (define py/apply
  47     (get-ffi-obj "PyObject_CallObject" libpy
  48                  (_fun py/obj py/obj -> py/obj)))
  49
  50   (define py/import
  51     (get-ffi-obj "PyImport_Import" libpy
  52                  (_fun py/obj -> py/obj)))
  53
  54   (define py/import-module
  55     (get-ffi-obj "PyImport_ImportModule" libpy
  56                  (_fun _string -> py/obj)))
  57
  58   (define py/getattr
  59     (get-ffi-obj "PyObject_GetAttrString" libpy
  60                  (_fun py/obj _string -> py/obj)))
  61
  62   (define py/setattr
  63     (get-ffi-obj "PyObject_SetAttrString" libpy
  64                  (_fun py/obj _string py/obj ->  _int)))
  65
  66   (define py/getitem
  67     (get-ffi-obj "PySequence_GetItem" libpy
  68                  (_fun py/obj _int -> py/obj)))
  69
  70   (define py/err-occured
  71     (get-ffi-obj "PyErr_Occurred" libpy
  72                  (_fun -> _pointer)))
  73
  74   (define py/err-print
  75     (get-ffi-obj "PyErr_Print" libpy
  76                  (_fun -> _void)))
  77
  78
  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))
  88               (begin
  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)
  94         ;(display "-end\n")
  95         t)))
  96
  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))))
 108         (append-car args)
 109         l)))
 110
 111
 112   (define py/int-as-long
 113     (get-ffi-obj "PyInt_AsLong" libpy
 114                  (_fun py/obj -> _long)))
 115
 116   ;; The Python ``None'' object.
 117   ;; Note: _Py_NoneStruct is the ``unofficial'' and ``internal'', that is
 118   ;;       accessible via a C macro.
 119   (define py/none
 120     (ffi-obj-ref "_Py_NoneStruct" libpy ))
 121
 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)
 125   (define py/dot
 126     (lambda/kw (#:rest names)
 127       (define (attr-ref a b)
 128         ;; b.a
 129         (if (null? b)
 130             (if (string? a)
 131                 (py/mod a)
 132                 a)
 133             (py/getattr b (symbol->string a))))
 134       (fold attr-ref null names)))
 135
 136   ;; Import the Python module ``modname''
 137   (define (py/mod modname)
 138     (py/import (py/str modname)))
 139
 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"))
 142   (define py/call
 143     (lambda/kw (func #:rest args)
 144       (py/apply func (py/tuple args))))
 145
 146   ;; Syntax sugar for py/call
 147   ;; Usage:
 148   ;;   (@ (: "os" 'path 'join) "/usr" "share"))
 149   (define-syntax @
 150     (syntax-rules (:)
 151       ((_ (: flist ...) arg ...)
 152        (@ (py/dot flist ...) arg ...))
 153       ((_ f arg ...)
 154        (py/apply f (py/tuple (map ss->py (list arg ...)))))))
 155
 156   ;; Convert a Scheme type to corresponding Python type.
 157   ;; As fail case, return the Scheme type as such.
 158   (define (ss->py o)
 159     (cond
 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))
 165       (else o)))
 166
 167
 168   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 169   ;; ``compiler.ast'' module
 170   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 171
 172   (define ast
 173     (let ((ast (py/import-module "compiler.ast")))
 174       (lambda (node-type)
 175         (lambda/kw (#:rest r)
 176           (py/apply (py/getattr ast node-type)
 177                     (py/tuple r))))))
 178
 179   ;; Syntax sugar for constructing AST nodes
 180   ;; Usage:
 181   ;;   (@> Add (@> Name "a") (@> Name "b"))
 182   ;;   (@> And : (nodes ...))
 183   (define-syntax @>
 184     (syntax-rules (:)
 185       ((_ node : c-list)
 186        (apply (ast (symbol->string (car `(node))))
 187               (map ss->py c-list)))
 188       ((_ node c1 ...)
 189        (@> node : (list c1 ...)))))
 190
 191   'ok)