Re: A couple of general-ish questions

[Rob Browning]

Robert Marlow <address@hidden> writes:

> Secondly, I've been trying to do this with g-wrap but I'm completely
> new to g-wrap. Specifically, LDAP has some struct types containing
> structs (containing structs etc etc) and I was unsure how I should
> represent such a nested type using g-wrap (see the LDAP struct
> typedef for example). Does anyone have a clean solution to this?

Right now g-wrap doesn't make any specific accomodations for structs,
so you'll have to provide your own getter/setter C functions and wrap
them if the library doesn't already.  I've been thinking off and on
about a possibly (though not definitely) much smarter way to handle
things in any successor to g-wrap.  (I'm still not sure the stuff I've
been musing about's reasonable, though...)

> Or should I not use g-wrap and instead use something else (eg
> ffcall)?

If you're planning to wrap types that other people will also need to
use in wrapping their own APIs (i.e. if you want to provide a stanard
way to wrap GLists, for example), or if you have a large enough API,
then g-wrap may be the right choice ATM.  However, if the API is
small, and you only expect people to be using your scheme-side
interface, you could also consider just wrapping the API "by hand"
using guile's built in snarfer, validate.h, etc.

i.e. here's my simple pcre test module setup (not finished):

File: Makefile.am

  # declarations
  CLEANFILES =
  EXTRA_DIST = 

  scmmoddir = ${prefix}/share/guile/pcre
  scmmod_DATA = pcre.scm
  EXTRA_DIST += ${scmmod_DATA}

  lib_LTLIBRARIES = libguile-pcre-v-1.la

  BUILT_SOURCES = libguile-pcre.c.x

  libguile_pcre_v_1_la_SOURCES = libguile-pcre.c

  libguile_pcre_v_1_la_LDFLAGS = \
          -version-info 1:0:0 \
          -export-dynamic \
          -no-undefined

  libguile_pcre_v_1_la_LIBADD = -lpcre

  snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)

  %.c.x: %.c
          ${GUILE_SNARF} $(snarfcppopts) $< > $@

  CLEANFILES += *.c.x

  TESTS = test-trivial-load
  check_SCRIPTS = test-trivial-load
  EXTRA_DIST += ${check_SCRIPTS} 

  .DELETE_ON_ERROR:

