Python Scheme integration (libguile)

.gitignore

*.so
*.o
*.html
.*.un~
.*.swp

README.md

Guile for Python

External links

• Guile reference mannual
• IBM: Scripting with Guile
• SchemePy Guile backend

guile.py

#!/usr/bin/env python
# -*- coding: utf-8 -*-
import weakref
from ctypes.util import find_library
from ctypes import *
import os.path
import logging
logging.basicConfig(level=logging.INFO,
                    format=' [%(levelname)-7s] (%(asctime)s) %(filename)-23s(L %(lineno)-4s): %(message)s',
                    datefmt='%Y-%m-%d %H:%M:%S')

__path__ = os.path.dirname(__file__)

lib = find_library("guile-2.0")
if lib is None:
  raise RuntimeError("Can't find a guile library to use.")

path = os.path.abspath(os.path.join(__path__, "guilehelper.so"))
guilehelper = cdll.LoadLibrary(path)

guile = cdll.LoadLibrary(lib)

class SCM(c_void_p):
  def __init__(self, value=None):
    c_void_p.__init__(self)
    self.value = value
    
  def set_value(self, value):
    old_value = getattr(self, 'value', None)
    if old_value is not None and not guile.scm_imp(old_value):
      if getattr(self, 'protected', False):
        guile.scm_gc_unprotect_object(old_value)
      self.protected = False
    if value is not None and not guile.scm_imp(value):
      guile.scm_gc_protect_object(value)
      self.protected = True
    return c_void_p.value.__set__(self, value)

  def get_value(self):
    return c_void_p.value.__get__(self)

  value = property(get_value, set_value)
  
  def __del__(self):
    if guile is None:
      return # the guile library has been unloaded, do nothing
    self.value = None

  def __str__(self):
    return "SCM(%s)" % self.value
  
  def __repr__(self):
    return self.__str__()

guile.scm_imp = guilehelper.scm_imp
guile.scm_imp.argtypes = [c_void_p]
guile.scm_imp.restype = bool

guile.scm_eol = guilehelper.scm_eol
guile.scm_eol.argtypes = []
guile.scm_eol.restype = SCM

guile.scm_is_eol = guilehelper.scm_is_eol
guile.scm_is_eol.argtypes = [SCM]
guile.scm_is_list = guilehelper.scm_is_list
guile.scm_is_eol.restype = int

guile.scm_string_to_symbol.argtypes = [SCM]
guile.scm_string_to_symbol.restype = SCM

guile.scm_symbol_to_string.argtypes = [SCM]
guile.scm_symbol_to_string.restype = SCM

guile.scm_cons.argtypes = [SCM, SCM]
guile.scm_cons.restype = SCM

guile.scm_is_pair.argtypes = [SCM]
guile.scm_is_pair.restype = int

guile.scm_is_list = guilehelper.scm_is_list
guile.scm_is_list.argtypes = [SCM]
guile.scm_is_list.restype = int

guile.scm_car = guilehelper.scm_car
guile.scm_car.argtypes = [SCM]
guile.scm_car.restype = SCM

guile.scm_cdr = guilehelper.scm_cdr
guile.scm_cdr.argtypes = [SCM]
guile.scm_cdr.restype = SCM

guile.scm_c_lookup.argtypes = [c_char_p]
guile.scm_c_lookup.restype = SCM

guile.scm_variable_ref.argtypes = [SCM]
guile.scm_variable_ref.restype = SCM

guile.scm_from_bool = guilehelper.scm_from_bool_
guile.scm_from_bool.argtypes = [c_int]
guile.scm_from_bool.restype = SCM

guile.scm_is_true = guilehelper.scm_is_true_
guile.scm_is_true.argtypes = [SCM]
guile.scm_is_true.restype = int

guile.scm_is_integer = guilehelper.scm_is_integer
guile.scm_is_integer.argtypes = [SCM]
guile.scm_is_integer.restype = int

guile.scm_is_symbol = guilehelper.scm_is_symbol_
guile.scm_is_symbol.argtypes = [SCM]
guile.scm_is_symbol.restype = int

