luke
/
magic
mirror of https://github.com/RTimothyEdwards/magic.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
magic/lisp/lispParse.c

416 lines
8.5 KiB
C
Raw Blame History

/*************************************************************************
*
* lispParse.c --
*
* This module contains the mini-scheme command-line parser (ugh).
*
* (c) 1996 California Institute of Technology
* Department of Computer Science
* Pasadena, CA 91125.
*
* Permission to use, copy, modify, and distribute this software
* and its documentation for any purpose and without fee is hereby
* granted, provided that the above copyright notice appear in all
* copies. The California Institute of Technology makes no representations
* about the suitability of this software for any purpose. It is
* provided "as is" without express or implied warranty. Export of this
* software outside of the United States of America may require an
* export license.
*
* $Header$
*
*************************************************************************/
#include <stdio.h>
#include <ctype.h>
#include "lisp/lisp.h"
#include "lispInt.h"
#include "textio/textio.h"
#include "utils/hash.h"
#include "utils/malloc.h"
#define IsSpace(c) ((c) == ' ')
#define BeginIdChar(c) (isalpha(c) || (c) == '+' || (c) == '-' || \
(c) == '.' || (c) == '*' || (c) == '/' || \
(c) == '<' || (c) == '=' || (c) == '>' || \
(c) == '!' || (c) == '?' || (c) == ':' || \
(c) == '$' || (c) == '%' || (c) == '_' || \
(c) == '&' || (c) == '~' || (c) == '^' || \
(c) == '#' || (c) == '@' || (c) == ',')
#define IsIdChar(c) (BeginIdChar(c) || isdigit(c) || ((c) == '[') || \
((c) == ']'))
#define ISEND(c) ((c) == '\0' || isspace(c) || (c) == ')' || (c) == '(')
/*-----------------------------------------------------------------------------
*
* Various string munging functions
*
*-----------------------------------------------------------------------------
*/
/*
strip whitespace from left: returns new string pointer
*/
static char *
stripleft (s)
char *s;
{
while (*s && IsSpace (*s))
s++;
return s;
}
#define STRINGTAB 1000
static int nstrings = 0;
HashTable Strings;
/*-----------------------------------------------------------------------------
*
* LispNewString --
*
* Returns a unique string pointer corresponding to string "s"
*
*-----------------------------------------------------------------------------
*/
char *LispNewString (s)
char *s;
{
int i;
HashEntry *h;
if (nstrings == 0)
HashInit (&Strings, STRINGTAB, HT_STRINGKEYS);
h = HashLookOnly (&Strings, s);
if (h)
i = (int) HashGetValue(h);
else {
i = nstrings++;
h = HashFind (&Strings, s);
HashSetValue (h, i);
}
return h->h_key.h_name;
}
/*-----------------------------------------------------------------------------
*
* LispStringId --
*
* Returns an integer identifier associated with string, used for
* faster function table lookup.
*
* Results:
* None.
*
* Side effects:
* None.
*
*-----------------------------------------------------------------------------
*/
int
LispStringId (s)
char *s;
{
int i;
HashEntry *h;
h = HashLookOnly (&Strings, s);
if (!h)
i = -1;
else
i = (int)HashGetValue (h);
return i;
}
/*-----------------------------------------------------------------------------
*
* LispAtomParse --
*
* Parse an atom.
* If within a quote, 'quoted' is 1.
*
* Results:
* Returns pointer to an object.
*
* Side effects:
* None.
*
*-----------------------------------------------------------------------------
*/
LispObj *
LispAtomParse (pstr,quoted)
int quoted;
char **pstr;
{
char *str = *pstr;
char *q, c;
LispObj *l;
int r;
char *t;
l = LispNewObj ();
if ((*str == '+' || *str == '-' || *str == '.') && ISEND(*(str+1))) {
str++;
*str = '\0';
LTYPE(l) = S_SYM;
LSYM(l) = LispNewString (str-1);
*pstr = str+1;
return l;
}
if ((isdigit(*str) || *str == '.' || *str == '-' || *str == '+') &&
(isdigit(str[1]) || str[1] == '.' || str[1] == '-' || str[1] == '+'
|| ISEND(str[1]))) {
/* eat leading sign */
q = str;
r = 0;
if (*str == '-' || *str == '+')
str++;
if (!*str) {
TxPrintf ("Invalid number\n");
*pstr = str;
return NULL;
}
while (*str && isdigit (*str))
str++;
if (*str && *str == '.') {
r = 1;
str++;
}
while (*str && isdigit(*str))
str++;
c = *str;
*str = '\0';
if (r) {
LTYPE(l) = S_FLOAT;
sscanf (q, "%lf", &LFLOAT(l));
}
else {
LTYPE(l) = S_INT;
sscanf (q, "%d", &LINTEGER(l));
}
*str = c;
}
else if (*str == '\"') {
str++;
q = str;
while (*str != '\"') {
if (!*str) {
TxPrintf ("Unterminated string\n");
*pstr = str;
return NULL;
}
if (*str == '\\') {
if (*(str+1))
str++;
else {
TxPrintf ("Trailing character constant\n");
*pstr = str;
return NULL;
}
}
str++;
}
*str = '\0';
LTYPE(l) = S_STRING;
LSTR(l) = (char *) mallocMagic((unsigned) (strlen (q)+1));
strcpy (LSTR(l), q);
*str = '\"';
str++;
}
else if (!quoted && str[0] == '#' && (str[1] == 't'|| str[1] == 'f') &&
ISEND(str[2])) {
LTYPE(l) = S_BOOL;
LBOOL(l) = (str[1] == 't') ? 1 : 0;
str+=2;
}
else if (BeginIdChar(*str) || (*str == '\\')) {
int nest;
LTYPE(l) = S_SYM;
t = q = str;
if (*str == '\\') {
*t = *++str;
t++;
str++;
}
nest = 0;
while (*str && IsIdChar (*str) || *str == '(' || (*str == ')' && nest>0)) {
*t = *str;
if (*str == '(') nest++;
if (*str == ')') nest--;
str++;
if (*str == '\\') {
*t = *++str;
str++;
}
t++;
}
c = *t;
*t = '\0';
LSYM(l) = LispNewString (q);
*t = c;
}
else {
TxPrintf ("Unparsable input character: %c\n", *str);
*pstr = str;
return NULL;
}
*pstr = str;
return l;
}
/*-----------------------------------------------------------------------------
*
* LispIParse --
*
* Parse a string to a Sexp.
*
* Results:
* Returns pointer to a Sexp.
*
* Side effects:
* None.
*
*-----------------------------------------------------------------------------
*/
Sexp *
LispIParse (pstr)
char **pstr;
{
char *str = *pstr;
Sexp *s;
Sexp *ret = NULL;
Sexp **sptr;
str = stripleft (str);
if (!*str) {
TxPrintf ("Input malformed\n");
return NULL;
}
while (*str != ')') {
if (!*str) {
TxPrintf ("Input malformed: missing )\n");
return NULL;
}
s = LispNewSexp ();
if (*str == '(') {
CAR(s) = LispNewObj ();
LTYPE(CAR(s)) = S_LIST;
str++;
LLIST(CAR(s)) = LispIParse (&str);
if (*str != ')') {
*pstr = str;
return NULL;
}
str++;
}
else if (*str == '\'') {
LispObj *l;
Sexp *t;
t = s;
CAR(s) = LispNewObj ();
LTYPE(CAR(s)) = S_SYM;
LSYM(CAR(s)) = LispNewString ("quote");
CDR(s) = LispNewObj ();
LTYPE(CDR(s)) = S_LIST;
LLIST(CDR(s)) = LispNewSexp ();
s = LLIST(CDR(s));
CDR(s) = LispNewObj ();
LTYPE(CDR(s)) = S_LIST;
LLIST(CDR(s)) = NULL;
str++;
str = stripleft (str);
if (*str == '(') {
str++;
CAR(s) = LispNewObj ();
LTYPE(CAR(s)) = S_LIST;
LLIST(CAR(s)) = LispIParse (&str);
if (*str != ')') {
*pstr = str;
return NULL;
}
str++;
}
else {
if (!(CAR(s) = LispAtomParse (&str,1))) {
*pstr = str;
return NULL;
}
}
*pstr = str;
l = LispNewObj ();
LTYPE(l) = S_LIST;
LLIST(l) = t;
t = LispNewSexp ();
CAR(t) = l;
s = t;
}
else {
if (!(CAR(s) = LispAtomParse (&str,0))) {
*pstr = str;
return NULL;
}
}
CDR(s) = LispNewObj ();
LTYPE(CDR(s)) = S_LIST;
if (ret == NULL)
ret = s;
else
*sptr = s;
sptr = &LLIST(CDR(s));
str = stripleft (str);
}
if (ret)
*sptr = NULL;
*pstr = str;
return ret;
}
/*-----------------------------------------------------------------------------
*
* LispParseString --
*
* Parse string to a lisp object.
*
* Results:
* Returns pointer to the object.
*
* Side effects:
* None.
*
*-----------------------------------------------------------------------------
*/
LispObj *
LispParseString (str)
char *str;
{
LispObj *l;
str = stripleft (str);
if (*str != '(')
l = LispAtomParse (&str,0);
else {
str++;
l = LispNewObj ();
LTYPE(l) = S_LIST;
LLIST(l) = LispIParse (&str);
if (LLIST(l) && *str != ')')
l = NULL;
}
return l;
}
Reference in New Issue View Git Blame Copy Permalink