klink.h

   1 /*_. Klink 0.0: klink.h */
   2 /*_ , Header */
   3 /*_  . Credits and License */
   4 /*
   5     Copyright (C) 2010,2011 Tom Breton (Tehom)
   6
   7     This program is free software: you can redistribute it and/or modify
   8     it under the terms of the GNU General Public License as published by
   9     the Free Software Foundation, either version 3 of the License, or
  10     (at your option) any later version.
  11
  12     This program is distributed in the hope that it will be useful,
  13     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15     GNU General Public License for more details.
  16
  17     You should have received a copy of the GNU General Public License
  18     along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19  */
  20 /*_  . Once */
  21 #ifndef _KLINK_H
  22 #define _KLINK_H
  23
  24 /*_  . Own includes */
  25 #include <stdio.h>
  26
  27 /*_  . C++ nonmangling */
  28 #ifdef __cplusplus
  29 extern "C"
  30 {
  31 #endif
  32
  33 /*_ , Body */
  34
  35 /*_  . Default values for #define'd symbols */
  36 /*
  37  * Default values for #define'd symbols
  38  */
  39 #ifndef STANDALONE              /* If used as standalone interpreter */
  40 # define STANDALONE 1
  41 #endif
  42
  43 #ifndef _MSC_VER
  44 # define USE_STRCASECMP 1
  45 # ifndef USE_STRLWR
  46 #   define USE_STRLWR 1
  47 # endif
  48 # define KLINK_EXPORT
  49 #else
  50 # define USE_STRCASECMP 0
  51 # define USE_STRLWR 0
  52 # ifdef _KLINK_SOURCE
  53 #  define KLINK_EXPORT __declspec(dllexport)
  54 # else
  55 #  define KLINK_EXPORT __declspec(dllimport)
  56 # endif
  57 #endif
  58
  59 #if USE_NO_FEATURES
  60 # define USE_MATH 0
  61 # define USE_CHAR_CLASSIFIERS 0
  62 # define USE_ASCII_NAMES 0
  63 # define USE_STRING_PORTS 0
  64 # define USE_ERROR_HOOK 0
  65 # define USE_TRACING 0
  66 # define USE_COLON_HOOK 0
  67 # define USE_DL 0
  68 # define USE_PLIST 0
  69 #endif
  70
  71 #define PROFILING               /* $$TRANSITIONAL Define profiling */
  72 #define USE_OBJECT_LIST         /* Temporary diagnostic */
  73 #if USE_DL
  74 # define USE_INTERFACE 1
  75 #endif
  76
  77
  78 #ifndef USE_MATH                /* If math support is needed */
  79 # define USE_MATH 1
  80 #endif
  81
  82 #ifndef USE_CHAR_CLASSIFIERS    /* If char classifiers are needed */
  83 # define USE_CHAR_CLASSIFIERS 1
  84 #endif
  85
  86 #ifndef USE_ASCII_NAMES         /* If extended escaped characters are needed */
  87 # define USE_ASCII_NAMES 1
  88 #endif
  89
  90 #ifndef USE_STRING_PORTS        /* Enable string ports */
  91 # define USE_STRING_PORTS 1
  92 #endif
  93
  94 #ifndef USE_TRACING
  95 # define USE_TRACING 1
  96 #endif
  97
  98 #ifndef USE_PLIST
  99 # define USE_PLIST 0
 100 #endif
 101
 102 /* To force system errors through user-defined error handling (see *error-hook*) */
 103 #ifndef USE_ERROR_HOOK
 104 # define USE_ERROR_HOOK 1
 105 #endif
 106
 107 #ifndef USE_COLON_HOOK          /* Enable qualified qualifier */
 108 # define USE_COLON_HOOK 1
 109 #endif
 110
 111 #ifndef USE_STRCASECMP          /* stricmp for Unix */
 112 # define USE_STRCASECMP 0
 113 #endif
 114
 115 #ifndef USE_STRLWR
 116 # define USE_STRLWR 1
 117 #endif
 118
 119 #ifndef STDIO_ADDS_CR           /* Define if DOS/Windows */
 120 # define STDIO_ADDS_CR 0
 121 #endif
 122
 123 #ifndef INLINE
 124 # define INLINE
 125 #endif
 126
 127 #ifndef USE_INTERFACE
 128 # define USE_INTERFACE 0
 129 #endif
 130
 131 #ifndef SHOW_ERROR_LINE         /* Show error line in file */
 132 # define SHOW_ERROR_LINE 1
 133 #endif
 134
 135 /*_  .  */
 136 #ifdef COLLECT_RGSTRS           /* Not compiling, collecting registerables */
 137 # define RGSTR(ARRAY,K_NAME,C_NAME) \
 138   _K_RGSTR ARRAY:{ K_NAME, C_NAME, }, _K_END_RGSTR
 139 #else
 140 # define RGSTR(ARRAY,K_NAME,C_NAME)             /* Do nothing */
 141 #endif
 142
 143 /*_  . Fundamental types */
 144 /*_   , Fundamental enumerations */
 145 /*_    . The T_ types */
 146
 147 typedef enum klink_types
 148 {
 149   T_STRING,
 150   T_NUMBER,
 151   T_SYMBOL,
 152   T_PAIR,
 153   T_CHARACTER,
 154   T_PORT,
 155   T_VECTOR,
 156   T_ENCAP,
 157   T_CONTINUATION,
 158   T_CFUNC,
 159   T_CURRIED,
 160   T_DESTRUCTURE,
 161   T_TYPECHECK,
 162   T_TYPEP,
 163   T_ENV_FRAME,
 164   T_ENV_PAIR,
 165   T_KEY,
 166   T_RECURRENCES,                /* Returned by get-recurrences */
 167   T_RECUR_TRACKER,
 168   T_LISTLOOP_STYLE,
 169   T_LISTLOOP,
 170   T_PROMISE,
 171   T_CHAIN,
 172   T_CHAIN_ARG,
 173   T_CHAIN_ACCUM,
 174   T_STORE,              /* Operative  */
 175   T_LOAD,               /* Operative */
 176   T_NOTRACE,            /* Operative */
 177   T_DESTR_RESULT,
 178   T_CFUNC_RESUME,
 179
 180   T_NO_K      = 16384,          /* Function will not need _klink_cycle */
 181   T_IMMUTABLE = 32768,          /* Object can't mutate  */
 182   T_MASKTYPE  = ~(T_IMMUTABLE | T_NO_K),
 183 } _kt_tag;
 184
 185 /*_   , Fundamental typedefs */
 186
 187 /*_    . Interpreters, error reporting */
 188
 189   typedef struct klink klink;
 190   /* Error-reporting, allowed to be 0 to indicate that only C static
 191      checking is wanted. */
 192   typedef klink * sc_or_null;
 193 /*_    . Kernel objects */
 194
 195   typedef struct
 196   {
 197     _kt_tag type;
 198   } kt_boxed_any;
 199
 200   typedef kt_boxed_any kt_boxed_void;
 201
 202 /*_     , Macros helping this */
 203 #define BOX_OF(TYPE)                            \
 204   struct { _kt_tag type; TYPE data; }
 205
 206
 207 /*_    . Pointers to kernel objects */
 208   /* We can't reasonably have a `const' variant, because pko's are
 209      passed around in a way governed by Kernel logic, not C constness
 210      logic.  */
 211   typedef _kt_tag *pko;
 212
 213 /*_     , Macros converting from box to pko */
 214 #define PTR2PKO(OBJ) (&(OBJ)->type)
 215 #define REF_OBJ(OBJ) (&(OBJ).type)
 216
 217 /*_   , Struct definitions */
 218
 219 /* num, for generic arithmetic */
 220   typedef struct num
 221   {
 222     char is_fixnum;
 223     union
 224     {
 225       long ivalue;
 226       double rvalue;
 227     } value;
 228   } num;
 229
 230 /*_  . Signatures of exported functions */
 231   KLINK_EXPORT klink *klink_alloc_init (FILE * in, FILE * out);
 232   KLINK_EXPORT int klink_init (klink * sc, FILE * in, FILE * out);
 233   KLINK_EXPORT void klink_deinit (klink * sc);
 234   void klink_set_input_port_file (klink * sc, FILE * fin);
 235   void klink_set_input_port_string (klink * sc, char *start,
 236                                      char *past_the_end);
 237   KLINK_EXPORT void klink_set_output_port_file (klink * sc, FILE * fin);
 238   void klink_set_output_port_string (klink * sc, char *start,
 239                                       char *past_the_end);
 240   KLINK_EXPORT void klink_load_file (klink * sc, FILE * fin);
 241   KLINK_EXPORT void klink_load_named_file (klink * sc, FILE * fin,
 242                                              const char *filename);
 243   KLINK_EXPORT void klink_load_string (klink * sc, const char *cmd);
 244   KLINK_EXPORT pko klink_apply0 (klink * sc, const char *procname);
 245   KLINK_EXPORT int klink_call (klink * sc, pko func, pko args);
 246   KLINK_EXPORT int klink_eval (klink * sc, pko obj);
 247   void klink_set_external_data (klink * sc, void *p);
 248   KLINK_EXPORT void klink_define (klink * sc, pko symbol, pko value);
 249
 250 /*_  . Macros to define type signatures for functions */
 251   /* Macros to define type signatures for functions.
 252      One define-macro per function type.
 253
 254      Naming klink:
 255      Letters occur in order.  Some cannot occur together.
 256
 257      P = returns a pko
 258      B = returns an integer interpreted as a boolean
 259      S = takes a pointer to the klink interpreter as first argument "sc"
 260      AN = takes its Kernel arguments as a single object "args"
 261      A1 = takes one Kernel argument "arg1"
 262      A2, A3 etc = takes 2 (3, etc) Kernel arguments, named "arg1", "arg2"
 263
 264      Macro arguments:
 265
 266      C_NAME: The name that the C function should have.  This can also
 267      be a (*functype_name) for typedefs.
 268
 269    */
 270
 271
 272 #define KERNEL_FUN_SIG_b00a1(C_NAME)            \
 273   int C_NAME(pko arg1)
 274
 275 #define KERNEL_FUN_SIG_b00a2(C_NAME)            \
 276   int C_NAME(pko arg1, pko arg2)
 277
 278 #define KERNEL_FUN_SIG_bs0a2(C_NAME)            \
 279   int C_NAME(klink *sc, pko arg1, pko arg2)
 280
 281 #define KERNEL_FUN_SIG_p00a0(C_NAME)            \
 282   pko C_NAME(void)
 283
 284 #define KERNEL_FUN_SIG_p00a1(C_NAME)            \
 285   pko C_NAME(pko arg1)
 286
 287 #define KERNEL_FUN_SIG_p00a2(C_NAME)            \
 288     pko C_NAME(pko arg1, pko arg2)
 289
 290 #define KERNEL_FUN_SIG_p00a3(C_NAME)            \
 291     pko C_NAME(pko arg1, pko arg2, pko arg3)
 292
 293 #define KERNEL_FUN_SIG_ps0a0(C_NAME)            \
 294     pko C_NAME(klink *sc)
 295
 296 #define KERNEL_FUN_SIG_ps0a1(C_NAME)            \
 297     pko C_NAME(klink *sc, pko arg1)
 298
 299 #define KERNEL_FUN_SIG_ps0a2(C_NAME)                            \
 300     pko C_NAME(klink *sc, pko arg1, pko arg2)
 301
 302 #define KERNEL_FUN_SIG_ps0a3(C_NAME)                            \
 303   pko C_NAME(klink *sc, pko arg1, pko arg2,     \
 304                  pko arg3)
 305
 306 #define KERNEL_FUN_SIG_ps0a4(C_NAME)                            \
 307   pko C_NAME(klink *sc, pko arg1, pko arg2,     \
 308                  pko arg3, pko arg4)
 309
 310 #define KERNEL_FUN_SIG_ps0a5(C_NAME)                            \
 311   pko C_NAME(klink *sc, pko arg1, pko arg2,             \
 312                  pko arg3, pko arg4, pko arg5)
 313
 314 #define KERNEL_FUN_SIG_vs0a3(C_NAME)                            \
 315   void C_NAME(klink *sc, pko arg1, pko arg2, pko arg3)
 316
 317   #define KERNEL_FUN_SIG_vs0a2(C_NAME)                          \
 318   void C_NAME(klink *sc, pko arg1, pko arg2)
 319
 320   /* Typedefs of the functions. */
 321 #define FFTYPE(X,Y) typedef KERNEL_FUN_SIG_##X((*kernel_f_##X));
 322 #include "fftypes.inc"
 323 #undef FFTYPE
 324
 325   /* Union of all function types */
 326   typedef union kernel_f_union
 327   {
 328     void *dummy;                /* So we can initialize the union. */
 329 #define FFTYPE(X,Y) kernel_f_##X f_##X;
 330 #include "fftypes.inc"
 331 #undef FFTYPE
 332   } kernel_f_union;
 333
 334   /* Enumeration of function types */
 335   typedef enum klink_ftype_enum
 336   {
 337     klink_ftype_dummy,  /* Allowing 0 would be risky. */
 338 #define FFTYPE(X,Y) klink_ftype_##X,
 339 #include "fftypes.inc"
 340 #undef FFTYPE
 341     klink_ftype_beyond,
 342   } klink_ftype_enum;
 343
 344   /* Data for Kernel to know about a function */
 345   typedef struct kt_cfunc
 346   {
 347     kernel_f_union   func;
 348     klink_ftype_enum type;
 349     pko              argcheck;
 350     pko              rettype;
 351   } kt_cfunc;
 352
 353 /*_  . Internal functions that are exported */
 354
 355   pko mk_pair (pko a, pko b);
 356   pko mk_mutable_pair (pko a, pko b);
 357   pko mk_integer (long num);
 358   pko mk_real (double num);
 359   pko mk_symbol (const char *name);
 360   pko mk_string (const char *str);
 361   pko mk_counted_string (const char *str, int len);
 362   pko mk_empty_string (int len, char fill);
 363   pko mk_character (int c);
 364   pko mk_cfunc (const kt_cfunc * f);
 365
 366   void putstr (klink * sc, const char *s);
 367   int list_length (pko a);
 368   int eqv (pko a, pko b);
 369
 370
 371 #if USE_INTERFACE
 372   struct klink_interface
 373   {
 374     void (*klink_define) (klink * sc, pko symbol, pko value);
 375     pko (*mcons) (pko a, pko b);
 376     pko (*cons) (pko a, pko b);
 377     pko (*mk_integer) (long num);
 378     pko (*mk_real) (double num);
 379     pko (*mk_symbol) (const char *name);
 380     pko (*mk_string) (const char *str);
 381     pko (*mk_counted_string) (const char *str, int len);
 382     pko (*mk_character) (int c);
 383     pko (*mk_vector) (int len, pko fill);
 384     void (*putstr) (klink * sc, const char *s);
 385     void (*putcharacter) (klink * sc, int c);
 386
 387     int (*is_string) (pko p);
 388     char *(*string_value) (pko p);
 389     int (*is_number) (pko p);
 390     num (*nvalue) (pko p);
 391     long (*ivalue) (pko p);
 392     double (*rvalue) (pko p);
 393     int (*is_integer) (pko p);
 394     int (*is_real) (pko p);
 395     int (*is_character) (pko p);
 396     long (*charvalue) (pko p);
 397     int (*is_list) (pko p);
 398     int (*is_vector) (pko p);
 399     int (*list_length) (pko vec);
 400     int (*vector_length) (pko vec);
 401     void (*fill_vector) (pko vec, pko elem);
 402     pko (*vector_elem) (pko vec, int ielem);
 403     void (*set_vector_elem) (pko vec, int ielem, pko newel);
 404     int (*is_port) (pko p);
 405
 406     int (*is_pair) (pko p);
 407     pko (*pair_car) (klink * sc, pko p);
 408     pko (*pair_cdr) (klink * sc, pko p);
 409     pko (*set_car) (klink * sc, pko p, pko q);
 410     pko (*set_cdr) (klink * sc, pko p, pko q);
 411
 412     int (*is_symbol) (pko p);
 413     char *(*symname) (klink * sc, pko p);
 414
 415     int (*is_continuation) (pko p);
 416     int (*is_environment) (pko p);
 417     int (*is_immutable) (pko p);
 418     void (*setimmutable) (pko p);
 419     void (*load_file) (klink * sc, FILE * fin);
 420     void (*load_string) (klink * sc, const char *input);
 421   };
 422 #endif
 423
 424   typedef struct kernel_registerable
 425   {
 426     const char *const name;
 427     const pko data;
 428   } kernel_registerable;
 429
 430   void
 431   k_register_list (const kernel_registerable * list, int count, pko env);
 432
 433
 434 /*_  . Pairs */
 435 /*_   , Define mcons */
 436
 437 #define mcons(a,b) v2cons(T_PAIR,a,b)
 438 #define cons(a,b)  v2cons(T_PAIR | T_IMMUTABLE,a,b)
 439
 440 /*_   , Define c{ad}*r etc */
 441   /* To be used with WITH_REPORTER */
 442 #define car(p) (v2car(_err_reporter,T_PAIR,p))
 443 #define cdr(p) (v2cdr(_err_reporter,T_PAIR,p))
 444 #define caar(p)          car(car(p))
 445 #define cadr(p)          car(cdr(p))
 446 #define cdar(p)          cdr(car(p))
 447 #define cddr(p)          cdr(cdr(p))
 448 #define cadar(p)         car(cdr(car(p)))
 449 #define caddr(p)         car(cdr(cdr(p)))
 450 #define cdaar(p)         cdr(car(car(p)))
 451 #define cadaar(p)        car(cdr(car(car(p))))
 452 #define cadddr(p)        car(cdr(cdr(cdr(p))))
 453 #define cddddr(p)        cdr(cdr(cdr(cdr(p))))
 454
 455 /*_ , Footers */
 456 /*_  . End C++ nonmangling */
 457 #ifdef __cplusplus
 458 }
 459 #endif
 460
 461 /*_  . End Once */
 462 #endif
 463
 464
 465 /*
 466 Local variables:
 467 c-file-style: "gnu"
 468 mode: allout
 469 End:
 470 */