Calling SWI-Prolog from Racket via FFI

swipl.rkt

#lang racket

(require ffi/unsafe) 
(require ffi/cvector)
 
(define swipl-lib (ffi-lib "/opt/local/lib/swipl-5.11.24/lib/i386-darwin10.8.0/libswipl"))

(define [swipl-func name type] (get-ffi-obj name swipl-lib type))

(define fid_t _pointer) ;;handle to a foreign frame
(define term_t _pointer) ;;handle to a term
(define predicate_t _pointer) ;;handle to a predicate
(define module_t _pointer) ;;handle to a module
(define qid_t _pointer) ;;handle to a query
(define PL_Q_NORMAL	2) ;;open-query flag

(define swipl-initialise          (swipl-func "PL_initialise"          (_fun _int _pointer -> _int)))
(define swipl-halt                (swipl-func "PL_halt"                (_fun _int -> _int)))
(define swipl-open-foreign-frame  (swipl-func "PL_open_foreign_frame"  (_fun -> fid_t)))
(define swipl-close-foreign-frame (swipl-func "PL_close_foreign_frame" (_fun fid_t -> _void)))
(define swipl-new-term-refs       (swipl-func "PL_new_term_refs"       (_fun _int -> term_t)))
(define swipl-predicate           (swipl-func "PL_predicate"           (_fun _string _int _string -> predicate_t)))
(define swipl-open-query          (swipl-func "PL_open_query"          (_fun module_t _int predicate_t term_t -> qid_t)))
(define swipl-next-solution       (swipl-func "PL_next_solution"       (_fun qid_t -> _int)))
(define swipl-cut-query           (swipl-func "PL_cut_query"           (_fun qid_t -> _void)))
(define swipl-call-predicate      (swipl-func "PL_call_predicate"      (_fun module_t _int predicate_t term_t -> _int)))
(define swipl-get-atom-chars      (swipl-func "PL_get_atom_chars"      (_fun term_t _pointer -> _int)))

(define argv (list->cvector '("racket" #f) _string/latin-1))
(define [swipl-init] (swipl-initialise 1 (cvector-ptr argv)))

(define [test]
  (swipl-init)
  (letrec 
      ([frame-handle (swipl-open-foreign-frame)]
       [terms        (swipl-new-term-refs 2)]
       [curr-pred    (swipl-predicate "current_predicate" 1 #f)]
       [query        (swipl-open-query #f PL_Q_NORMAL curr-pred terms)]
       [result       (swipl-next-solution query)]
       [chars        (make-cvector _string 1)])
    (swipl-cut-query query)
    (swipl-call-predicate #f PL_Q_NORMAL (swipl-predicate "term_to_atom" 2 #f) terms)
    (swipl-get-atom-chars (ptr-add terms 1 ) (cvector-ptr chars))
    (write (cvector-ref chars 0))
    (swipl-close-foreign-frame frame-handle)))