guile.scm_from_int64.argtypes = [c_int]
guile.scm_from_int64.restype = SCM

guile.scm_to_int64.argtypes = [SCM]
guile.scm_to_int64.restype = int

guile.scm_is_string.argtypes = [SCM]
guile.scm_is_string.restype = int

guile.scm_from_utf8_stringn.argtypes = [c_char_p, c_int]
guile.scm_from_utf8_stringn.restype = SCM

guile.scm_to_utf8_stringn.argtypes = [SCM, POINTER(c_ulong)]
guile.scm_to_utf8_stringn.restype = c_char_p

guile.scm_call_0.argtypes = [SCM]
guile.scm_call_0.restype = SCM

guile.scm_call_1.argtypes = [SCM, SCM]
guile.scm_call_1.restype = SCM

guile.scm_init_guile()

class Symbol(object):
  symbols = weakref.WeakValueDictionary({})

  def __new__(cls, name):
    if cls.symbols.has_key(name):
      return cls.symbols[name]
    # 'sym' variable protects value from garbage collector
    sym = object.__new__(cls)
    sym._name = name
    cls.symbols[name] = sym
    return sym

  def __eq__(self, other):
    return self is other

  def __ne__(self, other):
    return not self.__eq__(other)

  def get_name(self):
    return self._name
  
  def set_name(self):
    raise AttributeError("Can't modify name of a symbol")

  name = property(get_name, set_name)

  def __str__(self):
    return self.name

  def __repr__(self):
    return "Symbol(%s)" % self._name.__repr__()

class VM(object):
  def __init__(self):
    guileroot = guile.scm_current_module()

  @staticmethod
  def toscheme(*val):
    if (len(val) == 1):
      if type(*val) is bool:
        return guile.scm_from_bool(*val)
      if type(*val) is int:
        return guile.scm_from_int64(*val)
      if type(*val) is str:
        return guile.scm_from_utf8_stringn(val[0], len(*val))
      if type(*val) is Symbol:
        name = VM.toscheme(val[0].name)
        return guile.scm_string_to_symbol(name)
      if isinstance(val[0], list):
        scm = guile.scm_eol()
        for item in reversed(*val):
          scm = guile.scm_cons(VM.toscheme(item), scm)
        return scm
    elif len(val) == 2:
      return guile.scm_cons(VM.toscheme(val[0]), VM.toscheme(val[1]))
    else:
      raise ArgumentError("Expecting tuple of size 2 but got %s." % val)
    print len(val)
    raise RuntimeError("Conversion of %s not supported." % val)

  @staticmethod
  def fromscheme(val):
    if not isinstance(val, SCM):
      raise ArgumentError("Expecting a Scheme value but got %s." % val)
    if guile.scm_is_bool(val):
      return True if guile.scm_is_true(val) else False
    if guile.scm_is_integer(val):
      return guile.scm_to_int64(val)
    if guile.scm_is_string(val):
      # TODO: Use scm_to_utf8_stringbuf
      length = c_ulong(0)
      mem = guile.scm_to_utf8_stringn(val, pointer(length))
      retval = string_at(mem, length.value)
      return retval
    if guile.scm_is_symbol(val):
      return Symbol(VM.fromscheme(guile.scm_symbol_to_string(val)))
    if guile.scm_is_eol(val):
      return []
    if guile.scm_is_pair(val):
      if guile.scm_is_list(val):
        return [VM.fromscheme(guile.scm_car(val))] + VM.fromscheme(guile.scm_cdr(val))
      else:
        return (VM.fromscheme(guile.scm_car(val)), VM.fromscheme(guile.scm_cdr(val)))
    raise RuntimeError("Conversion of %s not supported." % val)

guile.scm_c_eval_string("(use-modules (ice-9 r5rs))")
guile.scm_c_eval_string("(scheme-report-environment 5)")
guile.scm_c_eval_string("(set-port-encoding! (current-input-port) \"utf-8\")")
guile.scm_c_eval_string("(set-port-encoding! (current-output-port) \"utf-8\")")

vm = VM()


