added (updated) regex module

CHANGES

@@ -4,6 +4,8 @@ Change Log
 Version 1.50
     - extended the public API and properly namespaced everything
     - separated the main tinyscheme shell into a separate file
+    - made source compatible with Visual C++ (and consequently C89)
+    - added regex module and updated it to use the new API
 
 Version 1.41
     Bugs fixed:

CMakeLists.txt

@@ -5,9 +5,15 @@ set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib)
 # set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib)
 # set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin)
 
+# remove 'lib' prefix for dlls 
+if(WIN32 AND CMAKE_COMPILER_IS_GNUCXX)
+	set(CMAKE_SHARED_LIBRARY_PREFIX "")
+endif()
+
 # ----------------------------------------------------------------------------
 
 set (TINYSCHEME_DIR "src")
+set (RE_MODULE_DIR "src/re")
 
 # ----------------------------------------------------------------------------
 
@@ -49,3 +55,20 @@ set_target_properties (tinyscheme-app PROPERTIES OUTPUT_NAME tinyscheme)
 
 # ----------------------------------------------------------------------------
 
+set(RE_MODULE_SRCS
+	${RE_MODULE_DIR}/re.c 
+	${RE_MODULE_DIR}/debug.c 
+	${RE_MODULE_DIR}/regcomp.c 
+	${RE_MODULE_DIR}/regerror.c 
+	${RE_MODULE_DIR}/regexec.c 
+	${RE_MODULE_DIR}/regfree.c 
+	${RE_MODULE_DIR}/split.c
+)
+
+add_library(tinyscheme-re SHARED ${RE_MODULE_SRCS})
+target_link_libraries(tinyscheme-re tinyscheme)
+target_include_directories (tinyscheme-re PUBLIC ${TINYSCHEME_DIR} PUBLIC ${RE_MODULE_DIR})
+target_compile_definitions(tinyscheme-re PUBLIC ${TINYSCHEME_DEFS})
+set_target_properties (tinyscheme-re PROPERTIES OUTPUT_NAME re)
+
+# ----------------------------------------------------------------------------

docs/regex-module.txt

@@ -0,0 +1,27 @@
+             TinyScheme RE (Regular Expressions) extension
+             ---------------------------------------------
+Version 1.2, August 2002
+
+The bulk of this directory is the regular expression library written
+by Henry Spencer (see file README and COPYRIGHT).
+
+Two files were added to produce the TinyScheme regular expression
+library, re.so: re.c and re.makefile. The included re.makefile was contributed
+initially by Stephen Gildea and should be adaptable to all Unix systems.
+
+The makefile produces a DLL named re.so. For now, it contains just
+a single foreign function (re-match <pattern> <string>). It returns
+true (string matches pattern) or false. If it is called with an
+extra parameter, which should be a vector, overwrites as many elements
+of the vector as needed with the strings that matched the corresponding
+parenthesized subexpressions inside <pattern>.
+
+It is not fully tested, so use with caution.
+
+Load the extension from inside TinyScheme using
+(load-extension "re/re")
+assuming that re.so is in the directory "re".
+
+Load "re.scm" if you wish to use v.1.1 behavior.
+
+dsouflis@acm.org

src/api.c

