/* lparse.c: parse s-expressions,
 * conv to internal form and print.
 * grammar: sexpr --->  alphanum  |  "("   tail
 *          tail  --->  ")"       |  sexpr tail
 */
#include <stdio.h>
#include <string.h>
/* Lisp cells and supporting declarations */
typedef enum {l, a} Stype;  /* list or alpha */
typedef struct scell* Sp;   /* ptr to S-expr */
typedef struct scell {      /* S-expr decl */
            Stype celltype; /* Kind of S-expr? */
            struct {
                Sp first;   /* pointer to car */
                Sp rest;    /* pointer to cdr */
            } lcell;
            char alf;       /* alpha S-expr */
        } Scell;
/* function prototypes */
Sp getsexpr(void); /* fetch next S-expression */
Sp sexpr(void); /* recognize and return S-expr */
Sp tail (void); /* recognize tail end of S-expr */
Sp cons(Sp, Sp); /* tack two S-exprs together */
Sp car(Sp); /* chase first pointer of S-expr */
Sp cdr(Sp); /* chase second pointer of S-expr */
Sp newalfatom(char); /* create new alpha S-expr */
void writesexpr(Sp); /* write an entire S-expr */
void wsexpr(Sp ); /* write S-expr, calls tail */
void wtail(Sp ); /* write tail of S-expression */
Sp err(int); /* error message */
char gettoken(void); /* fetch next token */
char tok; /* holds current token */

void main(void)
{
    Sp s;
    s = getsexpr();
    printf("s:             ");writesexpr(s);
    printf("(car s):       ");writesexpr(car(s));
    printf("(cdr s):       ");writesexpr(cdr(s));
    printf("(car (car s)): ");writesexpr(car(car(s)));
    printf("(car (cdr s)): ");writesexpr(car(cdr(s)));
    printf("(cdr (car s)): ");writesexpr(cdr(car(s)));
    printf("(cdr (cdr s)): ");writesexpr(cdr(cdr(s)));
}
/* getsexpr: fetch next S-expression */
Sp getsexpr (void)
{
    tok = gettoken();
    return(sexpr());
}
/* sexpr: recognize and return S-expression */
Sp sexpr (void)
{
    if (isalnum(tok))
        return(newalfatom(tok));
    if (tok == '(')
        return(tail());
    return(err(0));
}
/* tail: recognize tail end of S-expression */
Sp tail (void)
{
    Sp s, t;
    tok = gettoken();
    if (tok == ')') return(NULL);
    s = sexpr();
    t = tail();
    return(cons(s, t));
}
/* cons: tack two S-expressions together */
Sp cons (Sp s, Sp t)
{
    Sp r = (Sp) malloc(sizeof(Scell));
    r -> celltype = l;
    r -> lcell.first = s;
    r -> lcell.rest = t;
    return(r);
}
/* car: chase the first pointer of S-expr */
Sp car (Sp s)
{
    if (s == NULL) return(err(1));
    if (s -> celltype == l)
        return(s -> lcell.first);
    return(err(2));
}
/* cdr: chase second pointer of S-expr */
Sp cdr (Sp s)
{
    if (s == NULL) return(err(3));
    if (s -> celltype == l)
        return(s ->  lcell.rest);
    return(err(4));
}

/* newalfatom: create new alpha S-expr */
static Sp newalfatom (char alfa)
{
    Sp r = (Sp) malloc(sizeof(Scell));
    r -> celltype = a;
    r -> alf = alfa;
    return(r);
}
/* writesexpr: write an entire S-expr */
void writesexpr(Sp s)
{
    wsexpr(s); printf("\n");
}
/* wsexpr: write S-expr, calls tail */
static void wsexpr(Sp s)
{
    if (s == NULL) {
        printf("("); printf(")");
        return;
    }
    if (s -> celltype == a) {
        printf("%c", s -> alf);
        return;
    }
    printf("(");
    wtail(s);
}
/* wtail: write tail of S-expression */
static void wtail(Sp s)
{
    if (s == NULL) {
        printf(")");
        return;
    }
    wsexpr(car(s));
    printf(" ");
    wtail(cdr(s));
}
/* err: error message */
Sp err(int i)
{
    printf("[Error number: %d] ", i);
    return(NULL);
}
/* gettoken: fetch next token (a char) */
char gettoken(void) {
    char ch;
    while (isspace(ch = getchar()) &&
              ch != EOF)
        ;
    return ch;
}
four06% cc -o lparse lparse.c
four06% lparse
(a b c)
s:             (a b c )
(car s):       a
(cdr s):       (b c )
(car (car s)): [Error number: 2] ()
(car (cdr s)): b
(cdr (car s)): [Error number: 4] ()
(cdr (cdr s)): (c )
four06% lparse
( (a b) c (d (e f) g))
s:             ((a b ) c (d (e f ) g ) )
(car s):       (a b )
(cdr s):       (c (d (e f ) g ) )
(car (car s)): a
(car (cdr s)): c
(cdr (car s)): (b )
(cdr (cdr s)): ((d (e f ) g ) )
four06% lparse
()
s:             ()
(car s):       [Error number: 1] ()
(cdr s):       [Error number: 3] ()
(car (car s)): [Error number: 1] [Error number: 1] ()
(car (cdr s)): [Error number: 3] [Error number: 1] ()
(cdr (car s)): [Error number: 1] [Error number: 3] ()
(cdr (cdr s)): [Error number: 3] [Error number: 3] ()
four06% lparse
(((a) b (c) d) (e f) (g (h i) j))
s:             (((a ) b (c ) d ) (e f ) (g (h i ) j ) )
(car s):       ((a ) b (c ) d )
(cdr s):       ((e f ) (g (h i ) j ) )
(car (car s)): (a )
(car (cdr s)): (e f )
(cdr (car s)): (b (c ) d )
(cdr (cdr s)): ((g (h i ) j ) )