git.gag.com Git - fw/altos/blob - src/scheme/ao_scheme_atom.c

   1 /*
   2  * Copyright © 2016 Keith Packard <keithp@keithp.com>
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; version 2 of the License.
   7  *
   8  * This program is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License along
  14  * with this program; if not, write to the Free Software Foundation, Inc.,
  15  * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
  16  */
  17
  18 #include "ao_scheme.h"
  19
  20 static int name_size(char *name)
  21 {
  22         return sizeof(struct ao_scheme_atom) + strlen(name) + 1;
  23 }
  24
  25 static int atom_size(void *addr)
  26 {
  27         struct ao_scheme_atom   *atom = addr;
  28         if (!atom)
  29                 return 0;
  30         return name_size(atom->name);
  31 }
  32
  33 static void atom_mark(void *addr)
  34 {
  35         struct ao_scheme_atom   *atom = addr;
  36
  37         for (;;) {
  38                 atom = ao_scheme_poly_atom(atom->next);
  39                 if (!atom)
  40                         break;
  41                 if (ao_scheme_mark_memory(&ao_scheme_atom_type, atom))
  42                         break;
  43         }
  44 }
  45
  46 static void atom_move(void *addr)
  47 {
  48         struct ao_scheme_atom   *atom = addr;
  49         int                     ret;
  50
  51         for (;;) {
  52                 struct ao_scheme_atom *next = ao_scheme_poly_atom(atom->next);
  53
  54                 if (!next)
  55                         break;
  56                 ret = ao_scheme_move_memory(&ao_scheme_atom_type, (void **) &next);
  57                 if (next != ao_scheme_poly_atom(atom->next))
  58                         atom->next = ao_scheme_atom_poly(next);
  59                 if (ret)
  60                         break;
  61                 atom = next;
  62         }
  63 }
  64
  65 const struct ao_scheme_type ao_scheme_atom_type = {
  66         .mark = atom_mark,
  67         .size = atom_size,
  68         .move = atom_move,
  69         .name = "atom"
  70 };
  71
  72 struct ao_scheme_atom   *ao_scheme_atoms;
  73
  74 static struct ao_scheme_atom *
  75 ao_scheme_atom_find(char *name)
  76 {
  77         struct ao_scheme_atom   *atom;
  78
  79         for (atom = ao_scheme_atoms; atom; atom = ao_scheme_poly_atom(atom->next)) {
  80                 if (!strcmp(atom->name, name))
  81                         return atom;
  82         }
  83 #ifdef ao_builtin_atoms
  84         for (atom = ao_scheme_poly_atom(ao_builtin_atoms); atom; atom = ao_scheme_poly_atom(atom->next)) {
  85                 if (!strcmp(atom->name, name))
  86                         return atom;
  87         }
  88 #endif
  89         return NULL;
  90 }
  91
  92 static void
  93 ao_scheme_atom_init(struct ao_scheme_atom *atom, char *name)
  94 {
  95         if (atom) {
  96                 atom->type = AO_SCHEME_ATOM;
  97                 strcpy(atom->name, name);
  98                 atom->next = ao_scheme_atom_poly(ao_scheme_atoms);
  99                 ao_scheme_atoms = atom;
 100         }
 101 }
 102
 103 struct ao_scheme_atom *
 104 ao_scheme_string_to_atom(struct ao_scheme_string *string)
 105 {
 106         struct ao_scheme_atom   *atom = ao_scheme_atom_find(string->val);
 107
 108         if (atom)
 109                 return atom;
 110         ao_scheme_string_stash(0, string);
 111         atom = ao_scheme_alloc(name_size(string->val));
 112         string = ao_scheme_string_fetch(0);
 113         ao_scheme_atom_init(atom, string->val);
 114         return atom;
 115 }
 116
 117 struct ao_scheme_atom *
 118 ao_scheme_atom_intern(char *name)
 119 {
 120         struct ao_scheme_atom   *atom = ao_scheme_atom_find(name);
 121         if (atom)
 122                 return atom;
 123
 124         atom = ao_scheme_alloc(name_size(name));
 125         ao_scheme_atom_init(atom, name);
 126         return atom;
 127 }
 128
 129 ao_poly *
 130 ao_scheme_atom_ref(ao_poly atom, struct ao_scheme_frame **frame_ref)
 131 {
 132         ao_poly *ref;
 133         struct ao_scheme_frame *frame;
 134
 135         for (frame = ao_scheme_frame_current; frame; frame = ao_scheme_poly_frame(frame->prev)) {
 136                 ref = ao_scheme_frame_ref(frame, atom);
 137                 if (ref) {
 138                         if (frame_ref)
 139                                 *frame_ref = frame;
 140                         return ref;
 141                 }
 142         }
 143         ref = ao_scheme_frame_ref(ao_scheme_frame_global, atom);
 144         if (ref)
 145                 if (frame_ref)
 146                         *frame_ref = ao_scheme_frame_global;
 147         return ref;
 148 }
 149
 150 ao_poly
 151 ao_scheme_atom_get(ao_poly atom)
 152 {
 153         ao_poly *ref = ao_scheme_atom_ref(atom, NULL);
 154
 155 #ifdef ao_builtin_frame
 156         if (!ref)
 157                 ref = ao_scheme_frame_ref(ao_scheme_poly_frame(ao_builtin_frame), atom);
 158 #endif
 159         if (ref)
 160                 return *ref;
 161         return ao_scheme_error(AO_SCHEME_UNDEFINED, "undefined atom %s", ao_scheme_poly_atom(atom)->name);
 162 }
 163
 164 ao_poly
 165 ao_scheme_atom_set(ao_poly atom, ao_poly val)
 166 {
 167         ao_poly *ref = ao_scheme_atom_ref(atom, NULL);
 168
 169         if (!ref)
 170                 return ao_scheme_error(AO_SCHEME_UNDEFINED, "undefined atom %s", ao_scheme_poly_atom(atom)->name);
 171         *ref = val;
 172         return val;
 173 }
 174
 175 ao_poly
 176 ao_scheme_atom_def(ao_poly atom, ao_poly val)
 177 {
 178         struct ao_scheme_frame  *frame;
 179         ao_poly *ref = ao_scheme_atom_ref(atom, &frame);
 180
 181         if (ref) {
 182                 if (frame == ao_scheme_frame_current)
 183                         return ao_scheme_error(AO_SCHEME_REDEFINED, "attempt to redefine atom %s", ao_scheme_poly_atom(atom)->name);
 184                 *ref = val;
 185                 return val;
 186         }
 187         return ao_scheme_frame_add(ao_scheme_frame_current ? ao_scheme_frame_current : ao_scheme_frame_global, atom, val);
 188 }
 189
 190 void
 191 ao_scheme_atom_write(ao_poly a, bool write)
 192 {
 193         struct ao_scheme_atom *atom = ao_scheme_poly_atom(a);
 194         (void) write;
 195         printf("%s", atom->name);
 196 }