def call(fname, *args):
    arglen = len(args)

    def ret(scm):
        if scm.value == 2052:
            return None # unspecified
        return vm.fromscheme(scm)

    try:
        if arglen == 0:
            return ret(guile.scm_call_0(guile.scm_variable_ref(guile.scm_c_lookup(fname))))
        elif arglen == 1:
            return ret(guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup(fname)), vm.toscheme(args[0])))
        else:
            return ret(guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup(fname)), vm.toscheme(*args)))
    except RuntimeError as e: # no return value
        logging.warn(str(e))
        return


def eval_string(s):
    return guile.scm_c_eval_string(s)


if __name__ == "__main__":
    # run tests
    print False
    print vm.fromscheme(vm.toscheme(False))
    guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup("write")), vm.toscheme(False))
    guile.scm_call_0(guile.scm_variable_ref(guile.scm_c_lookup("newline")))
    print
    
    print True
    print vm.fromscheme(vm.toscheme(True))
    guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup("write")), vm.toscheme(True))
    guile.scm_call_0(guile.scm_variable_ref(guile.scm_c_lookup("newline")))
    print
    
    print 42
    print vm.fromscheme(vm.toscheme(42))
    guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup("write")), vm.toscheme(42))
    guile.scm_call_0(guile.scm_variable_ref(guile.scm_c_lookup("newline")))
    print
    
    print "String ©"
    print vm.fromscheme(vm.toscheme("String ©"))
    guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup("write")), vm.toscheme("String ©"))
    guile.scm_call_0(guile.scm_variable_ref(guile.scm_c_lookup("newline")))
    print
    
    guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup("write")), vm.toscheme(Symbol('Symbol')))
    guile.scm_call_0(guile.scm_variable_ref(guile.scm_c_lookup("newline")))
    
    print (1, 2)
    print vm.fromscheme(vm.toscheme(1, 2))
    guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup("write")), vm.toscheme(1, 2))
    guile.scm_call_0(guile.scm_variable_ref(guile.scm_c_lookup("newline")))
    print
    
    print [Symbol('Array'), True, 4, "String ©"]
    print vm.fromscheme(vm.toscheme([Symbol('Array'), True, 4, "String ©"]))
    guile.scm_call_1(guile.scm_variable_ref(guile.scm_c_lookup("write")), vm.toscheme([Symbol('Array'), True, 4, "String ©"]))
    guile.scm_call_0(guile.scm_variable_ref(guile.scm_c_lookup("newline")))
    print
    
    guile = None

guilehelper.c

#include <libguile.h>

int scm_imp(SCM x) {
  return SCM_IMP(x);
}

SCM scm_eol(void) {
  return SCM_EOL;
}

int scm_is_eol(SCM x) {
  return x == SCM_EOL;
}

SCM scm_from_bool_(int x) {
  return x ? SCM_BOOL_T : SCM_BOOL_F;
}

int scm_is_true_(SCM x) {
  return SCM_NFALSEP(x);
}

int scm_is_integer(SCM x) {
  return scm_integer_p(x) == SCM_BOOL_T;
}

int scm_is_symbol_(SCM x) {
  return SCM_SYMBOLP(x);
}

int scm_is_list(SCM x) {
  return scm_list_p(x) == SCM_BOOL_T;
}

SCM scm_car(SCM x) {
  return SCM_CAR(x);
}

SCM scm_cdr(SCM x) {
  return SCM_CDR(x);
}

Makefile

.SUFFIXES: .md .html

CC = gcc
PANDOC = pandoc

CFLAGS = $(shell pkg-config guile-2.0 --cflags)
LIBS = $(shell pkg-config guile-2.0 --libs)
OBJS = guilehelper.o

all: guilehelper.so README.html

guilehelper.so: $(OBJS)
	$(CC) -shared -fPIC -o $@ $(OBJS) $(LIBS)

.c.o:
	$(CC) -fPIC -c $(CFLAGS) -o $@ $<

.md.html:
	$(PANDOC) $< -o $@

clean:
	rm -f *.so *.o

script.scm

(define (simple-script) (display "script called") (newline))