1 /*_. Klink 0.0: klink.h */
3 /*_ . Credits and License */
5 Copyright (C) 2010,2011 Tom Breton (Tehom)
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.
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.
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/>.
27 /*_ . C++ nonmangling */
35 /*_ . Default values for #define'd symbols */
37 * Default values for #define'd symbols
39 #ifndef STANDALONE /* If used as standalone interpreter */
44 # define USE_STRCASECMP 1
50 # define USE_STRCASECMP 0
53 # define KLINK_EXPORT __declspec(dllexport)
55 # define KLINK_EXPORT __declspec(dllimport)
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
71 #define PROFILING /* $$TRANSITIONAL Define profiling */
72 #define USE_OBJECT_LIST /* Temporary diagnostic */
74 # define USE_INTERFACE 1
78 #ifndef USE_MATH /* If math support is needed */
82 #ifndef USE_CHAR_CLASSIFIERS /* If char classifiers are needed */
83 # define USE_CHAR_CLASSIFIERS 1
86 #ifndef USE_ASCII_NAMES /* If extended escaped characters are needed */
87 # define USE_ASCII_NAMES 1
90 #ifndef USE_STRING_PORTS /* Enable string ports */
91 # define USE_STRING_PORTS 1
95 # define USE_TRACING 1
102 /* To force system errors through user-defined error handling (see *error-hook*) */
103 #ifndef USE_ERROR_HOOK
104 # define USE_ERROR_HOOK 1
107 #ifndef USE_COLON_HOOK /* Enable qualified qualifier */
108 # define USE_COLON_HOOK 1
111 #ifndef USE_STRCASECMP /* stricmp for Unix */
112 # define USE_STRCASECMP 0
116 # define USE_STRLWR 1
119 #ifndef STDIO_ADDS_CR /* Define if DOS/Windows */
120 # define STDIO_ADDS_CR 0
127 #ifndef USE_INTERFACE
128 # define USE_INTERFACE 0
131 #ifndef SHOW_ERROR_LINE /* Show error line in file */
132 # define SHOW_ERROR_LINE 1
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
140 # define RGSTR(ARRAY,K_NAME,C_NAME) /* Do nothing */
143 /*_ . Fundamental types */
144 /*_ , Fundamental enumerations */
145 /*_ . The T_ types */
147 typedef enum klink_types
166 T_RECURRENCES
, /* Returned by get-recurrences */
174 T_STORE
, /* Operative */
175 T_LOAD
, /* Operative */
176 T_NOTRACE
, /* Operative */
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
),
185 /*_ , Fundamental typedefs */
187 /*_ . Interpreters, error reporting */
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 */
200 typedef kt_boxed_any kt_boxed_void
;
202 /*_ , Macros helping this */
203 #define BOX_OF(TYPE) \
204 struct { _kt_tag type; TYPE data; }
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
211 typedef _kt_tag
*pko
;
213 /*_ , Macros converting from box to pko */
214 #define PTR2PKO(OBJ) (&(OBJ)->type)
215 #define REF_OBJ(OBJ) (&(OBJ).type)
217 /*_ , Struct definitions */
219 /* num, for generic arithmetic */
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
,
237 KLINK_EXPORT
void klink_set_output_port_file (klink
* sc
, FILE * fin
);
238 void klink_set_output_port_string (klink
* sc
, char *start
,
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
);
250 /*_ . Macros to define type signatures for functions */
251 /* Macros to define type signatures for functions.
252 One define-macro per function type.
255 Letters occur in order. Some cannot occur together.
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"
266 C_NAME: The name that the C function should have. This can also
267 be a (*functype_name) for typedefs.
272 #define KERNEL_FUN_SIG_b00a1(C_NAME) \
275 #define KERNEL_FUN_SIG_b00a2(C_NAME) \
276 int C_NAME(pko arg1, pko arg2)
278 #define KERNEL_FUN_SIG_bs0a2(C_NAME) \
279 int C_NAME(klink *sc, pko arg1, pko arg2)
281 #define KERNEL_FUN_SIG_p00a0(C_NAME) \
284 #define KERNEL_FUN_SIG_p00a1(C_NAME) \
287 #define KERNEL_FUN_SIG_p00a2(C_NAME) \
288 pko C_NAME(pko arg1, pko arg2)
290 #define KERNEL_FUN_SIG_p00a3(C_NAME) \
291 pko C_NAME(pko arg1, pko arg2, pko arg3)
293 #define KERNEL_FUN_SIG_ps0a0(C_NAME) \
294 pko C_NAME(klink *sc)
296 #define KERNEL_FUN_SIG_ps0a1(C_NAME) \
297 pko C_NAME(klink *sc, pko arg1)
299 #define KERNEL_FUN_SIG_ps0a2(C_NAME) \
300 pko C_NAME(klink *sc, pko arg1, pko arg2)
302 #define KERNEL_FUN_SIG_ps0a3(C_NAME) \
303 pko C_NAME(klink *sc, pko arg1, pko arg2, \
306 #define KERNEL_FUN_SIG_ps0a4(C_NAME) \
307 pko C_NAME(klink *sc, pko arg1, pko arg2, \
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)
314 #define KERNEL_FUN_SIG_vs0a3(C_NAME) \
315 void C_NAME(klink *sc, pko arg1, pko arg2, pko arg3)
317 #define KERNEL_FUN_SIG_vs0a2(C_NAME) \
318 void C_NAME(klink *sc, pko arg1, pko arg2)
320 /* Typedefs of the functions. */
321 #define FFTYPE(X,Y) typedef KERNEL_FUN_SIG_##X((*kernel_f_##X));
322 #include "fftypes.inc"
325 /* Union of all function types */
326 typedef union kernel_f_union
328 void *dummy
; /* So we can initialize the union. */
329 #define FFTYPE(X,Y) kernel_f_##X f_##X;
330 #include "fftypes.inc"
334 /* Enumeration of function types */
335 typedef enum klink_ftype_enum
337 klink_ftype_dummy
, /* Allowing 0 would be risky. */
338 #define FFTYPE(X,Y) klink_ftype_##X,
339 #include "fftypes.inc"
344 /* Data for Kernel to know about a function */
345 typedef struct kt_cfunc
348 klink_ftype_enum type
;
353 /*_ . Internal functions that are exported */
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
);
366 void putstr (klink
* sc
, const char *s
);
367 int list_length (pko a
);
368 int eqv (pko a
, pko b
);
372 struct klink_interface
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
);
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
);
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
);
412 int (*is_symbol
) (pko p
);
413 char *(*symname
) (klink
* sc
, pko p
);
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
);
424 typedef struct kernel_registerable
426 const char *const name
;
428 } kernel_registerable
;
431 k_register_list (const kernel_registerable
* list
, int count
, pko env
);
435 /*_ , Define mcons */
437 #define mcons(a,b) v2cons(T_PAIR,a,b)
438 #define cons(a,b) v2cons(T_PAIR | T_IMMUTABLE,a,b)
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))))
456 /*_ . End C++ nonmangling */