1 /**
2
3 SFSEXP: Small, Fast S-Expression Library version 1.0
4 Written by Matthew Sottile (matt@lanl.gov)
5
6 Copyright (2003-2006). The Regents of the University of California. This
7 material was produced under U.S. Government contract W-7405-ENG-36 for Los
8 Alamos National Laboratory, which is operated by the University of
9 California for the U.S. Department of Energy. The U.S. Government has rights
10 to use, reproduce, and distribute this software. NEITHER THE GOVERNMENT NOR
11 THE UNIVERSITY MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR ASSUMES ANY
12 LIABILITY FOR THE USE OF THIS SOFTWARE. If software is modified to produce
13 derivative works, such modified software should be clearly marked, so as not
14 to confuse it with the version available from LANL.
15
16 Additionally, this library is free software; you can redistribute it and/or
17 modify it under the terms of the GNU Lesser General Public License as
18 published by the Free Software Foundation; either version 2.1 of the
19 License, or (at your option) any later version.
20
21 This library is distributed in the hope that it will be useful, but WITHOUT
22 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
23 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License
24 for more details.
25
26 You should have received a copy of the GNU Lesser General Public License
27 along with this library; if not, write to the Free Software Foundation,
28 Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, U SA
29
30 LA-CC-04-094
31
32 **/
33
34 /**
35 * utility routines of some use to the slisp implementation, removed from
36 * the eval source file to unclutter things. also, these routines may
37 * prove useful enough in a general sense that they may be migrated into
38 * the main s-expression library code base in the future.
39 *
40 * -mjs 8.2003
41 */
42 #include "slisp_util.h"
43 #include <assert.h>
44 #include <stdlib.h>
45 #include <string.h>
46
47 /**
48 *
49 */
deep_copy_sexp(sexp_t * sx)50 sexp_t *deep_copy_sexp(sexp_t *sx) {
51 sexp_t *c_sx;
52
53 if (sx == NULL) return NULL;
54
55 c_sx = (sexp_t *)malloc(sizeof(sexp_t));
56 assert(c_sx != NULL);
57
58 c_sx->ty = sx->ty;
59 c_sx->aty = sx->aty;
60
61 if (sx->ty == SEXP_VALUE) {
62 switch(sx->aty) {
63 case SEXP_BASIC:
64 case SEXP_SQUOTE:
65 case SEXP_DQUOTE:
66 c_sx->val_used = sx->val_used;
67 c_sx->val_allocated = sx->val_allocated;
68 c_sx->val = (char *)malloc(sizeof(char)*c_sx->val_allocated);
69 assert(c_sx->val != NULL);
70 memcpy(c_sx->val,sx->val,c_sx->val_used);
71
72 c_sx->bindata = NULL;
73 c_sx->binlength = 0;
74 break;
75
76 case SEXP_BINARY:
77 c_sx->val_used = c_sx->val_allocated = 0;
78 c_sx->val = NULL;
79 c_sx->binlength = sx->binlength;
80 c_sx->bindata = (char *)malloc(sizeof(char)*c_sx->binlength);
81
82 assert(c_sx->bindata != NULL);
83 memcpy(c_sx->bindata,sx->bindata,sx->binlength);
84
85 break;
86
87 default:
88 fprintf(stderr,"ERROR: Unknown atom type in SEXP_VALUE element.\n");
89
90 break;
91 }
92 } else {
93 /* this is a list - so null out all atom data pointers, set counts
94 to zero, and deal with the list/next fields. if someone was
95 trying to be clever and was hiding stuff in these fields, they're
96 screwed. :) */
97 c_sx->val = NULL;
98 c_sx->val_allocated = c_sx->val_used = 0;
99 c_sx->binlength = 0;
100 c_sx->bindata = NULL;
101 c_sx->list = deep_copy_sexp(sx->list);
102 c_sx->next = deep_copy_sexp(sx->next);
103 }
104
105 return c_sx;
106 }
107
108 /**
109 * Given a sexp_t element, return the token that it represents.
110 */
tokenize(sexp_t * sx)111 slisp_op_t tokenize(sexp_t *sx) {
112 if (sx->ty != SEXP_VALUE) {
113 return SL_UNKNOWN;
114 }
115
116 if (strcmp("+",sx->val) == 0) return SL_PLUS;
117 else if (strcmp("-",sx->val) == 0) return SL_MINUS;
118 else if (strcmp("*",sx->val) == 0) return SL_MULT;
119 else if (strcmp("/",sx->val) == 0) return SL_DIVIDE;
120 else if (strcmp("^",sx->val) == 0) return SL_EXP;
121 else if (strcmp("=",sx->val) == 0) return SL_EQ;
122 else if (strcmp(">",sx->val) == 0) return SL_GT;
123 else if (strcmp("<",sx->val) == 0) return SL_LT;
124 else if (strcmp("<=",sx->val) == 0) return SL_LEQ;
125 else if (strcmp(">=",sx->val) == 0) return SL_GEQ;
126 else if (strcmp("<>",sx->val) == 0) return SL_NE;
127 else if (strcmp("if",sx->val) == 0) return SL_IF;
128 else if (strcmp("not",sx->val) == 0) return SL_NOT;
129 else if (strcmp("cdr",sx->val) == 0) return SL_CDR;
130 else if (strcmp("car",sx->val) == 0) return SL_CAR;
131 else if (strcmp("map",sx->val) == 0) return SL_MAP;
132 else if (strcmp("cons",sx->val) == 0) return SL_CONS;
133 else if (strcmp("fold",sx->val) == 0) return SL_FOLD;
134 else if (strcmp("sort",sx->val) == 0) return SL_SORT;
135 else if (strcmp("sqrt",sx->val) == 0) return SL_SQRT;
136 else if (strcmp("lambda",sx->val) == 0) return SL_LAMBDA;
137
138 return SL_UNKNOWN;
139 }
140
141 /**
142 * Given an expression element, try to derive the type.
143 */
derive_type(sexp_t * sx)144 slisp_val_t derive_type(sexp_t *sx) {
145 slisp_val_t ty = SL_INT;
146 char *p;
147
148 if (sx->ty == SEXP_LIST) return SL_SEXP;
149 p = sx->val;
150
151 if (p == NULL) return SL_INVALID;
152
153 /* only one minus, first character, is allowed while still remaining a
154 numeric type. */
155 if (p[0] == '-') p++;
156
157 while (p[0] != '\0' && ty != SL_STRING) {
158 if (p[0] == '.') {
159 if (ty == SL_INT) ty = SL_FLOAT;
160 else ty = SL_STRING;
161 } else if (p[0] > '9'|| p[0] < '0') ty = SL_STRING;
162 p++;
163 }
164
165 return ty;
166 }
167