libguile/scmhob.h

   1 /* This was modified to try out compiling with Guile. */
   2
   3
   4 /*   scmhob.h is a header file for scheme source compiled with hobbit4d
   5      Copyright (C) 1992, 1993, 1994, 1995 Tanel Tammet
   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 1, or (at your option)
  10 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, write to the Free Software
  19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20 */
  21
  22
  23 #include <stdio.h>
  24 #include <ctype.h>
  25 #include "libguile/_scm.h"
  26
  27 \f
  28
  29 #define abrt                    scm_abort
  30 #define absval                  scm_abs
  31 #define angle                   scm_angle
  32 #define append                  scm_append
  33 #define assoc                   scm_assoc
  34 #define assq                    scm_assq
  35 #define assv                    scm_assv
  36 #define big2dbl                 scm_big2dbl
  37 #define close_port              scm_close_port
  38 #define cons                    scm_cons
  39 #define cur_input_port          scm_current_input_port
  40 #define cur_output_port         scm_current_output_port
  41 #define difference              scm_difference
  42 #define display                 scm_display
  43 #define divide                  scm_divide
  44 #define eof_objectp             scm_eof_object_p
  45 #define eqp                     scm_eq_p
  46 #define equal                   scm_equal_p
  47 #define eqv                     scm_eqv_p
  48 #define evenp                   scm_even_p
  49 #define exactp                  scm_exact_p
  50 #define greaterp                scm_gr_p
  51 #define greqp                   scm_geq_p
  52 #define imag_part               scm_imag_part
  53 #define in2ex                   scm_inexact_to_exact
  54 #define inexactp                scm_inexact_p
  55 #define input_portp             scm_input_port_p
  56 #define intp                    scm_integer_p
  57 #define length                  scm_length
  58 #define leqp                    scm_leq_p
  59 #define lessp                   scm_less_p
  60 #define lgcd                    scm_gcd
  61 #define list_ref                scm_list_ref
  62 #define list_tail               scm_list_tail
  63 #define listp                   scm_list_p
  64 #define llcm                    scm_lcm
  65 #define lmax                    scm_max
  66 #define lmin                    scm_min
  67 #define lquotient               scm_quotient
  68 #define lread(X)                scm_read((X), SCM_UNDEFINED)
  69 #define lremainder              scm_remainder
  70 #define lwrite                  scm_write
  71 #define magnitude               scm_magnitude
  72 #define makcclo                 scm_makcclo
  73 #define makdbl                  scm_makdbl
  74 #define make_string             scm_make_string
  75 #define make_vector             scm_make_vector
  76 #define makpolar                scm_make_polar
  77 #define makrect                 scm_make_rectangular
  78 #define member                  scm_member
  79 #define memq                    scm_memq
  80 #define memv                    scm_memv
  81 #define modulo                  scm_modulo
  82 #define my_time                 scm_get_internal_run_time
  83 #define negativep               scm_negative_p
  84 #define newline                 scm_newline
  85 #define number2string           scm_number_to_string
  86 #define oddp                    scm_odd_p
  87 #define open_file               scm_open_file
  88 #define output_portp            scm_output_port_p
  89 #define peek_char               scm_peek_char
  90 #define positivep               scm_positive_p
  91 #define procedurep              scm_procedure_p
  92 #define product                 scm_product
  93 #define quit                    scm_quit
  94 #define read_char               scm_read_char
  95 #define real_part               scm_real_part
  96 #define realp                   scm_real_p
  97 #define reverse                 scm_reverse
  98 #define set_inp                 scm_set_current_input_port
  99 #define set_outp                scm_set_current_output_port
 100 #define st_append               scm_string_append
 101 #define st_equal                scm_string_equal_p
 102 #define st_leqp                 scm_string_leq_p
 103 #define st_lessp                scm_string_less_p
 104 #define st_set                  scm_string_set_x
 105 #define stci_equal              scm_string_ci_equal_p
 106 #define stci_leqp               scm_string_ci_leq_p
 107 #define stci_lessp              scm_string_ci_less_p
 108 #define string                  scm_string
 109 #define string2list             scm_string_to_list
 110 #define string2number           scm_string_to_number
 111 #define string2symbol           scm_string_to_symbol
 112 #define string_copy             scm_string_copy
 113 #define string_fill             scm_string_fill_x
 114 #define substring               scm_substring
 115 #define sum                     scm_sum
 116 #define symbol2string           scm_symbol_to_string
 117 #define vector                  scm_vector
 118 #define vector2list             scm_vector_to_list
 119 #define vector_ref              scm_vector_ref
 120 #define vector_set              scm_vector_set_x
 121 #define write_char              scm_write_char
 122 #define zerop                   scm_zero_p
 123
 124 \f
 125
 126 #define STBL_VECTOR_SET(v,k,o) (v[((long)SCM_INUM(k))] = o)
 127 #define STBL_VECTOR_REF(v,k) (v[((long)SCM_INUM(k))])
 128 #define CHAR_LESSP(x,y) ((SCM_ICHR(x) < SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F)
 129 #define CHAR_LEQP(x,y) ((SCM_ICHR(x) <= SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F)
 130 #define CHCI_EQ(x,y) ((upcase[SCM_ICHR(x)]==upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
 131 #define CHCI_LESSP(x,y) ((upcase[SCM_ICHR(x)] < upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
 132 #define CHCI_LEQP(x,y) ((upcase[SCM_ICHR(x)] <= upcase[SCM_ICHR(y)]) ? SCM_BOOL_T : SCM_BOOL_F)
 133 #define CHAR_ALPHAP(chr) ((isascii(SCM_ICHR(chr)) && isalpha(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
 134 #define SCM_CHAR_NUMP(chr) ((isascii(SCM_ICHR(chr)) && isdigit(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
 135 #define CHAR_WHITEP(chr) ((isascii(SCM_ICHR(chr)) && isspace(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
 136 #define CHAR_UPPERP(chr) ((isascii(SCM_ICHR(chr)) && isupper(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
 137 #define CHAR_LOWERP(chr) ((isascii(SCM_ICHR(chr)) && islower(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F)
 138 #define CHAR2INT(chr) SCM_MAKINUM(SCM_ICHR(chr))
 139 #define INT2CHAR(n) SCM_MAKICHR(SCM_INUM(n))
 140 #define CHAR_UPCASE(chr) SCM_MAKICHR(upcase[SCM_ICHR(chr)])
 141 #define CHAR_DOWNCASE(chr) SCM_MAKICHR(downcase[SCM_ICHR(chr)])
 142 #define ST_LENGTH(str) SCM_MAKINUM(SCM_LENGTH(str))
 143 #define ST_REF(str,k) SCM_MAKICHR(SCM_CHARS(str)[SCM_INUM(k)])
 144 #define VECTOR_LENGTH(v)  SCM_MAKINUM(SCM_LENGTH(v))
 145
 146 #ifdef SCM_FLOATS
 147 #include <math.h>
 148 #endif
 149 #ifdef SCM_BIGDIG
 150 #define PRE_TRANSC_FUN(x) (SCM_INUMP(x) ? (double) SCM_INUM(x) : (SCM_REALP(x) ? (double) SCM_REALPART(x) : (double) big2dbl(x)))
 151 #else
 152 #define PRE_TRANSC_FUN(x) (SCM_INUMP(x) ?  (double) SCM_INUM(x) : (double) SCM_REALPART(x))
 153 #endif
 154
 155 #define SIN_FUN(x) (makdbl( sin( PRE_TRANSC_FUN(x)), 0.0))
 156 #define COS_FUN(x) (makdbl( cos( PRE_TRANSC_FUN(x)), 0.0))
 157 #define TAN_FUN(x) (makdbl( tan( PRE_TRANSC_FUN(x)), 0.0))
 158 #define ASIN_FUN(x) (makdbl( asin( PRE_TRANSC_FUN(x)), 0.0))
 159 #define ACOS_FUN(x) (makdbl( acos( PRE_TRANSC_FUN(x)), 0.0))
 160 #define ATAN_FUN(x) (makdbl( atan( PRE_TRANSC_FUN(x)), 0.0))
 161 #define SINH_FUN(x) (makdbl( sinh( PRE_TRANSC_FUN(x)), 0.0))
 162 #define COSH_FUN(x) (makdbl( cosh( PRE_TRANSC_FUN(x)), 0.0))
 163 #define TANH_FUN(x) (makdbl( tanh( PRE_TRANSC_FUN(x)), 0.0))
 164 #define ASINH_FUN(x) (makdbl( asinh( PRE_TRANSC_FUN(x)), 0.0))
 165 #define ACOSH_FUN(x) (makdbl( acosh( PRE_TRANSC_FUN(x)), 0.0))
 166 #define ATANH_FUN(x) (makdbl( atanh( PRE_TRANSC_FUN(x)), 0.0))
 167 #define SQRT_FUN(x) (makdbl( sqrt( PRE_TRANSC_FUN(x)), 0.0))
 168 #define EXPT_FUN(x,y) (makdbl( pow(( PRE_TRANSC_FUN(x)), ( PRE_TRANSC_FUN(y))), 0.0))
 169 #define EXP_FUN(x) (makdbl( exp( PRE_TRANSC_FUN(x)), 0.0))
 170 #define LOG_FUN(x) (makdbl( log( PRE_TRANSC_FUN(x)), 0.0))
 171 #define ABS_FUN(x) (makdbl( fabs( PRE_TRANSC_FUN(x)), 0.0))
 172 #define EX2IN_FUN(x) (makdbl( PRE_TRANSC_FUN(x), 0.0))
 173 #define SCM_FLOOR_FUN(x) (makdbl( floor( PRE_TRANSC_FUN(x)), 0.0))
 174 #define CEILING_FUN(x) (makdbl( ceil( PRE_TRANSC_FUN(x)), 0.0))
 175 #define TRUNCATE_FUN(x) (makdbl( ltrunc( PRE_TRANSC_FUN(x)), 0.0))
 176 #define ROUND_FUN(x) (makdbl(round( PRE_TRANSC_FUN(x)), 0.0))
 177
 178 /* the following defs come from the #ifdef HOBBIT part of scm.h */
 179
 180 #define SBOOL(x) ((x) ? SCM_BOOL_T : SCM_BOOL_F)
 181
 182 #define BOOLEAN_P(x) ((x)==SCM_BOOL_T || (x)==SCM_BOOL_F)
 183 #define CHAR_P SCM_ICHRP
 184 #define SYMBOL_P(x) (SCM_ISYMP(x) || (!(SCM_IMP(x)) && SCM_SYMBOLP(x)))
 185 #define VECTOR_P(x) (!(SCM_IMP(x)) && SCM_VECTORP(x))
 186 #define PAIR_P(x) (!(SCM_IMP(x)) && SCM_CONSP(x))
 187 #define NUMBER_P SCM_INUMP
 188 #define INTEGER_P SCM_INUMP
 189 #define STRING_P(x) (!(SCM_IMP(x)) && SCM_STRINGP(x))
 190 #define NULL_P SCM_NULLP
 191 #define ZERO_P(x) ((x)==SCM_INUM0)
 192 #define POSITIVE_P(x) ((x) > SCM_INUM0)
 193 #define NEGATIVE_P(x) ((x) < SCM_INUM0)
 194
 195 #define NOT(x) ((x)==SCM_BOOL_F ? SCM_BOOL_T : SCM_BOOL_F)
 196 #define SET_CAR(x,y) (CAR(x) = (SCM)(y))
 197 #define SET_CDR(x,y) (CDR(x) = (SCM)(y))
 198 #define VECTOR_SET(v,k,o) (SCM_VELTS(v)[((long)SCM_INUM(k))] = o)
 199 #define VECTOR_REF(v,k) (SCM_VELTS(v)[((long)SCM_INUM(k))])
 200 #define CL_VECTOR_SET(v,k,o) (SCM_VELTS(v)[k] = o)
 201 #define CL_VECTOR_REF(v,k) (SCM_VELTS(v)[k])
 202 #define GLOBAL(x) (*(x))
 203
 204 #define append2(lst1,lst2) (append(scm_cons2(lst1,lst2,SCM_EOL)))
 205 #define procedure_pred_(x) (SCM_BOOL_T==procedurep(x))