]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/include/lily-guile.hh
* Documentation/windows/zlily-profile.sh:
[lilypond.git] / lily / include / lily-guile.hh
index 54c9decd293fea8ff8ef6a33d7caabae96ff427e..6b13fc9eb8f491fafae72875a6c3621485d17a19 100644 (file)
@@ -3,12 +3,14 @@
 
   source file of the GNU LilyPond music typesetter
 
-  (c) 1998--2001 Jan Nieuwenhuizen <janneke@gnu.org>
+  (c) 1998--2002 Jan Nieuwenhuizen <janneke@gnu.org>
 */
 
 #ifndef LILY_GUILE_HH
 #define LILY_GUILE_HH
 
+#define SCM_VOIDP_TEST
+
 #include <libguile.h>
 
 /*
@@ -19,6 +21,8 @@
 #include <guile/gh.h>
 
 #include "config.h"
+#include "drul-array.hh"
+
 
 /* Guile 1.3.4 compatibility */
 #if GUILE_MINOR_VERSION < 4
 #define fix_guile_1_4_scm_primitive_eval(form) scm_eval_3 (form, 1, SCM_EOL)
 #define scm_primitive_eval(form) fix_guile_1_4_scm_primitive_eval (form)
 
+#define scm_current_module() (SCM)0
+#define scm_set_current_module(x) (void)x
+#define scm_c_resolve_module(x) (SCM)0
+
 #define scm_c_define_gsubr scm_make_gsubr
 #define scm_c_eval_string(str) gh_eval_str ((char*)str)
 #define scm_c_memq scm_sloppy_memq
@@ -62,7 +70,6 @@
 #endif
 
 
-
 #include "direction.hh"
 #include "flower-proto.hh"
 
@@ -86,10 +93,24 @@ SCM ly_write2scm (SCM s);
 SCM ly_deep_copy (SCM);
 SCM ly_truncate_list (int k, SCM l );
 
+
+#if (__GNUC__ > 2)
+/*
+  todo: should add check for x86 as well
+ */
 #define CACHE_SYMBOLS
+#endif
+
+
+/*
+  We don't use gh_symbol2scm directly, since it has const-correctness
+  problems in GUILE 1.3.4
+  
+ */
+SCM my_gh_symbol2scm (const char* x);
+
 #ifdef CACHE_SYMBOLS
 
-// #warning: CACHE_SYMBOLS
 
 /*
   Using this trick we cache the value of gh_symbol2scm ("fooo") where
@@ -102,13 +123,14 @@ SCM ly_truncate_list (int k, SCM l );
 */
 #define ly_symbol2scm(x) ({ static SCM cached;  \
  SCM value = cached;  /* We store this one locally, since G++ -O2 fucks up else */   \
- if (__builtin_constant_p (x))\
-   value = cached =  scm_permanent_object (gh_symbol2scm((char*)x));\
- else\
-  value = gh_symbol2scm ((char*)x); \
+ if ( __builtin_constant_p ((x)))\
+ {  if (!cached)\
+     value = cached =  scm_gc_protect_object (my_gh_symbol2scm((x)));\
+ } else\
+  value = gh_symbol2scm ((char*) (x)); \
   value; })
 #else
-inline SCM ly_symbol2scm(char const* x) { return gh_symbol2scm((char*)x); }
+inline SCM ly_symbol2scm(char const* x) { return my_gh_symbol2scm((x)); }
 #endif 
 
 
@@ -118,13 +140,16 @@ String ly_symbol2string (SCM);
 SCM ly_offset2scm (Offset);
 Offset ly_scm2offset (SCM);
 SCM ly_assoc_chain (SCM key, SCM achain);
+SCM ly_assoc_cdr (SCM key, SCM alist);
 Interval ly_scm2interval (SCM);
-SCM ly_interval2scm (Interval);
+SCM ly_interval2scm (Drul_array<Real>);
+
 
 SCM ly_parse_scm (char const* s, int* n);
 SCM ly_quote_scm (SCM s);
 SCM ly_type (SCM);
 bool type_check_assignment (SCM val, SCM sym,  SCM type_symbol) ;