File: pcre.scm

  ;; Copyright (C) 2002 Rob Browning <address@hidden>
  ;;
  ;; This program is free software; you can redistribute it and/or
  ;; modify it under the terms of the Lesser GNU General Public License
  ;; as published by the Free Software Foundation; either version 2, or
  ;; (at your option) any later version.
  ;; 
  ;; This program is distributed in the hope that it will be useful, but
  ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  ;; General Public License for more details.
  ;; 
  ;; You should have received a copy of the Lesser GNU General Public
  ;; License along with this software; see the file COPYING.  If not,
  ;; write to the Free Software Foundation, Inc., 59 Temple Place, Suite
  ;; 330, Boston, MA 02111-1307 USA

  (define-module (pcre))
  ;; exports at end of file.

  (let ((lib "libguile-pcre-v-1")
        (init-func "libguile_pcre_init"))
    (if (string=? (substring (version) 0 3) "1.4")
        (dynamic-call init-func (dynamic-link lib))
        (load-extension lib init-func)))

  ;; Q: should this return #f or "" for unset matches?
  ;; currently we do the latter to match pcre's native behavior.
  (define (pcre-get-substring-list target-str match-info)
    (let loop ((n (- (vector-length match-info) 1))
               (result '()))
      (if (= n -1)
          result
          (let ((info (vector-ref match-info n)))
            (loop (- n 1)
                  (cons (if (negative? (car info))
                            ""
                            (substring target-str (car info) (cdr info)))
                        result))))))

  ;; returns #f if index is out of range.
  ;; returns "" for unset matches as above...
  (define (pcre-get-substring target-str match-info index)
    (let ((match-len (vector-length match-info)))
      (and (positive? index)
           (< index match-len)
           (let ((info (vector-ref match-info index)))
             (if (negative? (car info))
                 ""
                 (substring target-str  (car info) (cdr info)))))))

  (export PCRE_MAJOR)
  (export PCRE_MINOR)

  (export PCRE_ANCHORED)
  (export PCRE_CASELESS)
  (export PCRE_DOLLAR_ENDONLY)
  (export PCRE_DOTALL)
  (export PCRE_EXTENDED)
  (export PCRE_EXTRA)
  (export PCRE_MULTILINE)
  (export PCRE_UNGREEDY)
  (export PCRE_UTF8)

  (export pcre-version)
  (export pcre-compile)
  (export pcre-study)
  (export pcre-exec)
  (export pcre-maketables)
  (export pcre-get-substring-list)

File: libguile-pcre.c

  /*
    Copyright (C) 2002 Rob Browining <address@hidden>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the Lesser GNU General Public License as
    published by the Free Software Foundation; either version 2, or (at
    your option) any later version.

    This program is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    General Public License for more details.

    You should have received a copy of the Lesser GNU General Public
    License along qwith this software; see the file COPYING.  If not,
    write to the Free Software Foundation, Inc., 59 Temple Place, Suite
    330, Boston, MA 02111-1307 USA
  */

  #include <guile/gh.h>
  #include <libguile/pairs.h>
  #include <libguile/validate.h>
  #include <libguile/list.h>
  #include <pcre.h>

  /* We have to have this structure because when you call pcre_compile,
     if you pass it a table from pcre_maketables(), that table will be
     cached inside the resulting pcre struct.  The table is allocated
     via pcre_malloc, and must stick around for as long as any pcre
     still holds a pointer to it.  Since a table may be shared among an
     arbitrary number of pcre's, knowing when to free it sounds like a
     job for the garbage collector (I sure don't want to try and keep
     track, do you? :>) */
  typedef struct {
    pcre *p;
    SCM table;
  } scm_t_i_pcre;

  static scm_bits_t scm_tc16_pcre_tag;
  static scm_bits_t scm_tc16_pcre_tables_tag;
  static scm_bits_t scm_tc16_pcre_extra_tag;

  SCM_DEFINE (scm_pcre_version, "pcre-version", 0, 0, 0,
              (),
              "Returns the PCRE version and release date as a string.")
  #define FUNC_NAME s_scm_pcre_version
  {
    return scm_makfrom0str (pcre_version ());
  }
  #undef FUNC_NAME

  SCM_DEFINE (scm_pcre_compile, "pcre-compile", 1, 2, 0,
              (SCM pattern, SCM options, SCM table),
              "Return a compiled form of the given pattern.  A table argument\n"
              "of #f is the same as not specifying one.")
  #define FUNC_NAME s_scm_pcre_compile
  {
    char *c_pattern;
    int c_options = 0;
    const unsigned char *c_table = NULL;

    pcre *compiled_rx = NULL;
    scm_t_i_pcre *smob_data = NULL;
    SCM result_smob;
    const char *errmsg = NULL;
    int errpos;

    SCM_VALIDATE_STRING_COPY (1, pattern, c_pattern);

    if (!SCM_UNBNDP (options))
    {
      SCM_VALIDATE_INUM_COPY (2, options, c_options);
    }

    if (!SCM_UNBNDP (table) && !SCM_FALSEP (table))
    {
      SCM_VALIDATE_SMOB (3, table, pcre_tables_tag);
      c_table = (const unsigned char *) SCM_SMOB_DATA (table);
    } 

    compiled_rx = pcre_compile (c_pattern, c_options, &errmsg, &errpos, 
c_table);
    if (compiled_rx == NULL)
    {
      scm_misc_error (FUNC_NAME,
                      "~A: at position ~A in pattern string.",
                      SCM_LIST2 (scm_makfrom0str (errmsg),
                                 scm_long2num (errpos)));
    }
    smob_data = scm_must_malloc (sizeof (scm_t_i_pcre), "scm_t_i_pcre");
    smob_data->p = compiled_rx;
    smob_data->table = SCM_BOOL_F;
    SCM_NEWSMOB (result_smob, scm_tc16_pcre_tag, smob_data);
    if (c_table) smob_data->table = table;
    return result_smob;
  }
  #undef FUNC_NAME

  SCM_DEFINE (scm_pcre_study, "pcre-study", 1, 1, 0,
              (SCM compiled_rx, SCM options),
              "Return information that may optimize the execution of the 
given\n"
              "compiled regex, or #f if no optimizations are possible.")
  #define FUNC_NAME s_scm_pcre_study
  {
    scm_t_i_pcre* c_pcre_smob_data;
    int c_options = 0;

    pcre_extra *c_study_info = NULL;
    const char *errmsg = NULL;

    SCM_VALIDATE_SMOB (1, compiled_rx, pcre_tag);
    c_pcre_smob_data = (scm_t_i_pcre *) SCM_SMOB_DATA (compiled_rx);

    if (!SCM_UNBNDP (options)) {
      SCM_VALIDATE_INUM_COPY (2, options, c_options);
    }

    c_study_info = pcre_study (c_pcre_smob_data->p, c_options, &errmsg);
    if (errmsg)
    {
      scm_misc_error (FUNC_NAME,
                      "~A: while studying regular expression.",
                      SCM_LIST1 (scm_makfrom0str (errmsg)));
    }
    if (!c_study_info) return SCM_BOOL_F;
    SCM_RETURN_NEWSMOB (scm_tc16_pcre_extra_tag, c_study_info);
  }
  #undef FUNC_NAME

  SCM_DEFINE (scm_pcre_exec, "pcre-exec", 3, 3, 0,
              (SCM compiled_rx, SCM study_info,
               SCM target_string, SCM length, SCM start_offset,
               SCM options),
              "Match the compiled regex against the target string.")
  #define FUNC_NAME s_scm_pcre_exec
  {
    scm_t_i_pcre *c_pcre_smob_data;
    pcre_extra *c_study_info = NULL;
    char *c_target_str;
    int c_length;
    int c_start_offset;
    int c_options;

    SCM_VALIDATE_SMOB (1, compiled_rx, pcre_tag);
    c_pcre_smob_data = (scm_t_i_pcre *) SCM_SMOB_DATA (compiled_rx);

    if (SCM_NFALSEP (study_info))
    {
      SCM_VALIDATE_SMOB (2, study_info, pcre_extra_tag);
      c_study_info = (pcre_extra *) SCM_SMOB_DATA (study_info);
    }

    SCM_VALIDATE_STRING_COPY (3, target_string, c_target_str);

    if (SCM_UNBNDP (length) || SCM_FALSEP (length))
    {
      c_length = scm_num2int (scm_string_length (target_string),
                              4,
                              "FUNC_NAME");
    }
    else
    {
      SCM_VALIDATE_INUM_COPY (4, length, c_length);
    }

    if (SCM_UNBNDP (start_offset) || SCM_FALSEP (start_offset))
      c_start_offset = 0;
    else
    {
      SCM_VALIDATE_INUM_COPY (5, start_offset, c_start_offset);
    }

    if (SCM_UNBNDP (options))
      c_options = 0;
    else
    {
      SCM_VALIDATE_INUM_COPY (6, options, c_options);
    }

    {
      int *ovector;
      int ovecsize;
      int rc;

      rc = pcre_fullinfo (c_pcre_smob_data->p,
                          c_study_info,
                          PCRE_INFO_CAPTURECOUNT,
                          &ovecsize);
      if (rc < 0)
      {
        scm_misc_error (FUNC_NAME,
                        "error calling pcre_fullinfo on compiled regexp.",
                        SCM_EOL);
      }
      ovecsize = (ovecsize + 1) * 3;
      ovector = scm_must_malloc (ovecsize * sizeof (int),
                                 "pcre-exec output vector");
      rc = pcre_exec (c_pcre_smob_data->p,
                      c_study_info,
                      c_target_str, c_length, c_start_offset,
                      c_options,
                      ovector,
                      ovecsize);

      if (rc < 0) return scm_int2num (rc);

      {
        SCM result_vec = scm_c_make_vector (rc, SCM_BOOL_F);
        int *ovec_cursor = ovector;
        unsigned int result_index;

        for (result_index = 0; result_index < rc; result_index++)
        {
          SCM s_index = scm_uint2num (result_index);
          scm_vector_set_x (result_vec,
                            s_index,
                            scm_cons (scm_int2num (*ovec_cursor),
                                      scm_int2num (*(ovec_cursor + 1))));
          ovec_cursor += 2;
        }
        return result_vec;
      }
    }
  }
  #undef FUNC_NAME


  SCM_DEFINE (scm_pcre_maketables, "pcre-maketables", 0, 0, 0,
              (),
              "Build a set of tables based on the current locale for use in\n"
              "calls to pcre-compile (optional).")
  #define FUNC_NAME s_scm_pcre_maketables
  {
    const unsigned char *c_table = pcre_maketables ();
    if (c_table == NULL)
    {
      scm_misc_error (FUNC_NAME, "failed to maketables.", SCM_EOL);
    }
    SCM_RETURN_NEWSMOB (scm_tc16_pcre_tables_tag, c_table);
  }
  #undef FUNC_NAME



  static size_t
  pcre_smob_free (SCM pcre_smob)
  {
    scm_t_i_pcre *prx = (scm_t_i_pcre *) SCM_SMOB_DATA (pcre_smob);

    if (prx != NULL)
    {
      pcre_free (prx->p);
      prx->p = NULL;
      scm_must_free (prx);
    }
    return 0;
  }

  static size_t
  pcre_generic_smob_free (SCM psmob)
  {
    void *p = (void *) SCM_SMOB_DATA (psmob);

    if (p != NULL)
    {
      pcre_free (p);
      p = NULL;
    }
    return 0;
  }

  void
  libguile_pcre_init ()
  {
    scm_c_define ("PCRE_MAJOR", scm_long2num (PCRE_MAJOR));
    scm_c_define ("PCRE_MINOR", scm_long2num (PCRE_MINOR));

    scm_c_define ("PCRE_ANCHORED", scm_long2num (PCRE_ANCHORED));
    scm_c_define ("PCRE_CASELESS", scm_long2num (PCRE_CASELESS));
    scm_c_define ("PCRE_DOLLAR_ENDONLY", scm_long2num (PCRE_DOLLAR_ENDONLY));
    scm_c_define ("PCRE_DOTALL", scm_long2num (PCRE_DOTALL));
    scm_c_define ("PCRE_EXTENDED", scm_long2num (PCRE_EXTENDED));
    scm_c_define ("PCRE_EXTRA", scm_long2num (PCRE_EXTRA));
    scm_c_define ("PCRE_MULTILINE", scm_long2num (PCRE_MULTILINE));
    scm_c_define ("PCRE_UNGREEDY", scm_long2num (PCRE_UNGREEDY));
    scm_c_define ("PCRE_UTF8", scm_long2num (PCRE_UTF8));

    scm_c_define ("PCRE_ERROR_NOMATCH", scm_long2num (PCRE_ERROR_NOMATCH));
    scm_c_define ("PCRE_ERROR_NULL", scm_long2num (PCRE_ERROR_NULL));
    scm_c_define ("PCRE_ERROR_BADOPTION", scm_long2num (PCRE_ERROR_BADOPTION));
    scm_c_define ("PCRE_ERROR_BADMAGIC", scm_long2num (PCRE_ERROR_BADMAGIC));
    scm_c_define ("PCRE_ERROR_UNKNOWN_NODE",
                  scm_long2num (PCRE_ERROR_UNKNOWN_NODE));
    scm_c_define ("PCRE_ERROR_NOMEMORY", scm_long2num (PCRE_ERROR_NOMEMORY));
    scm_c_define ("PCRE_ERROR_NOSUBSTRING",
                  scm_long2num (PCRE_ERROR_NOSUBSTRING));

    scm_tc16_pcre_tag
      = scm_make_smob_type ("pcre", sizeof (pcre *));
    scm_tc16_pcre_tables_tag
      = scm_make_smob_type ("pcre tables", sizeof (unsigned char *));
    scm_tc16_pcre_extra_tag
      = scm_make_smob_type ("pcre_extra", sizeof (pcre_extra *));

    scm_set_smob_free (scm_tc16_pcre_tag, pcre_smob_free);
    scm_set_smob_free (scm_tc16_pcre_tables_tag, pcre_generic_smob_free);
    scm_set_smob_free (scm_tc16_pcre_extra_tag, pcre_generic_smob_free);

  #  include "libguile-pcre.c.x"
  }

-- 
Rob Browning
rlb @defaultvalue.org, @linuxdevel.com, and @debian.org
Previously @cs.utexas.edu
GPG starting 2002-11-03 = 14DD 432F AE39 534D B592  F9A0 25C8 D377 8C7E 73A4