├── Makefile ├── README.md ├── examples ├── Makefile ├── demo.scm ├── gui.sld ├── requests │ ├── .gitignore │ ├── requests.scm │ └── requirements.txt ├── ruamel.yaml │ ├── .gitignore │ ├── in.yaml │ ├── requirements.txt │ └── ruamel.scm └── spiral.sld ├── mocks.scm ├── pyffi#.scm ├── pyffi-test.scm ├── pyffi._must-build_ ├── pyffi.scm ├── pyffi.sld ├── python-config.py ├── six-convert.scm └── six.scm /Makefile: -------------------------------------------------------------------------------- 1 | build: 2 | gsc -e '(##build-module "pyffi.sld" (quote C) (quote ((module-ref github.com/feeley/pyffi))))' 3 | python3 -m venv ${HOME}/.gambit_venv 4 | 5 | test: 6 | gsi pyffi-test.scm 7 | 8 | ln: 9 | ln -s `pwd` "@" 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # pyffi 2 | Gambit Scheme library to interface to Python 3 | 4 | **This library depends on new Gambit features not yet made into a release. 5 | Please build using Gambit@HEAD.** 6 | 7 | **Programmers are encouraged to read the Python C API specification.** 8 | 9 | **The following instructions are written for pyffi developers. Users beware.** 10 | 11 | ## Build instructions 12 | 13 | NOTE: Make sure your `~/.gambit_userlib/github.com/feeley/pyffi` directory is clean of any prior artifacts (just remove it and re-create the symlink). 14 | 15 | The library is compatible with Gambit's primitive module system and the R7RS 16 | libraries. 17 | 18 | Assuming you 19 | - have compiled Gambit@HEAD, 20 | - are developing Gambit modules in `/home/me/dev/gambit-modules`, 21 | - have Python 3.x _with development sources_ available, 22 | 23 | these instructions should allow you to build `pyffi`: 24 | 25 | ``` 26 | cd /home/me/.gambit_userlib 27 | mkdir github.com 28 | mkdir github.com/feeley 29 | cd /home/me/dev/gambit-modules 30 | git clone https://github.com/feeley/pyffi 31 | cd pyffi 32 | make ln 33 | make 34 | ln -s /home/me/dev/gambit-modules/pyffi ~/.gambit_userlib/github.com/feeley/pyffi 35 | ``` 36 | 37 | ## Examples 38 | 39 | After building the library, you should be able to run the examples in the 40 | `examples` directory. Some examples require the use of `virtualenv`. Make sure 41 | you have it installed. A `Makefile` is provided to facilitate demonstrations. 42 | 43 | `Pyffi` currently only offers a relatively low-level API in sync with the Python 44 | C API. A higher level API is WIP. 45 | 46 | ### Vanilla python 47 | 48 | This example works out of the box requiring only built-in python modules. From 49 | the `pyffi` directory: 50 | 51 | ``` 52 | cd examples 53 | make demo 54 | ``` 55 | 56 | should output 57 | 58 | ``` 59 | gsi demo.scm 60 | result=200 61 | # 62 | "hello, world!" 63 | --------------------------------------------- 64 | # 65 | --------------------------------------------- 66 | #(# 67 | # 68 | # 69 | #) 70 | --------------------------------------------- 71 | (#!void #f #t #(#() () 42 "hello")) 72 | --------------------------------------------- 73 | (#!void #f #t #(#() () 42 "hello")) 74 | --------------------------------------------- 75 | ``` 76 | 77 | Notice the rich information displayed in the foreign objects. This information 78 | can be displayed or not depending on your needs. Modify 79 | [examples/demo.scm](examples/demo.scm) to `register-foreign-write-handlers` or 80 | not. 81 | 82 | ### Python + virtualenv 83 | 84 | A common way to manage python versions and dependencies is to use a virtual 85 | environment. Here we assume that you have installed `virtualenv` (not `python3 86 | -m venv`) and are able to use it. 87 | 88 | A lot of third-party libraries you will install in virtualenvs will require 89 | linking with `libpython`. The makefile sets `LD_PRELOAD` to the default 90 | python3.x shared library path on Debian 10. You will need to provide your own 91 | `LD_PRELOAD` if that default is not correct for your system. 92 | 93 | The makefile also sets the `VENV_PATH` environment variable. This is required to 94 | tell the Python C API where to look for modules. In our case, we want modules to 95 | be searched for in the virtualenv. 96 | 97 | #### requests 98 | 99 | As a first example using the low-level API, let's use the popular `requests` 100 | package from PyPI. From the `examples` directory: 101 | 102 | ``` 103 | make requests 104 | ``` 105 | 106 | That will set up the correct virtual environment and execute the code in the 107 | proper context: 108 | 109 | ``` 110 | # 111 | "{'origin': 'x.x.x.x'}" 112 | ``` 113 | 114 | Again, notice the rich foreign-object information. 115 | 116 | #### ruamel.yaml 117 | 118 | This example showcases another way to evaluate expressions using the low-level 119 | API. Here, in particular, we are concerned with evaluating a block of Python 120 | code without returning a value, using the `Py_file_input` [start 121 | symbol](https://docs.python.org/3/c-api/veryhigh.html). The code showcases file 122 | IO directly from Python. From the `examples` directory: 123 | 124 | ``` 125 | make ruamel.yaml 126 | ``` 127 | 128 | That will set up the correct virtual environment and execute the code in the 129 | proper context: 130 | 131 | ``` 132 | out.yaml: 133 | 134 | alpha: &a 135 | fun: true 136 | sad: false 137 | happy: true 138 | 139 | entries: 140 | - <<: *a 141 | purpose: cure cancer 142 | - <<: *a 143 | purpose: cure latency 144 | - <<: *a 145 | purpose: cure all the things 146 | ``` 147 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: requests ruamel.yaml 2 | 3 | UNAME := $(shell uname) 4 | 5 | getvar=$(shell python3 -c "import sysconfig; print(sysconfig.get_config_var('$(1)'))") 6 | 7 | PY_LIBPL=$(call getvar,LIBPL) 8 | PY_LIBRARY = $(call getvar,LIBRARY) # macOS 9 | PY_LDLIBRARY = $(call getvar,LDLIBRARY) # Linux 10 | 11 | # TODO: Handle Windows. 12 | ifeq ($(UNAME), Linux) 13 | PY_SHARED=$(PY_LIBPL)/$(PY_LDLIBRARY) 14 | PY_PRELOAD=LD_PRELOAD 15 | endif 16 | ifeq ($(UNAME), Darwin) 17 | PY_SHARED=$(PY_LIBPL)/$(PY_LIBRARY) 18 | PY_PRELOAD=DYLD_INSERT_LIBRARIES 19 | endif 20 | 21 | make-venv = virtualenv --python python3.7 venv && venv/bin/pip install -r requirements.txt 22 | 23 | demo: 24 | $(PY_PRELOAD)=$(PY_SHARED) \ 25 | gsi demo.scm 26 | 27 | requests: 28 | cd requests && \ 29 | if [ ! -d "venv" ]; then $(make-venv); fi; \ 30 | $(PY_PRELOAD)=$(PY_SHARED) \ 31 | VENV_PATH=venv \ 32 | gsi requests.scm 33 | 34 | ruamel.yaml: 35 | cd ruamel.yaml && \ 36 | if [ ! -d "venv" ]; then $(make-venv); fi; \ 37 | $(PY_PRELOAD)=$(PY_SHARED) \ 38 | VENV_PATH=venv \ 39 | gsi ruamel.scm 40 | -------------------------------------------------------------------------------- /examples/demo.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env gsi-script 2 | 3 | (import (github.com/feeley pyffi)) 4 | (import (gambit)) 5 | 6 | ;; enable rich python foreign-object representation 7 | (register-foreign-write-handlers) 8 | 9 | (Py_Initialize) 10 | 11 | (PyRun_SimpleString "print('result=' + repr(10*20));") 12 | 13 | (define __main__ 14 | (PyImport_AddModuleObject 15 | (string->PyObject*/str "__main__"))) 16 | (define globals (PyModule_GetDict __main__)) 17 | 18 | (define (pyrun s) 19 | (PyRun_String s Py_eval_input globals globals)) 20 | 21 | ;; manual type conversions 22 | (define pystr (pyrun "\"hello, world!\"")) ;; returns a PyObject*/str 23 | (pretty-print pystr) ;; PyObject*/str 24 | (pretty-print (PyObject*/str->string pystr)) ;; hello, world! 25 | 26 | (define (check-roundtrip py2scm scm2py vals) 27 | (for-each 28 | (lambda (x) 29 | ;;(##gc) 30 | (let* ((py (scm2py x)) 31 | (scm (py2scm py))) 32 | (if (not (equal? scm x)) 33 | (pretty-print (list 'error x '-> py '-> scm)) 34 | '(pretty-print (list 'ok '-> x py '-> scm))))) 35 | vals)) 36 | 37 | (define (checks) 38 | 39 | (check-roundtrip PyObject*/None->void 40 | void->PyObject*/None 41 | (list (void))) 42 | 43 | (check-roundtrip PyObject*/bool->boolean 44 | boolean->PyObject*/bool 45 | (list #f #t)) 46 | 47 | (check-roundtrip PyObject*/int->exact-integer 48 | exact-integer->PyObject*/int 49 | (list 42 50 | 2305843009213693951 ;; max fixnum 51 | #; 2305843009213693952 52 | #; 9223372036854775807 53 | #; 18446744073709551616)) 54 | 55 | (check-roundtrip PyObject*/str->string 56 | string->PyObject*/str 57 | (list "" 58 | "hello!\n")) 59 | ) 60 | 61 | (##gc) 62 | 63 | ;;(println "---------------------------------------------") 64 | 65 | #; 66 | (checks) 67 | 68 | #; 69 | (let loop ((n 1000000)) 70 | (if (> n 0) 71 | (begin 72 | (checks) 73 | (loop (- n 1))))) 74 | 75 | 76 | ;(pp (PyObject*/tuple->vector (pyrun "(True,42,\"hello\")"))) 77 | ;(pp (PyObject*->object (pyrun "(True,42,\"hello\")"))) 78 | 79 | (define x (pyrun "(None,False,True,[[],(),42,\"hello\"])")) 80 | (println "---------------------------------------------") 81 | (pp x) 82 | (println "---------------------------------------------") 83 | (pp (PyObject*/tuple->vector x)) 84 | (println "---------------------------------------------") 85 | (pp (PyObject*->object x)) 86 | (println "---------------------------------------------") 87 | (pp (PyObject*->object (object->PyObject* (PyObject*->object x)))) 88 | (println "---------------------------------------------") 89 | 90 | #; 91 | (let loop ((n 1000000)) 92 | (if (> n 0) 93 | (begin 94 | (PyObject*->object (object->PyObject* (PyObject*->object x))) 95 | (loop (- n 1))))) 96 | 97 | (Py_Finalize) 98 | -------------------------------------------------------------------------------- /examples/gui.sld: -------------------------------------------------------------------------------- 1 | (define-library (gui) 2 | 3 | (import (except (gambit) six.infix) 4 | (github.com/feeley/pyffi)) 5 | 6 | (begin 7 | 8 | ;; Prerequisite: pip3 install -U wxPython 9 | 10 | \import wx ;; import wxPython 11 | 12 | (define (main) 13 | (let* ((app \foreign(wx.App())) 14 | (frm \foreign(wx.Frame(None)))) 15 | 16 | \(\frm).Show() 17 | 18 | \(\app).MainLoop() 19 | )) 20 | 21 | (main) 22 | )) 23 | -------------------------------------------------------------------------------- /examples/requests/.gitignore: -------------------------------------------------------------------------------- 1 | venv/ -------------------------------------------------------------------------------- /examples/requests/requests.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env gsi-script 2 | 3 | (import (github.com/feeley pyffi)) 4 | (import (gambit)) 5 | 6 | ;; enable rich python foreign-object representation 7 | (register-foreign-write-handlers) 8 | 9 | (define VENV_PATH 10 | (getenv "VENV_PATH" #f)) 11 | 12 | (if (not VENV_PATH) 13 | (begin 14 | (display "VENV_PATH not set") (newline) 15 | (exit #f))) 16 | 17 | ;; Assumes a proper virtualenv, created with virtualenv, not python -m venv 18 | (define (venv-path->PYTHONPATH p) 19 | (string-append 20 | (string-append p "/bin/python") 21 | ":" (string-append p "/lib/python37.zip") 22 | ":" (string-append p "/lib/python3.7") 23 | ":" (string-append p "/lib/python3.7/lib-dynload") 24 | ":" (string-append p "/lib/python3.7/site-packages"))) 25 | 26 | (define PYTHONPATH 27 | (venv-path->PYTHONPATH VENV_PATH)) 28 | 29 | (Py_SetPath PYTHONPATH) 30 | (Py_SetPythonHome VENV_PATH) 31 | (Py_Initialize) 32 | 33 | (define __main__ (PyImport_AddModule "__main__")) 34 | (define globals (PyModule_GetDict __main__)) 35 | (define locals (PyDict_New)) 36 | 37 | (define py/requests (PyImport_ImportModule "requests")) 38 | (define py/json (PyImport_ImportModule "json")) 39 | (define py/requests_dict (PyModule_GetDict py/requests)) 40 | (define r (PyRun_String 41 | "get(\"http://httpbin.org/ip\")" 42 | Py_eval_input 43 | py/requests_dict 44 | locals)) 45 | 46 | (define r.json_dict (PyObject_CallMethod r "json" "")) 47 | (define r.json_text (PyObject_CallMethod r.json_dict "__str__" "")) 48 | 49 | (pp r.json_text) 50 | (pp (PyObject*/str->string r.json_text)) 51 | 52 | (Py_Finalize) 53 | -------------------------------------------------------------------------------- /examples/requests/requirements.txt: -------------------------------------------------------------------------------- 1 | requests==2.31.0 2 | -------------------------------------------------------------------------------- /examples/ruamel.yaml/.gitignore: -------------------------------------------------------------------------------- 1 | venv/ -------------------------------------------------------------------------------- /examples/ruamel.yaml/in.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | alpha: &a 3 | fun: true 4 | sad: false 5 | happy: true 6 | 7 | entries: 8 | - <<: *a 9 | purpose: cure cancer 10 | - <<: *a 11 | purpose: cure latency 12 | - <<: *a 13 | purpose: cure all the things 14 | -------------------------------------------------------------------------------- /examples/ruamel.yaml/requirements.txt: -------------------------------------------------------------------------------- 1 | ruamel.yaml==0.16.10 2 | ruamel.yaml.clib==0.2.0 3 | -------------------------------------------------------------------------------- /examples/ruamel.yaml/ruamel.scm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env gsi-script 2 | 3 | (import (github.com/feeley pyffi)) 4 | (import (gambit)) 5 | 6 | ;; enable rich python foreign-object representation 7 | (register-foreign-write-handlers) 8 | 9 | (define VENV_PATH 10 | (getenv "VENV_PATH" #f)) 11 | 12 | (if (not VENV_PATH) 13 | (begin 14 | (display "VENV_PATH not set") (newline) 15 | (exit #f))) 16 | 17 | ;; Assumes a proper virtualenv, created with virtualenv, not python -m venv 18 | (define (venv-path->PYTHONPATH p) 19 | (string-append 20 | (string-append p "/bin/python") 21 | ":" (string-append p "/lib/python37.zip") 22 | ":" (string-append p "/lib/python3.7") 23 | ":" (string-append p "/lib/python3.7/lib-dynload") 24 | ":" (string-append p "/lib/python3.7/site-packages"))) 25 | 26 | (define PYTHONPATH 27 | (venv-path->PYTHONPATH VENV_PATH)) 28 | 29 | (Py_SetPath PYTHONPATH) 30 | (Py_SetPythonHome VENV_PATH) 31 | (Py_Initialize) 32 | 33 | (define __main__ (PyImport_AddModule "__main__")) 34 | (define globals (PyModule_GetDict __main__)) 35 | (define locals (PyDict_New)) 36 | 37 | ;; vectors map to lists, strings map to strings: 38 | (define from-list (object->PyObject* #("YAML"))) 39 | ;; Use PyImport_ImportModuleEx for stronger control. 40 | ;; Equivalent to 'from ruamel.yaml import YAML': 41 | (define py/ruamel.yaml (PyImport_ImportModuleEx 42 | "ruamel.yaml" 43 | globals 44 | locals 45 | from-list)) 46 | (define py/ruamel.yaml_dict (PyModule_GetDict py/ruamel.yaml)) 47 | 48 | ;; Store 'YAML()' from the py/ryamel.yaml_dict context 49 | ;; into the variable 'yaml' inside the globals context 50 | (PyRun_String "yaml = YAML()" Py_file_input py/ruamel.yaml_dict globals) 51 | 52 | ;; You can wrap the operation in a python try/except and print to the console 53 | ;; or you can let Gambit handle the exception. 54 | ;; Try changing the name of 'in.yaml' to one that does not exist. 55 | (PyRun_String " 56 | with open('./out.yaml', 'w') as outs: 57 | with open('./in.yaml', 'r') as ins: 58 | doc = yaml.load(ins) 59 | yaml.indent(mapping=2, sequence=4, offset=2) 60 | yaml.dump(doc, outs) 61 | " 62 | Py_file_input ;; execute, don't return! 63 | globals 64 | locals) 65 | 66 | (Py_Finalize) 67 | 68 | (define out 69 | (call-with-input-file "out.yaml" 70 | (lambda (port) (read-line port #f)))) 71 | 72 | (display "out.yaml:\n\n") 73 | (display out) 74 | -------------------------------------------------------------------------------- /examples/spiral.sld: -------------------------------------------------------------------------------- 1 | (define-library (spiral) 2 | 3 | (import (except (gambit) six.infix) 4 | (github.com/feeley/pyffi)) 5 | 6 | (begin 7 | 8 | \import turtle 9 | 10 | (define title \turtle.title) 11 | (define clear \turtle.clear) 12 | (define penup \turtle.penup) 13 | (define pendown \turtle.pendown) 14 | (define forward \turtle.forward) 15 | (define backward \turtle.backward) 16 | (define left \turtle.left) 17 | (define mainloop \turtle.mainloop) 18 | 19 | (define (spiral n) 20 | (if (> n 0) 21 | (begin 22 | (forward (* 20 n)) 23 | (left 90) 24 | (spiral (- n 1))))) 25 | 26 | (define (main) 27 | (title "spiral") 28 | (clear) 29 | (penup) 30 | (backward 200) 31 | (pendown) 32 | (spiral 20) 33 | (mainloop)) 34 | 35 | (main) 36 | )) 37 | -------------------------------------------------------------------------------- /mocks.scm: -------------------------------------------------------------------------------- 1 | ;; We have to handle different cases: 2 | ;; 3 | ;; 1) Scheme objects that are passed to python functions 4 | ;; 2) Python objects that are passed to scheme functions 5 | ;; 3) Bidirectional objects that support mutation on either side 6 | 7 | (import (github.com/feeley pyffi)) 8 | 9 | \import math 10 | (define pi \math.pi) 11 | (define (py-sqrt n) \math.sqrt(\n)) 12 | (define res (py-sqrt 9)) 13 | (for-each display `("Square root of 9: " ,res "\n")) 14 | 15 | (define (circle-area r) 16 | (* pi r r)) 17 | (for-each display `("Area of circle of radius pi: " 18 | ,(circle-area pi) "\n")) 19 | (define (hypot x y) 20 | \math.hypot(\x, \y)) 21 | (for-each display `("Hypothenuse of triangle of sides of length 3 and 4: " 22 | ,(hypot 3 4) "\n")) 23 | 24 | \import time 25 | (define (_time) \time.time()) 26 | (define (sleep n) \time.sleep(\n)) 27 | (define then (_time)) 28 | (for-each display `("Current time is: " ,then "\n")) 29 | (display "Sleeping for 3 seconds...") (newline) 30 | (sleep 3) 31 | (define now (_time)) 32 | (for-each display `("Current time is: " ,now "\n")) 33 | (define delta (- now then)) 34 | (for-each display `("Time delta is : " ,delta "\n")) 35 | 36 | ;; \import datetime 37 | ;; (define then \datetime.datetime.now()) 38 | ;; (sleep 3) 39 | ;; (define now \datetime.datetime.now()) 40 | ;; (define delta (- now then)) 41 | ;; (define seconds \\(delta).total_seconds()) 42 | 43 | ;; (pip install requests) 44 | ;; \import requests 45 | ;; (define url "https://jsonplaceholder.typicode.com/todos/1") 46 | ;; (define r \requests.get(\url)) 47 | ;; (define r.json \\(r).json()) 48 | 49 | ;; \from flask import Flask 50 | ;; (define app \Flask(__name__)) 51 | ;; (@ app route (list '/') 52 | ;; (define (hello-world) 53 | ;; "Hello, world!")) 54 | -------------------------------------------------------------------------------- /pyffi#.scm: -------------------------------------------------------------------------------- 1 | ;;;============================================================================ 2 | 3 | ;;; File: "pyffi#.scm" 4 | 5 | ;;; Copyright (c) 2020-2021 by Marc Feeley, All Rights Reserved. 6 | ;;; Copyright (c) 2020-2021 by Marc-André Bélanger, All Rights Reserved. 7 | 8 | ;;;============================================================================ 9 | 10 | (##namespace ("github.com/feeley/pyffi#" 11 | 12 | ;; Debug 13 | _Py_REFCNT 14 | 15 | ;; Constants 16 | Py_eval_input 17 | Py_file_input 18 | Py_single_input 19 | 20 | ;; Initialization, Finalization, and Threads 21 | Py_Initialize 22 | Py_Finalize 23 | Py_SetPath 24 | Py_SetPythonHome 25 | 26 | ;; PyRun_* 27 | PyRun_SimpleString 28 | PyRun_String 29 | 30 | ;; PyImport_* 31 | PyImport_AddModuleObject 32 | PyImport_AddModule 33 | PyImport_ImportModule 34 | PyImport_ImportModuleEx 35 | 36 | ;; PyModule_* 37 | PyModule_GetDict 38 | 39 | ;; PyDict_* 40 | PyDict_New 41 | PyDict_Size 42 | PyDict_Items 43 | PyDict_Keys 44 | PyDict_Values 45 | PyDict_GetItem 46 | PyDict_SetItem 47 | PyDict_GetItemString 48 | PyDict_SetItemString 49 | 50 | ;; PyList_* 51 | PyList_New 52 | 53 | ;; PyTuple_* 54 | PyTuple_GetItem 55 | 56 | ;; PyBool_* 57 | PyBool_FromLong 58 | 59 | ;; PyLong_* 60 | PyLong_FromUnicodeObject 61 | 62 | ;; PyUnicode_* 63 | PyUnicode_FromString 64 | 65 | ;; PyObject_* 66 | PyObject_CallMethod 67 | PyObject_GetAttrString 68 | PyObject_Length 69 | PyObject_Repr 70 | PyObject*-type 71 | PyObject*-type-name 72 | 73 | ;; Call Python callables 74 | PyObject_CallObject 75 | PyObject_CallFunctionObjArgs 76 | PyObject_CallFunctionObjArgs* 77 | PyObject_CallFunctionObjArgs0 78 | PyObject_CallFunctionObjArgs1 79 | PyObject_CallFunctionObjArgs2 80 | PyObject_CallFunctionObjArgs3 81 | PyObject_CallFunctionObjArgs4 82 | 83 | ;; Converters 84 | PyObject*/None->void 85 | void->PyObject*/None 86 | PyObject*/bool->boolean 87 | boolean->PyObject*/bool 88 | PyObject*/int->exact-integer 89 | exact-integer->PyObject*/int 90 | PyObject*/float->flonum 91 | flonum->PyObject*/float 92 | PyObject*/str->string 93 | string->PyObject*/str 94 | PyObject*/bytes->u8vector 95 | u8vector->PyObject*/bytes 96 | PyObject*/bytearray->u8vector 97 | u8vector->PyObject*/bytearray 98 | PyObject*/list->vector 99 | vector->PyObject*/list 100 | PyObject*/list->list 101 | list->PyObject*/list 102 | PyObject*/tuple->vector 103 | vector->PyObject*/tuple 104 | PyObject*/tuple->list 105 | list->PyObject*/tuple 106 | PyObject*->object 107 | object->PyObject* 108 | 109 | ;; Misc 110 | register-foreign-write-handlers 111 | pip-install 112 | pip 113 | py-eval 114 | py-exec 115 | py-import 116 | current-python-interpreter 117 | six.infix 118 | convert 119 | python 120 | 121 | )) 122 | 123 | ;;;============================================================================ 124 | -------------------------------------------------------------------------------- /pyffi-test.scm: -------------------------------------------------------------------------------- 1 | 2 | ;; Legacy load of pyintf 3 | (import (github.com/feeley pyffi)) 4 | 5 | ;; Tests. 6 | (Py_Initialize) 7 | 8 | (define __main__ (PyImport_AddModuleObject (string->PyObject*/str "__main__"))) 9 | (define __main__dict (PyModule_GetDict __main__)) 10 | 11 | ;; Run an expression 12 | (define (pyrun str) (PyRun_String str Py_eval_input __main__dict __main__dict)) 13 | ;; Run a statement 14 | (define (pyrun* str) (PyRun_String str Py_single_input __main__dict __main__dict)) 15 | 16 | ;; check conversion of various subtypes 17 | (begin 18 | (pp (pyrun "__builtins__")) 19 | (pp (pyrun "None")) 20 | (pp (pyrun "1>2")) 21 | (pp (pyrun "1<2")) 22 | (pp (pyrun "1+2*3")) 23 | (pp (pyrun "3.1415")) 24 | (pp (pyrun "1+2j")) 25 | (pp (pyrun "b'abc'")) 26 | (pp (pyrun "bytearray(b'abc')")) 27 | (pp (pyrun "'abc'")) 28 | (pp (pyrun "[1,2,3]")) 29 | (pp (pyrun "{}")) 30 | (pp (pyrun "frozenset()")) 31 | (pp (pyrun "set()")) 32 | (pp (pyrun "(1,2,3)")) 33 | ) 34 | 35 | ;; check roundtrip of strings 36 | (begin 37 | (pp (PyObject*/str->string (string->PyObject*/str "hello"))) 38 | 39 | (pp (PyObject*/str->string (pyrun "'ab'+'cd'"))) 40 | 41 | (with-exception-catcher 42 | (lambda (exc) (print "exception: ") (display-exception exc)) 43 | (lambda () (pp (PyObject*/str->string (pyrun "'ab'+1"))))) 44 | ) 45 | 46 | ;(Py_Finalize) 47 | 48 | ;;;---------------------------------------------------------------------------- 49 | -------------------------------------------------------------------------------- /pyffi._must-build_: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/feeley/pyffi/d4ad18e481c008af8b775fdc94dfd3f3a3acba7b/pyffi._must-build_ -------------------------------------------------------------------------------- /pyffi.scm: -------------------------------------------------------------------------------- 1 | ;;;============================================================================ 2 | 3 | ;;; File: "pyffi.scm" 4 | 5 | ;;; Copyright (c) 2020-2021 by Marc Feeley, All Rights Reserved. 6 | ;;; Copyright (c) 2020-2021 by Marc-André Bélanger, All Rights Reserved. 7 | 8 | ;;;============================================================================ 9 | 10 | ;;; Python FFI. 11 | 12 | (##supply-module github.com/feeley/pyffi) 13 | 14 | (##namespace ("github.com/feeley/pyffi#")) ;; in github.com/feeley/pyffi# 15 | (##include "~~lib/gambit/prim/prim#.scm") ;; map fx+ to ##fx+, etc 16 | (##include "~~lib/_gambit#.scm") ;; for macro-check-procedure, 17 | ;; macro-absent-obj, etc 18 | (##include "~~lib/gambit#.scm") ;; shell-command 19 | 20 | (##include "pyffi#.scm") ;; correctly map pyffi ops 21 | 22 | (declare (extended-bindings)) ;; ##fx+ is bound to fixnum addition, etc 23 | ;; (declare (not safe)) ;; claim code has no type errors 24 | (declare (block)) ;; claim no global is assigned 25 | 26 | ;;;---------------------------------------------------------------------------- 27 | 28 | ;; Generate meta information to link to Python libs. 29 | 30 | (define-syntax gen-meta-info 31 | (lambda (src) 32 | (define (string-strip-trailing-return! str) 33 | (if (string? str) 34 | (let ((newlen (- (string-length str) 1))) 35 | (if (char=? #\return (string-ref str newlen)) 36 | (string-shrink! str newlen)))) 37 | str) 38 | 39 | (let ((sh 40 | (parameterize ((current-directory 41 | (path-directory (##source-path src)))) 42 | (shell-command "python3 python-config.py" #t)))) 43 | 44 | (if (not (= (car sh) 0)) 45 | (error "Error executing python3-config.py" sh)) 46 | 47 | (let* ((res 48 | (call-with-input-string (cdr sh) 49 | (lambda (port) 50 | (read-all port (lambda (p) (string-strip-trailing-return! (read-line p))))))) 51 | (pyver (list-ref res 0)) 52 | ;; TODO: Act on Python C compiler? 53 | (pycc (list-ref res 1)) 54 | (ldflags (list-ref res 2)) 55 | (cflags (list-ref res 3)) 56 | (libdir (list-ref res 4))) 57 | 58 | ;; TODO: Better version handling. Temporary peg to >= 3. 59 | (if (not (eq? (string-ref pyver 0) #\3)) 60 | (error "Pyffi only supports CPython 3 and up." pyver)) 61 | 62 | `(begin 63 | (define PYVER ,pyver) 64 | (define LIBDIR ,libdir) 65 | (##meta-info ld-options ,ldflags) 66 | (##meta-info cc-options ,cflags)))))) 67 | 68 | (gen-meta-info) 69 | 70 | ;;;---------------------------------------------------------------------------- 71 | 72 | ;; Get Python C API. 73 | 74 | (c-declare #< 78 | 79 | typedef PyObject *PyObjectPtr; 80 | 81 | #define DEBUG_PYTHON_REFCNT_not 82 | 83 | #ifdef DEBUG_PYTHON_REFCNT 84 | 85 | #define PYOBJECTPTR_INCREF(obj, where) \ 86 | do { \ 87 | Py_INCREF(obj); \ 88 | printf(where " REFCNT(%p)=%ld after INCREF\n", obj, Py_REFCNT(obj)); \ 89 | fflush(stdout); \ 90 | } while (0) 91 | 92 | #define PYOBJECTPTR_DECREF(obj, where) \ 93 | do { \ 94 | printf(where " REFCNT(%p)=%ld before DECREF\n", obj, Py_REFCNT(obj)); \ 95 | fflush(stdout); \ 96 | Py_DECREF(obj); \ 97 | } while (0) 98 | 99 | #define PYOBJECTPTR_REFCNT_SHOW(obj, where) \ 100 | do { \ 101 | if (obj != NULL) { \ 102 | printf(where " REFCNT(%p)=%ld\n", obj, Py_REFCNT(obj)); \ 103 | fflush(stdout); \ 104 | } \ 105 | } while (0) 106 | 107 | #else 108 | 109 | #define PYOBJECTPTR_INCREF(obj, where) Py_INCREF(obj) 110 | #define PYOBJECTPTR_DECREF(obj, where) Py_DECREF(obj) 111 | #define PYOBJECTPTR_REFCNT_SHOW(obj, where) 112 | 113 | #endif 114 | 115 | ___SCMOBJ release_PyObjectPtr(void *obj) { 116 | 117 | if (Py_IsInitialized()) // Avoid mem management after Python is shutdown 118 | PYOBJECTPTR_DECREF(___CAST(PyObjectPtr, obj), "release_PyObjectPtr"); 119 | 120 | return ___FIX(___NO_ERR); 121 | } 122 | 123 | end-of-c-declare 124 | ) 125 | 126 | ;;;---------------------------------------------------------------------------- 127 | 128 | ;; Define PyObject* foreign type. 129 | 130 | (c-define-type PyObject "PyObject") 131 | 132 | (c-define-type _PyObject* 133 | (nonnull-pointer 134 | PyObject 135 | (PyObject* 136 | PyObject*/None 137 | PyObject*/bool 138 | PyObject*/int 139 | PyObject*/float 140 | PyObject*/complex 141 | PyObject*/bytes 142 | PyObject*/bytearray 143 | PyObject*/str 144 | PyObject*/list 145 | PyObject*/dict 146 | PyObject*/frozenset 147 | PyObject*/set 148 | PyObject*/tuple 149 | PyObject*/module 150 | PyObject*/type 151 | PyObject*/function 152 | PyObject*/cell 153 | ))) 154 | 155 | (c-define-type PyObject* 156 | "void*" 157 | "PYOBJECTPTR_to_SCMOBJ" 158 | "SCMOBJ_to_PYOBJECTPTR" 159 | #t) 160 | 161 | (c-define-type PyObject*!own 162 | "void*" 163 | "PYOBJECTPTR_OWN_to_SCMOBJ" 164 | "SCMOBJ_to_PYOBJECTPTR_OWN" 165 | #t) 166 | 167 | ;;;---------------------------------------------------------------------------- 168 | 169 | ;; Define PyObject* subtypes. 170 | 171 | (define-macro (define-python-subtype-type subtype) 172 | (define type (string-append "PyObjectPtr_" subtype)) 173 | (define _name (string->symbol (string-append "_PyObject*/" subtype))) 174 | (define name (string->symbol (string-append "PyObject*/" subtype))) 175 | (define name-own (string->symbol (string-append "PyObject*!own/" subtype))) 176 | (define TYPE (string-append "PYOBJECTPTR_" (string-upcase subtype))) 177 | (define TYPE-OWN (string-append "PYOBJECTPTR_OWN_" (string-upcase subtype))) 178 | (define to-scmobj (string-append TYPE "_to_SCMOBJ")) 179 | (define from-scmobj (string-append "SCMOBJ_to_" TYPE)) 180 | (define to-scmobj-own (string-append TYPE-OWN "_to_SCMOBJ")) 181 | (define from-scmobj-own (string-append "SCMOBJ_to_" TYPE-OWN)) 182 | `(begin 183 | (c-declare ,(string-append "typedef PyObjectPtr " type ";")) 184 | (c-define-type ,_name (nonnull-pointer PyObject ,name)) 185 | (c-define-type ,name "void*" ,to-scmobj ,from-scmobj #t) 186 | (c-define-type ,name-own "void*" ,to-scmobj-own ,from-scmobj-own #t))) 187 | 188 | (define-python-subtype-type "None") 189 | (define-python-subtype-type "bool") 190 | (define-python-subtype-type "int") 191 | (define-python-subtype-type "float") 192 | (define-python-subtype-type "complex") 193 | (define-python-subtype-type "bytes") 194 | (define-python-subtype-type "bytearray") 195 | (define-python-subtype-type "str") 196 | (define-python-subtype-type "list") 197 | (define-python-subtype-type "dict") 198 | (define-python-subtype-type "frozenset") 199 | (define-python-subtype-type "set") 200 | (define-python-subtype-type "tuple") 201 | (define-python-subtype-type "module") 202 | (define-python-subtype-type "type") 203 | (define-python-subtype-type "function") 204 | (define-python-subtype-type "cell") 205 | 206 | ;;;---------------------------------------------------------------------------- 207 | 208 | ;; Define PyTypeObject* foreign type. 209 | 210 | ;; NOTE: Not sure yet if we want to use raw PyTypeObjects. 211 | 212 | (c-define-type PyTypeObject "PyTypeObject") 213 | 214 | (c-define-type PyTypeObject* 215 | (nonnull-pointer PyTypeObject (PyTypeObject*))) 216 | 217 | ;;;---------------------------------------------------------------------------- 218 | 219 | ;; Generator of converter macros. 220 | 221 | (define-macro (define-converter-macros _SUBTYPE _OWN release) 222 | `(c-declare ,(string-append " 223 | 224 | #define ___BEGIN_CFUN_SCMOBJ_to_PYOBJECTPTR" _OWN _SUBTYPE "(src,dst,i) \ 225 | if ((___err = SCMOBJ_to_PYOBJECTPTR" _SUBTYPE "(src, &dst, i)) == ___FIX(___NO_ERR)) { 226 | #define ___END_CFUN_SCMOBJ_to_PYOBJECTPTR" _OWN _SUBTYPE "(src,dst,i) " release "} 227 | 228 | #define ___BEGIN_CFUN_PYOBJECTPTR" _OWN _SUBTYPE "_to_SCMOBJ(src,dst) \ 229 | if ((___err = PYOBJECTPTR" _OWN _SUBTYPE "_to_SCMOBJ(src, &dst, 0)) == ___FIX(___NO_ERR)) { 230 | #define ___END_CFUN_PYOBJECTPTR" _OWN _SUBTYPE "_to_SCMOBJ(src,dst) ___EXT(___release_scmobj)(dst); } 231 | 232 | #define ___BEGIN_SFUN_PYOBJECTPTR" _OWN _SUBTYPE "_to_SCMOBJ(src,dst,i) \ 233 | if ((___err = PYOBJECTPTR" _OWN _SUBTYPE "_to_SCMOBJ(src, &dst, i)) == ___FIX(___NO_ERR)) { 234 | #define ___END_SFUN_PYOBJECTPTR" _OWN _SUBTYPE "_to_SCMOBJ(src,dst,i) ___EXT(___release_scmobj)(dst); } 235 | 236 | #define ___BEGIN_SFUN_SCMOBJ_to_PYOBJECTPTR" _OWN _SUBTYPE "(src,dst) \ 237 | if ((___err = SCMOBJ_to_PYOBJECTPTR" _SUBTYPE "(src, &dst, 0)) == ___FIX(___NO_ERR)) { 238 | #define ___END_SFUN_SCMOBJ_to_PYOBJECTPTR" _OWN _SUBTYPE "(src,dst) " release "} 239 | "))) 240 | 241 | ;;;---------------------------------------------------------------------------- 242 | 243 | ;; Converter for Python* type that detects the subtype. 244 | 245 | (c-declare #<string 633 | (PyObject_Repr val)) 634 | "\n" 635 | (PyObject*/str->string 636 | (PyObject_Repr tb)) 637 | "\n" 638 | ) 639 | port) 640 | ) 641 | (cons (python-exception-proc exc) 642 | (python-exception-args exc))))) 643 | 644 | (define (pyffi-error-handler code data proc . args) 645 | (raise (make-python-exception data proc args))) 646 | 647 | ;;;---------------------------------------------------------------------------- 648 | 649 | ;; Interface to Python API. 650 | 651 | (define-macro (def-api name result-type arg-types) 652 | (let* ((result-type-str 653 | (symbol->string result-type)) 654 | (base-result-type-str 655 | (if (eqv? 0 (##string-contains result-type-str "PyObject*")) 656 | "PyObjectPtr" 657 | result-type-str))) 658 | `(define ,name 659 | (c-lambda ,arg-types 660 | ,result-type 661 | ,(string-append "return_with_check_" 662 | base-result-type-str 663 | "(" 664 | (symbol->string name) 665 | "(" 666 | (append-strings 667 | (map (lambda (i) 668 | (string-append "___arg" (number->string i))) 669 | (iota (length arg-types) 1)) 670 | ",") 671 | "));"))))) 672 | 673 | (define Py_eval_input ((c-lambda () int "___return(Py_eval_input);"))) 674 | (define Py_file_input ((c-lambda () int "___return(Py_file_input);"))) 675 | (define Py_single_input ((c-lambda () int "___return(Py_single_input);"))) 676 | 677 | (def-api Py_Initialize void ()) 678 | (def-api Py_Finalize void ()) 679 | 680 | (def-api PyBool_FromLong PyObject*/bool (long)) 681 | 682 | (def-api PyLong_FromUnicodeObject PyObject*/int (PyObject*/str int)) 683 | 684 | (def-api PyUnicode_FromString PyObject*/str (nonnull-UTF-8-string)) 685 | 686 | (def-api PyRun_SimpleString int (nonnull-UTF-8-string)) 687 | 688 | (def-api PyRun_String PyObject* (nonnull-UTF-8-string 689 | int 690 | PyObject*/dict 691 | PyObject*/dict)) 692 | 693 | (def-api PyImport_AddModuleObject PyObject*/module (PyObject*/str)) 694 | (def-api PyImport_AddModule PyObject*/module (nonnull-UTF-8-string)) 695 | (def-api PyImport_ImportModule PyObject*/module (nonnull-UTF-8-string)) 696 | (def-api PyImport_ImportModuleEx PyObject*/module (nonnull-UTF-8-string 697 | PyObject*/dict 698 | PyObject*/dict 699 | PyObject*/list)) 700 | 701 | (def-api PyModule_GetDict PyObject*/dict (PyObject*/module)) 702 | 703 | (def-api PyDict_New PyObject*/dict ()) 704 | (def-api PyDict_Size ssize_t (PyObject*/dict)) 705 | (def-api PyDict_Items PyObject*/list (PyObject*/dict)) 706 | (def-api PyDict_Keys PyObject*/list (PyObject*/dict)) 707 | (def-api PyDict_Values PyObject*/list (PyObject*/dict)) 708 | (def-api PyDict_GetItem PyObject* (PyObject*/dict 709 | PyObject*)) 710 | (def-api PyDict_SetItem int (PyObject*/dict 711 | PyObject* 712 | PyObject*)) 713 | (def-api PyDict_GetItemString PyObject* (PyObject*/dict 714 | nonnull-UTF-8-string)) 715 | (def-api PyDict_SetItemString int (PyObject*/dict 716 | nonnull-UTF-8-string 717 | PyObject*)) 718 | 719 | (def-api PyCell_New PyObject*/cell (PyObject*)) 720 | (def-api PyCell_Get PyObject* (PyObject*/cell)) 721 | (def-api PyCell_Set int (PyObject*/cell 722 | PyObject*)) 723 | 724 | (def-api PyList_New PyObject*/list (int)) 725 | 726 | (def-api PyTuple_GetItem PyObject* (PyObject*/tuple 727 | ssize_t)) 728 | 729 | (def-api PyObject_CallObject PyObject* (PyObject* 730 | PyObject*/tuple)) 731 | (def-api PyObject_CallMethod PyObject* (PyObject* 732 | nonnull-UTF-8-string 733 | nonnull-UTF-8-string)) 734 | 735 | (def-api PyObject_GetAttrString PyObject* (PyObject* 736 | nonnull-UTF-8-string)) 737 | 738 | (def-api PyObject_Length ssize_t (PyObject*)) 739 | 740 | (def-api PyObject_Repr PyObject*/str (PyObject*)) 741 | 742 | (def-api Py_SetPath void (nonnull-wchar_t-string)) 743 | (def-api Py_SetPythonHome void (nonnull-wchar_t-string)) 744 | 745 | ;; NOTE: Maybe migrate to `def-api' 746 | ;; TODO: Sub-interpreters 747 | (c-define-type PyThreadState "PyThreadState") 748 | (c-define-type PyThreadState* (nonnull-pointer PyThreadState)) 749 | (define Py_NewInterpreter 750 | (c-lambda () PyThreadState* "Py_NewInterpreter")) 751 | 752 | ;; Get object type from struct field, no new reference. 753 | (define PyObject*-type 754 | (c-lambda (_PyObject*) PyTypeObject* 755 | "___return(___arg1->ob_type);")) 756 | 757 | (define PyObject*-type-name 758 | (c-lambda (_PyObject*) nonnull-UTF-8-string 759 | "___return(___CAST(char*,___arg1->ob_type->tp_name));")) 760 | 761 | ;; Use for debugging 762 | (define _Py_REFCNT 763 | (c-lambda (PyObject*) ssize_t 764 | "___return(Py_REFCNT(___arg1));")) 765 | 766 | ;;;---------------------------------------------------------------------------- 767 | 768 | ;; Converters between Scheme and subtypes of Python* foreign objects. 769 | 770 | ;; TODO: check for errors and implement conversion of other subtypes... 771 | 772 | (define PyObject*/None->void 773 | (c-lambda (PyObject*/None) scheme-object " 774 | 775 | ___return(___VOID); 776 | 777 | ")) 778 | 779 | (define void->PyObject*/None 780 | (c-lambda (scheme-object) PyObject*/None " 781 | 782 | ___SCMOBJ src = ___arg1; 783 | PyObjectPtr dst = NULL; 784 | 785 | if (___EQP(src, ___VOID)) { 786 | dst = Py_None; 787 | PYOBJECTPTR_INCREF(dst, \"void->PyObject*/None\"); 788 | } 789 | 790 | ___return(dst); 791 | 792 | ")) 793 | 794 | (define PyObject*/bool->boolean 795 | (c-lambda (PyObject*/bool) scheme-object " 796 | 797 | ___return(___BOOLEAN(___arg1 != Py_False)); 798 | 799 | ")) 800 | 801 | (define boolean->PyObject*/bool 802 | (c-lambda (scheme-object) PyObject*/bool " 803 | 804 | ___SCMOBJ src = ___arg1; 805 | PyObjectPtr dst = NULL; 806 | 807 | if (___BOOLEANP(src)) { 808 | dst = ___FALSEP(src) ? Py_False : Py_True; 809 | PYOBJECTPTR_INCREF(dst, \"boolean->PyObject*/bool\"); 810 | } 811 | 812 | ___return(dst); 813 | 814 | ")) 815 | 816 | (define (PyObject*/int->exact-integer src) 817 | (let ((dst 818 | ((c-lambda (PyObject*/int) scheme-object " 819 | 820 | PyObjectPtr src = ___arg1; 821 | ___SCMOBJ dst = ___VOID; 822 | 823 | int overflow; 824 | ___LONGLONG val = PyLong_AsLongLongAndOverflow(src, &overflow); 825 | 826 | if (overflow) { 827 | /* TODO: use _PyLong_AsByteArray(...) */ 828 | } else { 829 | if (___EXT(___LONGLONG_to_SCMOBJ)(___PSTATE, 830 | val, 831 | &dst, 832 | ___RETURN_POS) 833 | != ___FIX(___NO_ERR)) 834 | dst = ___VOID; 835 | } 836 | 837 | ___return(___EXT(___release_scmobj) (dst)); 838 | 839 | ") 840 | src))) 841 | (if (eq? dst (void)) 842 | (error "PyObject*/int->exact-integer conversion error") 843 | dst))) 844 | 845 | (define exact-integer->PyObject*/int 846 | (c-lambda (scheme-object) PyObject*/int " 847 | 848 | ___SCMOBJ src = ___arg1; 849 | PyObjectPtr dst = NULL; 850 | 851 | if (___FIXNUMP(src)) { 852 | dst = PyLong_FromLongLong(___INT(src)); 853 | } else { 854 | 855 | #ifdef ___LITTLE_ENDIAN 856 | /* 857 | * Conversion is simple when words are represented in little endian 858 | * because bignums are also stored with the big digits from the least 859 | * signigicant digit to the most significant digit. So when viewed 860 | * as an array of bytes the bytes are from least significant to most 861 | * significant. 862 | */ 863 | dst = _PyLong_FromByteArray( 864 | ___CAST(const unsigned char*,___BODY_AS(src,___tSUBTYPED)), 865 | ___HD_BYTES(___SUBTYPED_HEADER(src)), 866 | 1, /* little_endian */ 867 | 1); /* is_signed */ 868 | #endif 869 | 870 | #ifdef ___BIG_ENDIAN 871 | /* TODO: use _PyLong_FromByteArray(...) after copying bignum */ 872 | #endif 873 | } 874 | 875 | PYOBJECTPTR_REFCNT_SHOW(dst, \"exact-integer->PyObject*/int\"); 876 | 877 | ___return(dst); 878 | 879 | ")) 880 | 881 | (define PyObject*/float->flonum 882 | (c-lambda (PyObject*/float) double " 883 | 884 | ___return(PyFloat_AS_DOUBLE(___arg1)); 885 | 886 | ")) 887 | 888 | (define flonum->PyObject*/float 889 | (c-lambda (double) PyObject*/float " 890 | 891 | PyObjectPtr dst = PyFloat_FromDouble(___arg1); 892 | 893 | PYOBJECTPTR_REFCNT_SHOW(dst, \"flonum->PyObject*/float\"); 894 | 895 | ___return(dst); 896 | 897 | ")) 898 | 899 | (define (PyObject*/str->string src) 900 | (let ((dst 901 | ((c-lambda (PyObject*/str) scheme-object " 902 | 903 | PyObjectPtr src = ___arg1; 904 | ___SCMOBJ dst = ___VOID; 905 | 906 | if (!PyUnicode_READY(src)) { /* convert to canonical representation */ 907 | 908 | Py_ssize_t len = PyUnicode_GET_LENGTH(src); 909 | 910 | dst = ___EXT(___alloc_scmobj) (___PSTATE, ___sSTRING, len << ___LCS); 911 | 912 | if (___FIXNUMP(dst)) 913 | dst = ___VOID; 914 | else 915 | switch (PyUnicode_KIND(src)) { 916 | case PyUnicode_1BYTE_KIND: 917 | { 918 | Py_UCS1 *data = PyUnicode_1BYTE_DATA(src); 919 | while (len-- > 0) 920 | ___STRINGSET(dst, ___FIX(len), ___CHR(data[len])); 921 | break; 922 | } 923 | case PyUnicode_2BYTE_KIND: 924 | { 925 | Py_UCS2 *data = PyUnicode_2BYTE_DATA(src); 926 | while (len-- > 0) 927 | ___STRINGSET(dst, ___FIX(len), ___CHR(data[len])); 928 | break; 929 | } 930 | case PyUnicode_4BYTE_KIND: 931 | { 932 | Py_UCS4 *data = PyUnicode_4BYTE_DATA(src); 933 | while (len-- > 0) 934 | ___STRINGSET(dst, ___FIX(len), ___CHR(data[len])); 935 | break; 936 | } 937 | } 938 | } 939 | 940 | ___return(___EXT(___release_scmobj) (dst)); 941 | 942 | ") 943 | src))) 944 | (if (eq? dst (void)) 945 | (error "PyObject*/str->string conversion error") 946 | dst))) 947 | 948 | (define string->PyObject*/str 949 | (c-lambda (scheme-object) PyObject*/str " 950 | 951 | ___SCMOBJ src = ___arg1; 952 | 953 | if (!___STRINGP(src)) { 954 | ___return(NULL); 955 | } else { 956 | PyObjectPtr dst = PyUnicode_FromKindAndData(___CS_SELECT( 957 | PyUnicode_1BYTE_KIND, 958 | PyUnicode_2BYTE_KIND, 959 | PyUnicode_4BYTE_KIND), 960 | ___CAST(void*, 961 | ___BODY_AS(src,___tSUBTYPED)), 962 | ___INT(___STRINGLENGTH(src))); 963 | PYOBJECTPTR_REFCNT_SHOW(dst, \"string->PyObject*/str\"); 964 | ___return(dst); 965 | } 966 | 967 | ")) 968 | 969 | (define (PyObject*/list->vector src) 970 | (let ((dst 971 | ((c-lambda (PyObject*/list) scheme-object " 972 | 973 | PyObjectPtr src = ___arg1; 974 | Py_ssize_t len = PyList_GET_SIZE(src); 975 | ___SCMOBJ dst = ___EXT(___make_vector) (___PSTATE, len, ___FIX(0)); 976 | 977 | if (___FIXNUMP(dst)) { 978 | ___return(___VOID); 979 | } else { 980 | Py_ssize_t i; 981 | for (i=0; ivector conversion error") 999 | dst))) 1000 | 1001 | (define vector->PyObject*/list 1002 | (c-lambda (scheme-object) PyObject*/list " 1003 | 1004 | ___SCMOBJ src = ___arg1; 1005 | 1006 | if (!___VECTORP(src)) { 1007 | ___return(NULL); 1008 | } else { 1009 | Py_ssize_t len = ___INT(___VECTORLENGTH(src)); 1010 | PyObjectPtr dst = PyList_New(len); 1011 | if (dst == NULL) { 1012 | ___return(NULL); 1013 | } else { 1014 | Py_ssize_t i; 1015 | for (i=0; iPyObject*/list\"); 1021 | PyList_SET_ITEM(dst, i, ___CAST(PyObjectPtr,item_py)); 1022 | } else { 1023 | PYOBJECTPTR_DECREF(dst, \"vector->PyObject*/list\"); 1024 | ___return(NULL); 1025 | } 1026 | } 1027 | PYOBJECTPTR_REFCNT_SHOW(dst, \"vector->PyObject*/list\"); 1028 | ___return(dst); 1029 | } 1030 | } 1031 | 1032 | ")) 1033 | 1034 | (define (PyObject*/tuple->vector src) 1035 | (let ((dst 1036 | ((c-lambda (PyObject*/tuple) scheme-object " 1037 | 1038 | PyObjectPtr src = ___arg1; 1039 | Py_ssize_t len = PyTuple_GET_SIZE(src); 1040 | ___SCMOBJ dst = ___EXT(___make_vector) (___PSTATE, len, ___FIX(0)); 1041 | 1042 | if (___FIXNUMP(dst)) { 1043 | ___return(___VOID); 1044 | } else { 1045 | Py_ssize_t i; 1046 | for (i=0; ivector conversion error") 1064 | dst))) 1065 | 1066 | (define (PyObject*/list->list src) 1067 | (vector->list (PyObject*/list->vector src))) 1068 | 1069 | (define (list->PyObject*/list src) 1070 | (vector->PyObject*/list (list->vector src))) 1071 | 1072 | (define vector->PyObject*/tuple 1073 | (c-lambda (scheme-object) PyObject*/tuple " 1074 | 1075 | ___SCMOBJ src = ___arg1; 1076 | 1077 | if (!___VECTORP(src)) { 1078 | ___return(NULL); 1079 | } else { 1080 | Py_ssize_t len = ___INT(___VECTORLENGTH(src)); 1081 | PyObjectPtr dst = PyTuple_New(len); 1082 | if (dst == NULL) { 1083 | ___return(NULL); 1084 | } else { 1085 | Py_ssize_t i; 1086 | for (i=0; iPyObject*/tuple\"); 1092 | PyTuple_SET_ITEM(dst, i, ___CAST(PyObjectPtr,item_py)); 1093 | } else { 1094 | PYOBJECTPTR_DECREF(dst, \"vector->PyObject*/tuple\"); 1095 | ___return(NULL); 1096 | } 1097 | } 1098 | PYOBJECTPTR_REFCNT_SHOW(dst, \"vector->PyObject*/tuple\"); 1099 | ___return(dst); 1100 | } 1101 | } 1102 | 1103 | ")) 1104 | 1105 | (define (PyObject*/tuple->list src) 1106 | (vector->list (PyObject*/tuple->vector src))) 1107 | 1108 | (define (list->PyObject*/tuple src) 1109 | (vector->PyObject*/tuple (list->vector src))) 1110 | 1111 | (define (PyObject*/bytes->u8vector src) 1112 | (let ((dst 1113 | ((c-lambda (PyObject*/bytes) scheme-object " 1114 | 1115 | PyObjectPtr src = ___arg1; 1116 | Py_ssize_t len = PyBytes_GET_SIZE(src); 1117 | ___SCMOBJ dst = ___EXT(___alloc_scmobj) (___PSTATE, ___sU8VECTOR, len); 1118 | 1119 | if (___FIXNUMP(dst)) { 1120 | ___return(___VOID); 1121 | } else { 1122 | memmove(___BODY_AS(dst,___tSUBTYPED), PyBytes_AS_STRING(src), len); 1123 | ___return(___EXT(___release_scmobj) (dst)); 1124 | } 1125 | 1126 | ") 1127 | src))) 1128 | (if (eq? dst (void)) 1129 | (error "PyObject*/bytes->u8vector conversion error") 1130 | dst))) 1131 | 1132 | (define u8vector->PyObject*/bytes 1133 | (c-lambda (scheme-object) PyObject*/bytes " 1134 | 1135 | ___SCMOBJ src = ___arg1; 1136 | 1137 | if (!___U8VECTORP(src)) { 1138 | ___return(NULL); 1139 | } else { 1140 | Py_ssize_t len = ___INT(___U8VECTORLENGTH(src)); 1141 | PyObjectPtr dst = PyBytes_FromStringAndSize( 1142 | ___CAST(char*,___BODY_AS(src,___tSUBTYPED)), 1143 | len); 1144 | PYOBJECTPTR_REFCNT_SHOW(dst, \"u8vector->PyObject*/bytes\"); 1145 | ___return(dst); 1146 | } 1147 | 1148 | ")) 1149 | 1150 | (define (PyObject*/bytearray->u8vector src) 1151 | (let ((dst 1152 | ((c-lambda (PyObject*/bytearray) scheme-object " 1153 | 1154 | PyObjectPtr src = ___arg1; 1155 | Py_ssize_t len = PyByteArray_GET_SIZE(src); 1156 | ___SCMOBJ dst = ___EXT(___alloc_scmobj) (___PSTATE, ___sU8VECTOR, len); 1157 | 1158 | if (___FIXNUMP(dst)) { 1159 | ___return(___VOID); 1160 | } else { 1161 | memmove(___BODY_AS(dst,___tSUBTYPED), PyByteArray_AS_STRING(src), len); 1162 | ___return(___EXT(___release_scmobj) (dst)); 1163 | } 1164 | 1165 | ") 1166 | src))) 1167 | (if (eq? dst (void)) 1168 | (error "PyObject*/bytearray->u8vector conversion error") 1169 | dst))) 1170 | 1171 | (define u8vector->PyObject*/bytearray 1172 | (c-lambda (scheme-object) PyObject*/bytearray " 1173 | 1174 | ___SCMOBJ src = ___arg1; 1175 | 1176 | if (!___U8VECTORP(src)) { 1177 | ___return(NULL); 1178 | } else { 1179 | Py_ssize_t len = ___INT(___U8VECTORLENGTH(src)); 1180 | PyObjectPtr dst = PyByteArray_FromStringAndSize( 1181 | ___CAST(char*,___BODY_AS(src,___tSUBTYPED)), 1182 | len); 1183 | PYOBJECTPTR_REFCNT_SHOW(dst, \"u8vector->PyObject*/bytearray\"); 1184 | ___return(dst); 1185 | } 1186 | 1187 | ")) 1188 | 1189 | ;;;---------------------------------------------------------------------------- 1190 | 1191 | ;; Generic converters. 1192 | 1193 | (define (PyObject*->object src) 1194 | 1195 | (define (conv src) 1196 | (case (car (##foreign-tags src)) 1197 | ((PyObject*/None) (PyObject*/None->void src)) 1198 | ((PyObject*/bool) (PyObject*/bool->boolean src)) 1199 | ((PyObject*/int) (PyObject*/int->exact-integer src)) 1200 | ((PyObject*/float) (PyObject*/float->flonum src)) 1201 | ((PyObject*/str) (PyObject*/str->string src)) 1202 | ((PyObject*/bytes) (PyObject*/bytes->u8vector src)) 1203 | ((PyObject*/bytearray) (PyObject*/bytearray->u8vector src)) 1204 | ((PyObject*/list) (list-conv src)) 1205 | ((PyObject*/tuple) (vector-conv src)) 1206 | ((PyObject*/dict) (table-conv src)) 1207 | ((PyObject*/function) (procedure-conv src)) 1208 | ((PyObject*/cell) (PyCell_Get src)) 1209 | (else (error "can't convert" src)))) 1210 | 1211 | (define (list-conv src) 1212 | (let* ((vect (PyObject*/list->vector src)) 1213 | (len (vector-length vect))) 1214 | (let loop ((i (fx- len 1)) (lst '())) 1215 | (if (fx< i 0) 1216 | lst 1217 | (loop (fx- i 1) 1218 | (cons (conv (vector-ref vect i)) 1219 | lst)))))) 1220 | 1221 | (define (vector-conv src) 1222 | (let ((vect (PyObject*/tuple->vector src))) 1223 | (let loop ((i (fx- (vector-length vect) 1))) 1224 | (if (fx< i 0) 1225 | vect 1226 | (begin 1227 | (vector-set! vect i (conv (vector-ref vect i))) 1228 | (loop (fx- i 1))))))) 1229 | 1230 | (define (table-conv src) 1231 | (let ((table (make-table))) 1232 | (for-each (lambda (key) 1233 | (let ((val (PyDict_GetItem src key))) 1234 | (table-set! table 1235 | (PyObject*->object key) 1236 | (PyObject*->object val)))) 1237 | (PyObject*/list->list (PyDict_Keys src))) 1238 | table)) 1239 | 1240 | (define (procedure-conv callable) 1241 | (lambda args 1242 | (PyObject*->object 1243 | (PyObject_CallFunctionObjArgs* 1244 | callable 1245 | (map object->PyObject* args))))) 1246 | 1247 | (if (##foreign? src) 1248 | (conv src) 1249 | src)) 1250 | 1251 | (define (object->PyObject* src) 1252 | 1253 | (define (conv src) 1254 | (cond ((eq? src (void)) (void->PyObject*/None src)) 1255 | ((boolean? src) (boolean->PyObject*/bool src)) 1256 | ((exact-integer? src) (exact-integer->PyObject*/int src)) 1257 | ((flonum? src) (flonum->PyObject*/float src)) 1258 | ((string? src) (string->PyObject*/str src)) 1259 | ((u8vector? src) (u8vector->PyObject*/bytes src)) 1260 | ((or (null? src) (pair? src)) (list-conv src)) 1261 | ((vector? src) (vector-conv src)) 1262 | ((table? src) (table-conv src)) 1263 | ((and (##foreign? src) 1264 | (memq (car (##foreign-tags src)) 1265 | '(PyObject* 1266 | PyObject*/None 1267 | PyObject*/bool 1268 | PyObject*/int 1269 | PyObject*/float 1270 | PyObject*/complex 1271 | PyObject*/bytes 1272 | PyObject*/bytearray 1273 | PyObject*/str 1274 | PyObject*/list 1275 | PyObject*/dict 1276 | PyObject*/frozenset 1277 | PyObject*/set 1278 | PyObject*/tuple 1279 | PyObject*/module 1280 | PyObject*/type 1281 | PyObject*/function 1282 | PyObject*/cell))) 1283 | src) 1284 | (else 1285 | (error "can't convert" src)))) 1286 | 1287 | (define (list-conv src) 1288 | (let loop1 ((probe src) (len 0)) 1289 | (if (pair? probe) 1290 | (loop1 (cdr probe) (fx+ len 1)) 1291 | (let ((vect (make-vector len))) 1292 | (let loop2 ((probe src) (i 0)) 1293 | (if (not (and (fx< i len) (pair? probe))) 1294 | (vector->PyObject*/list vect) 1295 | (begin 1296 | (vector-set! vect i (conv (car probe))) 1297 | (loop2 (cdr probe) (fx+ i 1))))))))) 1298 | 1299 | (define (vector-conv src) 1300 | (let* ((len (vector-length src)) 1301 | (vect (make-vector len))) 1302 | (let loop ((i (fx- len 1))) 1303 | (if (fx< i 0) 1304 | (vector->PyObject*/tuple vect) 1305 | (begin 1306 | (vector-set! vect i (conv (vector-ref src i))) 1307 | (loop (fx- i 1))))))) 1308 | 1309 | (define (u8vector-conv src) 1310 | (let* ((len (vector-length src)) 1311 | (vect (make-vector len))) 1312 | (let loop ((i (fx- len 1))) 1313 | (if (fx< i 0) 1314 | (vector->PyObject*/tuple vect) 1315 | (begin 1316 | (vector-set! vect i (conv (vector-ref src i))) 1317 | (loop (fx- i 1))))))) 1318 | 1319 | (define (table-conv src) 1320 | (let ((dst (PyDict_New))) 1321 | (table-for-each 1322 | (lambda (key val) 1323 | (PyDict_SetItem dst 1324 | (object->PyObject* key) 1325 | (object->PyObject* val))) 1326 | src) 1327 | dst)) 1328 | 1329 | (conv src)) 1330 | 1331 | ;;;---------------------------------------------------------------------------- 1332 | 1333 | ;; TODO: get rid of this by improving Gambit C interface. 1334 | 1335 | (define dummy 1336 | (list 1337 | (c-lambda () _PyObject* "___return(NULL);") 1338 | (c-lambda () _PyObject*/None "___return(NULL);") 1339 | (c-lambda () _PyObject*/bool "___return(NULL);") 1340 | (c-lambda () _PyObject*/int "___return(NULL);") 1341 | (c-lambda () _PyObject*/float "___return(NULL);") 1342 | (c-lambda () _PyObject*/complex "___return(NULL);") 1343 | (c-lambda () _PyObject*/bytes "___return(NULL);") 1344 | (c-lambda () _PyObject*/bytearray "___return(NULL);") 1345 | (c-lambda () _PyObject*/str "___return(NULL);") 1346 | (c-lambda () _PyObject*/list "___return(NULL);") 1347 | (c-lambda () _PyObject*/dict "___return(NULL);") 1348 | (c-lambda () _PyObject*/frozenset "___return(NULL);") 1349 | (c-lambda () _PyObject*/set "___return(NULL);") 1350 | (c-lambda () _PyObject*/tuple "___return(NULL);") 1351 | (c-lambda () _PyObject*/module "___return(NULL);") 1352 | (c-lambda () _PyObject*/type "___return(NULL);") 1353 | (c-lambda () _PyObject*/function "___return(NULL);") 1354 | (c-lambda () _PyObject*/cell "___return(NULL);"))) 1355 | 1356 | ;;;---------------------------------------------------------------------------- 1357 | 1358 | ;; Call Python callables from Scheme. 1359 | 1360 | (define (PyObject_CallFunctionObjArgs callable . args) 1361 | (PyObject_CallFunctionObjArgs* callable args)) 1362 | 1363 | (define (PyObject_CallFunctionObjArgs* callable args) 1364 | (if (not (pair? args)) 1365 | (PyObject_CallFunctionObjArgs0 callable) 1366 | (let ((arg1 (car args)) 1367 | (rest (cdr args))) 1368 | (if (not (pair? rest)) 1369 | (PyObject_CallFunctionObjArgs1 callable arg1) 1370 | (let ((arg2 (car rest)) 1371 | (rest (cdr rest))) 1372 | (if (not (pair? rest)) 1373 | (PyObject_CallFunctionObjArgs2 callable arg1 arg2) 1374 | (let ((arg3 (car rest)) 1375 | (rest (cdr rest))) 1376 | (if (not (pair? rest)) 1377 | (PyObject_CallFunctionObjArgs3 callable arg1 arg2 arg3) 1378 | (let ((arg4 (car rest)) 1379 | (rest (cdr rest))) 1380 | (if (not (pair? rest)) 1381 | (PyObject_CallFunctionObjArgs4 callable arg1 arg2 arg3 arg4) 1382 | (PyObject_CallObject 1383 | callable 1384 | (list->PyObject*/tuple args)))))))))))) 1385 | 1386 | (define PyObject_CallFunctionObjArgs0 1387 | (c-lambda (PyObject*) PyObject* " 1388 | 1389 | return_with_check_PyObjectPtr(PyObject_CallFunctionObjArgs(___arg1, NULL)); 1390 | 1391 | ")) 1392 | 1393 | (define PyObject_CallFunctionObjArgs1 1394 | (c-lambda (PyObject* PyObject*) PyObject* " 1395 | 1396 | return_with_check_PyObjectPtr(PyObject_CallFunctionObjArgs(___arg1, ___arg2, NULL)); 1397 | 1398 | ")) 1399 | 1400 | (define PyObject_CallFunctionObjArgs2 1401 | (c-lambda (PyObject* PyObject* PyObject*) PyObject* " 1402 | 1403 | return_with_check_PyObjectPtr(PyObject_CallFunctionObjArgs(___arg1, ___arg2, ___arg3, NULL)); 1404 | 1405 | ")) 1406 | 1407 | (define PyObject_CallFunctionObjArgs3 1408 | (c-lambda (PyObject* PyObject* PyObject* PyObject*) PyObject* " 1409 | 1410 | return_with_check_PyObjectPtr(PyObject_CallFunctionObjArgs(___arg1, ___arg2, ___arg3, ___arg4, NULL)); 1411 | 1412 | ")) 1413 | 1414 | (define PyObject_CallFunctionObjArgs4 1415 | (c-lambda (PyObject* PyObject* PyObject* PyObject* PyObject*) PyObject* " 1416 | 1417 | return_with_check_PyObjectPtr(PyObject_CallFunctionObjArgs(___arg1, ___arg2, ___arg3, ___arg4, ___arg5, NULL)); 1418 | 1419 | ")) 1420 | 1421 | ;;;---------------------------------------------------------------------------- 1422 | 1423 | ;; Misc 1424 | 1425 | (define (PyObject*-register-foreign-write-handler t) 1426 | (##readtable-foreign-write-handler-register! 1427 | ##main-readtable 1428 | t 1429 | (lambda (we obj) 1430 | (##wr-sn* we obj t PyObject*-wr-str)))) 1431 | 1432 | 1433 | (define (PyObject*-wr-str we obj) 1434 | (let* ((repr (PyObject_Repr obj)) 1435 | (s (PyObject*/str->string repr))) 1436 | (if (> (string-length s) 50) 1437 | (##wr-str we (string-append "\n" s)) 1438 | (##wr-str we (string-append " " s))))) 1439 | 1440 | (define (register-foreign-write-handlers) 1441 | (define python-subtypes 1442 | '(PyObject* 1443 | PyObject*/None 1444 | PyObject*/bool 1445 | PyObject*/int 1446 | PyObject*/float 1447 | PyObject*/complex 1448 | PyObject*/bytes 1449 | PyObject*/bytearray 1450 | PyObject*/str 1451 | PyObject*/list 1452 | PyObject*/dict 1453 | PyObject*/frozenset 1454 | PyObject*/set 1455 | PyObject*/tuple 1456 | PyObject*/module 1457 | PyObject*/type 1458 | PyObject*/function 1459 | PyObject*/cell 1460 | )) 1461 | (for-each PyObject*-register-foreign-write-handler python-subtypes)) 1462 | 1463 | ;; TODO: Make more robust. 1464 | ;; Assumes a proper virtualenv, created with virtualenv, not python -m venv 1465 | (define (venv-path->PYTHONPATH p) 1466 | ;; PYVER is, for example, "3.7" and we need "37" 1467 | (let ((PYVER-no-dot 1468 | (list->string (list (string-ref PYVER 0) 1469 | (string-ref PYVER 2))))) 1470 | (string-append 1471 | "''" 1472 | ":" (string-append LIBDIR "/python" PYVER-no-dot ".zip") 1473 | ":" (string-append LIBDIR "/python" PYVER) 1474 | ":" (string-append LIBDIR "/python" PYVER "/lib-dynload") 1475 | ;; per venv site-packages 1476 | ":" (string-append p "/lib/python" PYVER "/site-packages")))) 1477 | 1478 | 1479 | (define-macro (pip . args) 1480 | (define (pip* args) 1481 | (let ((home (string-append (user-info-home (user-info (user-name))) "/.gambit_venv"))) 1482 | (shell-command (string-append home "/bin/pip" args)))) 1483 | (let lp ((sargs (map symbol->string args)) 1484 | (out "")) 1485 | (if (eq? (cdr sargs) '()) 1486 | (pip* (string-append out " " (car sargs))) 1487 | (lp (cdr sargs) (string-append out " " (car sargs)))))) 1488 | 1489 | (define default-virtual-env 1490 | (make-parameter 1491 | (let ((default (string-append (user-info-home (user-info (user-name))) "/.gambit_venv"))) 1492 | (getenv "VIRTUAL_ENV" default)))) 1493 | 1494 | (define-type python-interpreter virtual-env pythonpath __main__ globals) 1495 | 1496 | (define (make-main-python-interpreter #!optional (virtual-env (default-virtual-env))) 1497 | (let* ((VIRTUAL_ENV virtual-env) 1498 | (PYTHONPATH (venv-path->PYTHONPATH VIRTUAL_ENV))) 1499 | 1500 | (Py_SetPath PYTHONPATH) 1501 | (Py_SetPythonHome VIRTUAL_ENV) 1502 | (Py_Initialize) 1503 | 1504 | (let* ((__main__ (PyImport_AddModule "__main__")) 1505 | (globals (PyModule_GetDict __main__))) 1506 | (make-python-interpreter VIRTUAL_ENV PYTHONPATH __main__ globals)))) 1507 | 1508 | ;; TODO: support more than "import foo" 1509 | (define (py-import m) 1510 | (let* ((python-interpreter (current-python-interpreter)) 1511 | (module (PyImport_ImportModule m)) 1512 | (dict (PyModule_GetDict (python-interpreter-__main__ python-interpreter)))) 1513 | ;; Set the module to be accessible inside the __main__ dict. 1514 | (PyDict_SetItemString dict m module))) 1515 | 1516 | (define (py-eval s) 1517 | (let ((python-interpreter (current-python-interpreter))) 1518 | (PyRun_String s 1519 | Py_eval_input 1520 | (python-interpreter-globals python-interpreter) 1521 | (python-interpreter-globals python-interpreter)))) 1522 | 1523 | (define (py-exec s) 1524 | (let ((python-interpreter (current-python-interpreter))) 1525 | (PyRun_String s 1526 | Py_file_input 1527 | (python-interpreter-globals python-interpreter) 1528 | (python-interpreter-globals python-interpreter)))) 1529 | 1530 | ;;;---------------------------------------------------------------------------- 1531 | 1532 | ;; Side effects 1533 | 1534 | (define main-python-interpreter (make-main-python-interpreter)) 1535 | (define current-python-interpreter (make-parameter main-python-interpreter)) 1536 | 1537 | (py-exec "foreign = lambda x: (lambda:x).__closure__[0]") 1538 | 1539 | ;; Foreign write handlers are registered as a side-effect 1540 | ;; at module import time for convenience of pretty-printing. 1541 | (register-foreign-write-handlers) 1542 | -------------------------------------------------------------------------------- /pyffi.sld: -------------------------------------------------------------------------------- 1 | (define-library (pyffi) 2 | 3 | ;; no import needed 4 | 5 | (export 6 | 7 | ;; Debug 8 | _Py_REFCNT 9 | 10 | ;; Constants 11 | Py_eval_input 12 | Py_file_input 13 | Py_single_input 14 | 15 | ;; Initialization, Finalization, and Threads 16 | Py_Initialize 17 | Py_Finalize 18 | Py_SetPath 19 | Py_SetPythonHome 20 | 21 | ;; PyRun_* 22 | PyRun_SimpleString 23 | PyRun_String 24 | 25 | ;; PyImport_* 26 | PyImport_AddModuleObject 27 | PyImport_AddModule 28 | PyImport_ImportModule 29 | PyImport_ImportModuleEx 30 | 31 | ;; PyModule_* 32 | PyModule_GetDict 33 | 34 | ;; PyDict_* 35 | PyDict_New 36 | PyDict_Size 37 | PyDict_Items 38 | PyDict_Keys 39 | PyDict_Values 40 | PyDict_GetItem 41 | PyDict_SetItem 42 | PyDict_GetItemString 43 | PyDict_SetItemString 44 | 45 | ;; PyList_* 46 | PyList_New 47 | 48 | ;; PyTuple_* 49 | PyTuple_GetItem 50 | 51 | ;; PyBool_* 52 | PyBool_FromLong 53 | 54 | ;; PyLong_* 55 | PyLong_FromUnicodeObject 56 | 57 | ;; PyUnicode_* 58 | PyUnicode_FromString 59 | 60 | ;; PyObject_* 61 | PyObject_CallMethod 62 | PyObject_GetAttrString 63 | PyObject_Length 64 | PyObject_Repr 65 | PyObject*-type 66 | PyObject*-type-name 67 | 68 | ;; Call Python callables 69 | PyObject_CallObject 70 | PyObject_CallFunctionObjArgs 71 | PyObject_CallFunctionObjArgs* 72 | PyObject_CallFunctionObjArgs0 73 | PyObject_CallFunctionObjArgs1 74 | PyObject_CallFunctionObjArgs2 75 | PyObject_CallFunctionObjArgs3 76 | PyObject_CallFunctionObjArgs4 77 | 78 | ;; Converters 79 | PyObject*/None->void 80 | void->PyObject*/None 81 | PyObject*/bool->boolean 82 | boolean->PyObject*/bool 83 | PyObject*/int->exact-integer 84 | exact-integer->PyObject*/int 85 | PyObject*/float->flonum 86 | flonum->PyObject*/float 87 | PyObject*/str->string 88 | string->PyObject*/str 89 | PyObject*/bytes->u8vector 90 | u8vector->PyObject*/bytes 91 | PyObject*/bytearray->u8vector 92 | u8vector->PyObject*/bytearray 93 | PyObject*/list->vector 94 | vector->PyObject*/list 95 | PyObject*/list->list 96 | list->PyObject*/list 97 | PyObject*/tuple->vector 98 | vector->PyObject*/tuple 99 | PyObject*/tuple->list 100 | list->PyObject*/tuple 101 | PyObject*->object 102 | object->PyObject* 103 | 104 | ;; Misc 105 | register-foreign-write-handlers 106 | pip-install 107 | pip 108 | py-eval 109 | py-exec 110 | py-import 111 | current-python-interpreter 112 | six.infix 113 | convert 114 | python 115 | 116 | ) 117 | 118 | (include "pyffi.scm") 119 | (include "six.scm") 120 | ) 121 | -------------------------------------------------------------------------------- /python-config.py: -------------------------------------------------------------------------------- 1 | # python-config.py 2 | # 3 | # This script tries to find the correct ld and cflags through python3 4 | # introspection. See CPython's Misc/python-config.in and configure.ac for 5 | # details. 6 | 7 | 8 | import sys 9 | import sysconfig 10 | import platform 11 | import pathlib 12 | 13 | 14 | class MSVC: 15 | def __init__(self): 16 | self.name = "cl" 17 | self.cflags = [] 18 | self.ldflags = ["-link"] 19 | 20 | def add_library_path(self, path): 21 | self.ldflags.append(f'-LIBPATH:"{path}"') 22 | 23 | def add_library(self, lib): 24 | self.ldflags.append(lib + ".lib") 25 | 26 | def add_libraries(self, libs): 27 | for lib in libs: 28 | self.add_library(lib) 29 | 30 | def add_include_path(self, path): 31 | self.cflags.append(f'-I"{path}"') 32 | 33 | 34 | class GnuLikeCompiler: 35 | def __init__(self, name): 36 | self.name = name 37 | self.cflags = [] 38 | self.ldflags = [] 39 | 40 | def add_library_path(self, path): 41 | self.ldflags.append(f'-L"{path}"') 42 | 43 | def add_library(self, lib): 44 | self.ldflags.append(f"-l{lib}") 45 | 46 | def add_libraries(self, libs): 47 | for lib in libs: 48 | self.add_library(lib) 49 | 50 | def add_include_path(self, path): 51 | self.cflags.append(f'-I"{path}"') 52 | 53 | 54 | getvar = sysconfig.get_config_var 55 | 56 | 57 | def extend_with_config_var(array, name): 58 | var = getvar(name) 59 | if var is not None: 60 | array.extend(var.split()) 61 | 62 | 63 | def find_compiler(): 64 | try: 65 | CC = getvar("CC").lower() 66 | if "clang" in CC: 67 | compiler = GnuLikeCompiler("clang") 68 | elif "gcc" in CC: 69 | compiler = GnuLikeCompiler("gcc") 70 | else: 71 | raise RuntimeError("Unknown compiler") 72 | except Exception: 73 | pycompiler = platform.python_compiler().lower() 74 | if "msc" in pycompiler: 75 | compiler = MSVC() 76 | elif "clang" in pycompiler: 77 | compiler = GnuLikeCompiler("clang") 78 | elif "gcc" in pycompiler: 79 | compiler = GnuLikeCompiler("gcc") 80 | else: 81 | raise RuntimeError("Unknown compiler") 82 | 83 | return compiler 84 | 85 | 86 | # Detect the platform/system 87 | 88 | system = platform.system().lower() 89 | if system not in ["linux", "darwin", "windows"]: 90 | raise RuntimeError("Unsupported system") 91 | 92 | 93 | # Detect the compiler 94 | 95 | compiler = find_compiler() 96 | 97 | 98 | # Get common Python configuration variables 99 | 100 | VERSION = getvar("VERSION") 101 | LIBDIR = getvar("LIBDIR") 102 | CONFINCLUDEDIR = getvar("CONFINCLUDEDIR") 103 | try: 104 | abiflags = sys.abiflags 105 | except Exception: 106 | abiflags = getvar("abiflags") or "" 107 | 108 | 109 | # Configure system specific variables 110 | 111 | if system == "windows" and LIBDIR is None: 112 | # Assume libpath is %PYTHONPREFIX%\\libs on Windows 113 | prefix = pathlib.Path(sysconfig.get_config_var("prefix")) 114 | libs = prefix / "libs" 115 | if not libs.exists(): 116 | raise RuntimeError("Unable to find python C libraries") 117 | LIBDIR = str(libs) 118 | 119 | elif system == "darwin": 120 | # Set @rpath when using clang 121 | PYTHONFRAMEWORKPREFIX = getvar("PYTHONFRAMEWORKPREFIX") 122 | if PYTHONFRAMEWORKPREFIX != "": 123 | compiler.cflags.append(f"-Wl,-rpath -Wl,{PYTHONFRAMEWORKPREFIX}") 124 | 125 | 126 | # Configure ldflags 127 | 128 | compiler.add_library_path(LIBDIR) 129 | compiler.add_library(f"python{VERSION}{abiflags}") 130 | extend_with_config_var(compiler.ldflags, "LIBS") 131 | extend_with_config_var(compiler.ldflags, "SYSLIBS") 132 | 133 | if not getvar("Py_ENABLE_SHARED"): 134 | LIBPL = getvar("LIBPL") 135 | if LIBPL is not None: 136 | compiler.add_library_path(LIBPL) 137 | 138 | if not getvar("PYTHONFRAMEWORK"): 139 | extend_with_config_var(compiler.ldflags, "LINKFORSHARED") 140 | 141 | 142 | # Configure cflags 143 | 144 | compiler.add_include_path(sysconfig.get_path("include")) 145 | compiler.add_include_path(sysconfig.get_path("platinclude")) 146 | if CONFINCLUDEDIR is not None: # Can be None on Windows 147 | compiler.add_include_path(CONFINCLUDEDIR + f"/python{VERSION}{abiflags}") 148 | extend_with_config_var(compiler.cflags, "CFLAGS") 149 | 150 | 151 | # The output is parsed by gsc, one line at a time: 152 | 153 | print(VERSION) 154 | print(compiler.name) 155 | print(" ".join(compiler.ldflags)) 156 | print(" ".join(compiler.cflags)) 157 | print(LIBDIR) 158 | -------------------------------------------------------------------------------- /six-convert.scm: -------------------------------------------------------------------------------- 1 | ;;;============================================================================ 2 | 3 | ;;; File: "six-convert.scm" 4 | 5 | ;;; Copyright (c) 2020-2021 by Marc Feeley, All Rights Reserved. 6 | 7 | ;;;============================================================================ 8 | 9 | (define-type conversion-ctx 10 | operators 11 | parameters 12 | globals 13 | literal 14 | unsupported) 15 | 16 | (define python-operators 17 | (list->table 18 | '( 19 | ;; _____precedence 20 | ;; / ____associativity (0=LR, 1=RL, 2=not assoc.) 21 | ;; / / ___operand count (-1 for postfix unary operator) 22 | ;; / / / __target operator 23 | ;; / / / / 24 | (six.prefix 0 0) 25 | (six.identifier 0 0) 26 | (six.literal 0 0) 27 | (six.list 0 0) 28 | (six.null 0 0) 29 | 30 | (six.index 1 0) 31 | (six.call 1 0) 32 | (six.dot 1 0) 33 | 34 | (six.x**y 3 1 2 "**") ;; note: RL associative 35 | 36 | (six.+x 4 1 1 "+") ;; note: RL associative 37 | (six.-x 4 1 1 "-") 38 | (six.~x 4 1 1 "~") 39 | 40 | (six.x*y 5 0 2 "*") 41 | (six.x@y 5 0 2 "@") 42 | (six.x/y 5 0 2 "/") 43 | (six.x//y 5 0 2 "//") 44 | (six.x%y 5 0 2 "%") 45 | 46 | (six.x+y 6 0 2 "+") 47 | (six.x-y 6 0 2 "-") 48 | 49 | (six.x<>y 7 0 2 ">>") 51 | 52 | (six.x&y 8 0 2 "&") 53 | 54 | (six.x^y 9 0 2 "^") 55 | 56 | (|six.x\|y| 10 0 2 "|") 57 | 58 | (six.x") 61 | (six.x>=y 11 2 2 ">=") 62 | (six.x==y 11 2 2 "==") 63 | (six.x!=y 11 2 2 "!=") 64 | (six.xiny 11 2 2 " in ") 65 | (six.xisy 11 2 2 " is ") 66 | 67 | (six.notx 12 1 1 "not ") ;; note: RL associative 68 | 69 | (six.xandy 13 0 2 " and ") 70 | 71 | (six.xory 14 0 2 " or ")))) 72 | 73 | (define javascript-operators 74 | (list->table 75 | '( 76 | ;; _____precedence 77 | ;; / ____associativity (0=LR, 1=RL, 2=not assoc.) 78 | ;; / / ___operand count (-1 for postfix unary operator) 79 | ;; / / / __target operator 80 | ;; / / / / 81 | (six.prefix 0 0) 82 | (six.identifier 0 0) 83 | (six.literal 0 0) 84 | (six.list 0 0) 85 | (six.null 0 0) 86 | 87 | (six.index 1 0) 88 | (six.call 1 0) 89 | (six.dot 1 0) 90 | 91 | ;; (six.x++ 3 0 -1 "++") 92 | ;; (six.x-- 3 0 -1 "--") 93 | 94 | (six.+x 4 1 1 "+") ;; note: RL associative 95 | (six.-x 4 1 1 "-") 96 | (six.~x 4 1 1 "~") 97 | (six.++x 4 1 1 "++") 98 | (six.--x 4 1 1 "--") 99 | 100 | (six.x**y 5 1 2 "**") ;; note: RL associative 101 | 102 | (six.x*y 6 0 2 "*") 103 | (six.x/y 6 0 2 "/") 104 | (six.x%y 6 0 2 "%") 105 | 106 | (six.x+y 7 0 2 "+") 107 | (six.x-y 7 0 2 "-") 108 | 109 | (six.x<>y 8 0 2 ">>") 111 | (six.x>>>y 8 0 2 ">>>") 112 | 113 | (six.x") 116 | (six.x>=y 9 0 2 ">=") 117 | (six.xiny 9 0 2 " in ") 118 | 119 | (six.x==y 10 0 2 "==") 120 | (six.x!=y 10 0 2 "!=") 121 | (six.x===y 10 0 2 "===") 122 | (six.x!==y 10 0 2 "!==") 123 | 124 | (six.x&y 11 0 2 "&") 125 | 126 | (six.x^y 12 0 2 "^") 127 | 128 | (|six.x\|y| 13 0 2 "|") 129 | 130 | (six.x&&y 14 0 2 "&&") 131 | 132 | (|six.x\|\|y| 15 0 2 "||") 133 | 134 | ;; (six.x?y:z 17 1) ;; note: RL associative 135 | 136 | (six.x=y 18 1 2 "=") ;; note: RL associative 137 | (six.x+=y 18 1 2 "+=") 138 | (six.x-=y 18 1 2 "-=") 139 | (six.x**=y 18 1 2 "**=") 140 | (six.x*=y 18 1 2 "*=") 141 | (six.x/=y 18 1 2 "/=") 142 | (six.x%=y 18 1 2 "%=") 143 | (six.x<<=y 18 1 2 "<<=") 144 | (six.x>>=y 18 1 2 ">>=") 145 | (six.x>>>=y 18 1 2 ">>>=") 146 | (six.x&=y 18 1 2 "&=") 147 | (six.x^=y 18 1 2 "^=") 148 | (|six.x\|=y| 18 1 2 "|=") 149 | (six.x&&=y 18 1 2 "&&=") 150 | (six.x||=y 18 1 2 "||=") 151 | 152 | ;; (six.x,=y 20 0 2 ",") 153 | ))) 154 | 155 | (define (six->python ast-src) 156 | 157 | (define (convert-literal cctx src) 158 | (##deconstruct-call 159 | src 160 | 2 161 | (lambda (val-src) 162 | (let ((val (##source-strip val-src))) 163 | (cond ((number? val) 164 | (number->string val)) ;; TODO: use Python number syntax 165 | ((boolean? val) 166 | (if val "True" "False")) 167 | ((string? val) 168 | (object->string val)) ;; TODO: use Python string syntax 169 | (else 170 | (unsupported cctx src))))))) 171 | 172 | (define (unsupported cctx src) 173 | (##raise-expression-parsing-exception 174 | 'ill-formed-expression 175 | src)) 176 | 177 | (define cctx 178 | (make-conversion-ctx 179 | python-operators 180 | '() 181 | (make-table) 182 | convert-literal 183 | unsupported)) 184 | 185 | (let ((target-expr (six-expression-to-infix cctx ast-src))) 186 | (list (reverse (conversion-ctx-parameters cctx)) 187 | (flatten-string (list "return " target-expr))))) 188 | 189 | (define (six->javascript ast-src) 190 | 191 | (define (convert-literal cctx src) 192 | (##deconstruct-call 193 | src 194 | 2 195 | (lambda (val-src) 196 | (let ((val (##source-strip val-src))) 197 | (cond ((number? val) 198 | (number->string val)) ;; TODO: use Python number syntax 199 | ((boolean? val) 200 | (if val "true" "false")) 201 | ((string? val) 202 | (object->string val)) ;; TODO: use Python string syntax 203 | (else 204 | (unsupported cctx src))))))) 205 | 206 | (define (unsupported cctx src) 207 | (##raise-expression-parsing-exception 208 | 'ill-formed-expression 209 | src)) 210 | 211 | (define cctx 212 | (make-conversion-ctx 213 | javascript-operators 214 | '() 215 | (make-table) 216 | convert-literal 217 | unsupported)) 218 | 219 | (let ((target-expr (six-expression-to-infix cctx ast-src))) 220 | (list "function ___fn(" 221 | (append-strings (map car (conversion-ctx-parameters cctx)) ",") 222 | ") { return " 223 | target-expr 224 | "; }"))) 225 | 226 | (define (six-expression-to-infix cctx ast-src) 227 | 228 | (define (unsupported ast-src) 229 | ((conversion-ctx-unsupported cctx) cctx ast-src)) 230 | 231 | (define (precedence op) (car op)) 232 | (define (associativity op) (cadr op)) 233 | 234 | (define (parens-optional? pos inner-op outer-op) 235 | (let ((inner-prec (precedence inner-op)) 236 | (outer-prec (precedence outer-op))) 237 | (or (< inner-prec outer-prec) 238 | (and (= inner-prec outer-prec) 239 | (let ((inner-assoc (associativity inner-op))) 240 | (and (< inner-assoc 2) ;; 2 = non associative 241 | (= inner-assoc pos))))))) 242 | 243 | (define (infix ast-src pos outer-op) 244 | (let ((ast (##source-strip ast-src))) 245 | (if (not (pair? ast)) 246 | (unsupported ast-src) 247 | (let* ((head 248 | (##source-strip (car ast))) 249 | (rest 250 | (cdr ast)) 251 | (inner-op 252 | (table-ref (conversion-ctx-operators cctx) head #f))) 253 | (if (not inner-op) 254 | (unsupported ast-src) 255 | (let* ((x 256 | (cddr inner-op)) 257 | (expr 258 | (if (not (pair? x)) 259 | (infix* ast-src pos inner-op) 260 | (let ((operand-count (car x)) 261 | (target-op (cadr x))) 262 | (case (length rest) 263 | ((0) 264 | target-op) 265 | ((1) 266 | (list target-op 267 | (infix (car rest) 1 inner-op))) 268 | ((2) 269 | (list (infix (car rest) 0 inner-op) 270 | target-op 271 | (infix (cadr rest) 1 inner-op))) 272 | ((3) 273 | ...) ;; TODO: ternary operator 274 | (else 275 | (unsupported ast))))))) 276 | (if (parens-optional? pos inner-op outer-op) 277 | expr 278 | (list "(" expr ")")))))))) 279 | 280 | (define (infix* ast-src pos inner-op) 281 | (let ((ast (##source-strip ast-src))) 282 | (case (##source-strip (car ast)) 283 | 284 | ((six.prefix) 285 | (##deconstruct-call 286 | ast-src 287 | 2 288 | (lambda (expr-src) 289 | (let* ((params 290 | (conversion-ctx-parameters cctx)) 291 | (param-id 292 | (string-append "___" 293 | (number->string (+ 1 (length params)))))) 294 | (conversion-ctx-parameters-set! 295 | cctx 296 | (cons (cons param-id expr-src) 297 | params)) 298 | param-id)))) 299 | 300 | ((six.identifier) 301 | (##deconstruct-call 302 | ast-src 303 | 2 304 | (lambda (ident-src) 305 | (let* ((ident-sym (##source-strip ident-src)) 306 | (ident (symbol->string ident-sym))) 307 | (table-set! (conversion-ctx-globals cctx) ident-sym ident) 308 | ident)))) 309 | 310 | ((six.literal) 311 | ((conversion-ctx-literal cctx) cctx ast-src)) 312 | 313 | ((six.list six.null) 314 | (let loop ((ast-src ast-src) (rev-elems '())) 315 | (let ((ast (##source-strip ast-src))) 316 | (case (##source-strip (car ast)) 317 | ((six.list) 318 | (##deconstruct-call 319 | ast-src 320 | 3 321 | (lambda (head-src tail-src) 322 | (loop tail-src (cons (cvt head-src) rev-elems))))) 323 | ((six.null) 324 | (##deconstruct-call 325 | ast-src 326 | 0 327 | (lambda () 328 | (list "[" 329 | (comma-separated (reverse rev-elems)) 330 | "]")))) 331 | (else 332 | (unsupported ast-src)))))) 333 | 334 | ((six.index) 335 | (##deconstruct-call 336 | ast-src 337 | 3 338 | (lambda (obj-src index-src) 339 | (list (infix obj-src 0 inner-op) 340 | "[" 341 | (cvt index-src) 342 | "]")))) 343 | 344 | ((six.call) 345 | (##deconstruct-call 346 | ast-src 347 | -2 348 | (lambda (fn-src . args-src) 349 | (let ((args (map cvt args-src))) 350 | (list (infix fn-src 0 inner-op) 351 | "(" 352 | (comma-separated args) 353 | ")"))))) 354 | 355 | ((six.dot) 356 | (##deconstruct-call 357 | ast-src 358 | 3 359 | (lambda (obj-src attr-src) 360 | ;; TODO: check that attr-src is (six.identifier ...) 361 | (##deconstruct-call 362 | attr-src 363 | 2 364 | (lambda (ident-src) 365 | (list (infix obj-src 0 inner-op) 366 | "." 367 | (symbol->string (##source-strip ident-src)))))))) 368 | 369 | (else 370 | (unsupported ast-src))))) 371 | 372 | (define (cvt ast-src) 373 | ;; pretend wrapped in infinitely low precedence operator to prevent 374 | ;; outer level of parentheses 375 | (infix ast-src 0 '(9999 0))) 376 | 377 | (cvt ast-src)) 378 | 379 | (define (comma-separated lst) 380 | (if (pair? lst) 381 | (cons (car lst) 382 | (map (lambda (x) (list "," x)) (cdr lst))) 383 | "")) 384 | 385 | (define (flatten-string x) 386 | (call-with-output-string (lambda (p) (print port: p x)))) 387 | 388 | -------------------------------------------------------------------------------- /six.scm: -------------------------------------------------------------------------------- 1 | (define-syntax six.infix 2 | (lambda (src) 3 | 4 | (include "six-convert.scm") 5 | 6 | ;; TODO: from-import-handler 7 | 8 | (##deconstruct-call 9 | src 10 | 2 11 | (lambda (ast-src) 12 | (let ((ast (##source-strip ast-src))) 13 | (if (and (pair? ast) 14 | (eq? 'six.import (##source-strip (car ast))) 15 | (pair? (cdr ast)) 16 | (null? (cddr ast))) 17 | (let ((ident (##source-strip (cadr ast)))) 18 | (if (and (pair? ident) 19 | (eq? 'six.identifier (##source-strip (car ident))) 20 | (pair? (cdr ident)) 21 | (null? (cddr ident))) 22 | `(begin 23 | (py-import ,(symbol->string (##source-strip (cadr ident)))) 24 | (void)) 25 | (error "invalid import"))) 26 | 27 | (let* ((x (six->python ast-src)) 28 | (params (car x)) 29 | (body (cadr x)) 30 | (def 31 | (string-append "def ___0(" 32 | (flatten-string 33 | (comma-separated (map car params))) 34 | "):\n " 35 | body))) 36 | `((begin 37 | (py-exec ,def) 38 | (PyObject*->object (py-eval "___0"))) 39 | ,@(map cdr params))))))))) 40 | --------------------------------------------------------------------------------