+String print_scm_val (SCM val);
 SCM ly_number2string (SCM s);
 
 SCM parse_symbol_list (char const *);
@@ -138,7 +163,17 @@ inline SCM ly_cddr (SCM x) { return SCM_CDDR (x); }
 inline SCM ly_caddr (SCM x) { return SCM_CADDR (x); }
 inline SCM ly_cdadr (SCM x) { return SCM_CDADR (x); }
 inline SCM ly_caadr (SCM x) { return SCM_CAADR (x); }
+/* inserts at front, removing dublicates */
+inline SCM ly_assoc_front_x(SCM alist, SCM key, SCM val)
+{
+  return scm_acons(key, val, scm_assoc_remove_x (alist, key));
+}
+#ifdef PARANOID
+#define gh_pair_p ly_pair_p
+bool ly_pair_p (SCM x);
+#else
 inline bool ly_pair_p (SCM x) { return SCM_NFALSEP (scm_pair_p (x)); }
+#endif
 inline bool ly_symbol_p (SCM x) { return SCM_SYMBOLP (x); }
 inline bool ly_number_p (SCM x) { return SCM_NUMBERP (x); }
 inline bool ly_procedure_p (SCM x) { return SCM_NFALSEP (scm_procedure_p(x)); }
@@ -153,10 +188,9 @@ void ly_display_scm (SCM s);
 #include "array.hh"
 
 void read_lily_scm_file (String);
-void init_lily_guile ();
+void init_lily_guile (String dir);
 
-bool isdir_b (SCM s);
-bool isaxis_b (SCM s);
+bool ly_dir_p (SCM s);
 bool ly_number_pair_p (SCM);
 bool ly_axis_p (SCM);
 
@@ -175,6 +209,10 @@ SCM index_cell (SCM cellp, Direction d);
 SCM index_set_cell (SCM cellp, Direction d, SCM val);
 
 
+
+SCM ly_snoc (SCM s, SCM list);
+SCM ly_split_list (SCM s, SCM list);
+SCM ly_unique (SCM list);
 /*
   snarfing.
  */
@@ -187,10 +225,12 @@ typedef SCM (*Scheme_function_unknown) ();
 typedef SCM (*Scheme_function_0) ();
 typedef SCM (*Scheme_function_1) (SCM);
 typedef SCM (*Scheme_function_2) (SCM,SCM);     
+typedef SCM (*Scheme_function_3) (SCM,SCM, SCM);        
 #else
 typedef SCM (*Scheme_function_0) (...);
 typedef SCM (*Scheme_function_1) (...);
 typedef SCM (*Scheme_function_2) (...);
+typedef SCM (*Scheme_function_3) (...);
 #endif
 
 #define DECLARE_SCHEME_CALLBACK(NAME,ARGS) \
@@ -209,6 +249,10 @@ TYPE ## _ ## FUNC ## _init_functions ()                                    \
 ADD_SCM_INIT_FUNC (TYPE ## _ ## FUNC ## _callback, TYPE ## _ ## FUNC ## _init_functions);      \
 
 
+void ly_add_function_documentation (char const * fname,
+                                   char const * varlist,
+                                   char const * doc);
+
 #define ADD_SCM_INIT_FUNC(name, func)\
 class name ## _scm_initter {                   \
 public:\
@@ -219,4 +263,20 @@ public:\
 } _ ## name ## _scm_initter;                   \
 /* end define */
 
+#define LY_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
+SCM FNAME ARGLIST ; \
+SCM FNAME ## _proc;\
+void \
+FNAME ## init ()\
+{\
+ FNAME ## _proc \
+    = scm_c_define_gsubr (PRIMNAME,REQ, OPT, VAR, (Scheme_function_unknown) FNAME);\
+  ly_add_function_documentation (PRIMNAME, #ARGLIST,  DOCSTRING);\
+}\
+ADD_SCM_INIT_FUNC (FNAME ## init_unique_prefix, FNAME ## init);\
+SCM \
+FNAME ARGLIST\
+
+
+
 #endif // LILY_GUILE_HH