@@ -224,3 +224,19 @@ int scheme_is_immutable(pointer p) {
 void scheme_setimmutable(pointer p) {
 	setimmutable(p);
 }
+
+void scheme_fill_vector(pointer vec, pointer obj) {
+	fill_vector(vec, obj);
+}
+
+pointer scheme_vector_elem(pointer vec, int ielem) {
+	return vector_elem(vec, ielem);
+}
+
+pointer scheme_set_vector_elem(pointer vec, int ielem, pointer a) {
+	return set_vector_elem(vec, ielem, a);
+}
+
+void scheme_memory_error(scheme *sc) {
+	sc->no_memory=1;
+}

src/config.h

@@ -19,7 +19,7 @@
 #define _CONFIG_H
 
 #if defined _WIN32 && !defined SCHEME_STATIC
-# ifdef _SCHEME_SOURCE
+# if defined _SCHEME_SOURCE || defined SCHEME_MODULE
 #  define SCHEME_EXPORT __declspec(dllexport)
 # else
 #  define SCHEME_EXPORT __declspec(dllimport)

src/dynload.c

@@ -99,6 +99,7 @@ pointer scm_load_ext(scheme *sc, pointer args)
 
    if ((args != sc->NIL) && is_string((first_arg = pair_car(args)))) {
       name = string_value(first_arg);
+      printf("loading scheme extension %s\n", name);
       make_filename(name,filename);
       make_init_fn(name,init_fn);
       dll_handle = dl_attach(filename);
@@ -108,6 +109,7 @@ pointer scm_load_ext(scheme *sc, pointer args)
       else {
          module_init = (void(*)(scheme *))dl_proc(dll_handle, init_fn);
          if (module_init != 0) {
+            printf("found init function: executing\n");
             (*module_init)(sc);
             retval = sc -> T;
          }

src/re/re.c

@@ -2,58 +2,43 @@
 /* Henry Spencer's implementation of Regular Expressions,
    used for TinyScheme */
 /* Refurbished by Stephen Gildea */
-#include "regex.h"
-#include "scheme.h"
-#include "scheme-private.h"
-
-#if defined(_WIN32)
-#define EXPORT __declspec( dllexport )
-#else
-#define EXPORT
-#endif
-
-/* Since not exported */
-#define T_STRING 1
+/* Updated by armornick */
 
-static void set_vector_elem(pointer vec, int ielem, pointer newel) {
- int n=ielem/2;
- if(ielem%2==0) {
-     vec[1+n]._object._cons._car=newel;
- } else {
-     vec[1+n]._object._cons._cdr=newel;
- }
-}
+/* this defintion is to export the init function */
+#define SCHEME_MODULE
+#include "regex.h"
+#include <scheme.h>
 
 pointer foreign_re_match(scheme *sc, pointer args) {
-  pointer retval=sc->F;
+  pointer retval=scheme_false(sc);
   int retcode;
   regex_t rt;
   pointer first_arg, second_arg;
-  pointer third_arg=sc->NIL;
+  pointer third_arg=scheme_nil(sc);
   char *string;
   char *pattern;
   int num=0;
 
-  if(!((args != sc->NIL) && sc->vptr->is_string((first_arg = sc->vptr->pair_car(args)))
-       && (args=sc->vptr->pair_cdr(args))
-       && sc->vptr->is_pair(args) && sc->vptr->is_string((second_arg = sc->vptr->pair_car(args))))) {
-    return sc->F;
+  if(!((args != scheme_nil(sc)) && scheme_is_string((first_arg = scheme_pair_car(args)))
+       && (args=scheme_pair_cdr(args))
+       && scheme_is_pair(args) && scheme_is_string((second_arg = scheme_pair_car(args))))) {
+    return scheme_false(sc);
   }
-  pattern = sc->vptr->string_value(first_arg);
-  string = sc->vptr->string_value(second_arg);
+  pattern = scheme_string_value(first_arg);
+  string = scheme_string_value(second_arg);
 
-  args=sc->vptr->pair_cdr(args);
-  if(args!=sc->NIL) {
-    if(!(sc->vptr->is_pair(args) && sc->vptr->is_vector((third_arg = sc->vptr->pair_car(args))))) {
-      return sc->F;
+  args=scheme_pair_cdr(args);
+  if(args!=scheme_nil(sc)) {
+    if(!(scheme_is_pair(args) && scheme_is_vector((third_arg = scheme_pair_car(args))))) {
+      return scheme_false(sc);
     } else {
-      num=third_arg->_object._number.value.ivalue;
+      num = scheme_ivalue(third_arg);
     }
   }
 
 
   if(regcomp(&rt,pattern,REG_EXTENDED)!=0) {
-    return sc->F;
+    return scheme_false(sc);
   }
 
   if(num==0) {
@@ -65,22 +50,21 @@ pointer foreign_re_match(scheme *sc, pointer args) {
       if(retcode==0) {
     int i;
     for(i=0; i<num; i++) {
-#undef cons
-      set_vector_elem(third_arg, i,
-              sc->vptr->cons(sc, sc->vptr->mk_integer(sc, pmatch[i].rm_so),
-                          sc->vptr->mk_integer(sc, pmatch[i].rm_eo)));
+      scheme_set_vector_elem(third_arg, i,
+              cons(sc, scheme_integer(sc, pmatch[i].rm_so),
+                          scheme_integer(sc, pmatch[i].rm_eo)));
 
     }
       }
       free(pmatch);
     } else {
-      sc->no_memory=1;
+      scheme_memory_error(sc);
       retcode=-1;
     }
   }
 
   if(retcode==0) {
-    retval=sc->T;
+    retval=scheme_true(sc);
   }
 
   regfree(&rt);
@@ -102,7 +86,9 @@ static char* utilities=";; return the substring of STRING matched in MATCH-VECTO
 "    (substring string (cdr (vector-ref match-vector n))\n"
 "             (string-length string))))\n";
 
-EXPORT void init_re(scheme *sc) {
-  sc->vptr->scheme_define(sc,sc->global_env,sc->vptr->mk_symbol(sc,"re-match"),sc->vptr->mk_foreign_func(sc, foreign_re_match));
-  /*    sc->vptr->load_string(sc,utilities);*/
+SCHEME_EXPORT void init_re(scheme *sc) {
+  printf("RE: defining foreign function\n");
+  scheme_define(sc, scheme_global_env(sc), scheme_symbol(sc, "re-match"), scheme_foreign_func(sc, foreign_re_match));
+  // printf("RE: adding utility functions\n");
+  // scheme_load_string(sc, utilities);
 }

src/scheme-private.h

@@ -226,10 +226,11 @@ int is_environment(pointer p);
 int is_immutable(pointer p);
 void setimmutable(pointer p);
 
-
 pointer reverse(scheme *sc, pointer a);
 pointer reverse_in_place(scheme *sc, pointer term, pointer list);
-
+void fill_vector(pointer vec, pointer obj);
+pointer vector_elem(pointer vec, int ielem);
+pointer set_vector_elem(pointer vec, int ielem, pointer a);
 
 #ifdef __cplusplus
 }

src/scheme.c

@@ -173,9 +173,6 @@ INTERFACE INLINE int is_string(pointer p)     { return (type(p)==T_STRING); }
 
 INTERFACE static int is_list(scheme *sc, pointer p);
 INTERFACE INLINE int is_vector(pointer p)    { return (type(p)==T_VECTOR); }
-INTERFACE static void fill_vector(pointer vec, pointer obj);
-INTERFACE static pointer vector_elem(pointer vec, int ielem);
-INTERFACE static pointer set_vector_elem(pointer vec, int ielem, pointer a);
 INTERFACE INLINE int is_number(pointer p)    { return (type(p)==T_NUMBER); }
 INTERFACE INLINE int is_integer(pointer p) {
   if (!is_number(p))
@@ -1005,7 +1002,7 @@ INTERFACE pointer mk_empty_string(scheme *sc, int len, char fill) {
 INTERFACE static pointer mk_vector(scheme *sc, int len)
 { return get_vector_object(sc,len,sc->NIL); }
 
-INTERFACE static void fill_vector(pointer vec, pointer obj) {
+INTERFACE void fill_vector(pointer vec, pointer obj) {
      int i;
      int num=ivalue(vec)/2+ivalue(vec)%2;
      for(i=0; i<num; i++) {
@@ -1016,7 +1013,7 @@ INTERFACE static void fill_vector(pointer vec, pointer obj) {
      }
 }
 
-INTERFACE static pointer vector_elem(pointer vec, int ielem) {
+INTERFACE pointer vector_elem(pointer vec, int ielem) {
      int n=ielem/2;
      if(ielem%2==0) {
           return car(vec+1+n);
@@ -1025,7 +1022,7 @@ INTERFACE static pointer vector_elem(pointer vec, int ielem) {
      }
 }
 
-INTERFACE static pointer set_vector_elem(pointer vec, int ielem, pointer a) {
+INTERFACE pointer set_vector_elem(pointer vec, int ielem, pointer a) {
      int n=ielem/2;
      if(ielem%2==0) {
           return car(vec+1+n)=a;

src/scheme.h

@@ -120,17 +120,20 @@ SCHEME_EXPORT pointer scheme_global_env(scheme *sc);
 SCHEME_EXPORT pointer scheme_nil(scheme *sc);
 SCHEME_EXPORT pointer scheme_true(scheme *sc);
 SCHEME_EXPORT pointer scheme_false(scheme *sc);
+SCHEME_EXPORT void scheme_memory_error(scheme *sc);
 
 SCHEME_EXPORT pointer scheme_reverse(scheme *sc, pointer a);
 SCHEME_EXPORT pointer scheme_reverse_in_place(scheme *sc, pointer term, pointer list);
+SCHEME_EXPORT void scheme_fill_vector(pointer vec, pointer obj);
+SCHEME_EXPORT pointer scheme_vector_elem(pointer vec, int ielem);
+SCHEME_EXPORT pointer scheme_set_vector_elem(pointer vec, int ielem, pointer a);
+
 
 
 #define cons(sc,a,b) scheme_cons(sc,a,b,0)
 #define immutable_cons(sc,a,b) scheme_cons(sc,a,b,1)
 
 
-#if USE_INTERFACE
-
 struct scheme_interface {
   void (*scheme_define)(scheme *sc, pointer env, pointer symbol, pointer value);
   pointer (*cons)(scheme *sc, pointer a, pointer b);
@@ -198,8 +201,6 @@ typedef struct scheme_interface scheme_interface;
 
 SCHEME_EXPORT void scheme_init_interface(scheme_interface *sci);
 
-#endif
-
 typedef struct scheme_registerable
 {
   foreign_func  f;