gscheme/scheme.y

%{
#import "SchemeTypes.h"

#define YYSTYPE id

YYSTYPE yyresult;
int yyinputitem;
id yyresultform;

extern int yysofar;
extern NSMutableArray *positionStack;
%}

%token LPAREN
%token LVECTPAREN
%token RPAREN

%token DEFINE
%token SET
%token LAMBDA

%token BEGINTOK

%token AND
%token OR

%token CASE
%token COND
%token ELSE
%token ARROW

%token CALLCC

%token APPLY

%token IF

%token LET
%token LETSTAR
%token LETREC

%token DOT

%token INTEGER
%token CHAR
%token BOOLEAN
%token DOUBLE
%token SYMBOL
%token STRING

%token QUOTECHAR
%token QUOTE

%% 

top: /* empty */ {
    $$ = [NSNull null];
    yyresultform = $$;
}
| topitem top {
    $$ = [Triple newTag:FORM_TOP Arg1:$1 Arg2:$2];
    yyresultform = $$;
    
    yyinputitem++;
}
;

topitem: LPAREN DEFINE SYMBOL form RPAREN {
    NSValue *entry = 
        [NSValue valueWithRange:NSMakeRange(yysofar, 0)];

    $$ = [Triple newTag:FORM_DEFINE1 Arg1:$3 Arg2:$4];

    [[positionStack lastObject] addObject:entry];
}
|  LPAREN DEFINE nonemptysymlist sequence RPAREN { 
    NSValue *entry = 
        [NSValue valueWithRange:NSMakeRange(yysofar, 0)];

    $$ = [Triple newTag:FORM_DEFINE2 Arg1:$3 Arg2:$4];

    [[positionStack lastObject] addObject:entry];
} 
|  form {
    NSValue *entry = 
        [NSValue valueWithRange:NSMakeRange(yysofar, 0)];

    $$ = $1;

    [[positionStack lastObject] addObject:entry];
}
;

sequence: form {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| form sequence {
    $$ = [Pair newCar:$1 Cdr:$2];
}
;

revsequence: form {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| revsequence form {
    $$ = [Pair newCar:$2 Cdr:$1];
}
;

qform: INTEGER {
    $$ = $1;
}
| CHAR {
    $$ = $1;
}
| BOOLEAN {
    $$ = $1;
}
| DOUBLE {
    $$ = $1;
}
| SYMBOL {
    $$ = $1;
}
| STRING {
    $$ = $1;
}
| qlist {
    $$ = $1;
}
| qvector {
    $$ = $1;
}
| QUOTECHAR qform {
    $$ = [Pair newCar:[[Symbol alloc] initSCMSymbol:"quote"]
	       Cdr:[Pair newCar:$2 Cdr:[NSNull null]]];
}
| ARROW {
    $$ = [[Symbol alloc] initSCMSymbol:"=>"];
}
| QUOTE {
    $$ = [[Symbol alloc] initSCMSymbol:"quote"];
}
| CALLCC {
    $$ = [[Symbol alloc] initSCMSymbol:"call-with-current-continuation"];
}
| APPLY {
    $$ = [[Symbol alloc] initSCMSymbol:"apply"];
}
| DEFINE {
    $$ = [[Symbol alloc] initSCMSymbol:"define"];
}
| SET {
    $$ = [[Symbol alloc] initSCMSymbol:"set!"];
}
| LAMBDA {
    $$ = [[Symbol alloc] initSCMSymbol:"lambda"];
}
| IF {
    $$ = [[Symbol alloc] initSCMSymbol:"if"];
}
| BEGINTOK {
    $$ = [[Symbol alloc] initSCMSymbol:"begin"];
}
| AND {
    $$ = [[Symbol alloc] initSCMSymbol:"and"];
}
| OR {
    $$ = [[Symbol alloc] initSCMSymbol:"or"];
}
| CASE {
    $$ = [[Symbol alloc] initSCMSymbol:"case"];
}
| COND {
    $$ = [[Symbol alloc] initSCMSymbol:"cond"];
}
| ELSE {
    $$ = [[Symbol alloc] initSCMSymbol:"else"];
}
| LET {
    $$ = [[Symbol alloc] initSCMSymbol:"let"];
}
| LETSTAR {
    $$ = [[Symbol alloc] initSCMSymbol:"let*"];
}
| LETREC {
    $$ = [[Symbol alloc] initSCMSymbol:"letrec"];
}
;

form: INTEGER {
    $$ = $1;
}
| CHAR {
    $$ = $1;
}
| BOOLEAN {
    $$ = $1;
}
| DOUBLE {
    $$ = $1;
}
| SYMBOL {
    $$ = $1;
}
| STRING {
    $$ = $1;
}
| list {
    $$ = $1;
}
| vector {
    $$ = $1;
}
| lambda {
    $$ = $1;
}
| if {
    $$ = $1;
}
| let {
    $$ = $1;
}
| letstar {
    $$ = $1;
}
| letrec {
    $$ = $1;
}
| quote {
    $$ = $1;
}
| apply {
    $$ = $1;
}
| set {
    $$ = $1;
}
| begin {
    $$ = $1;
}
| and {
    $$ = $1;
}
| or {
    $$ = $1;
}
| case {
    $$ = $1;
}
| cond {
    $$ = $1;
}
| callcc {
    $$ = $1;
}
;

callcc: LPAREN CALLCC form RPAREN {
    $$ = [Triple newTag:FORM_CALLCC Arg1:$3];
}
;

singlecase: LPAREN LPAREN sequence RPAREN sequence RPAREN {
    $$ = [Pair newCar:$3 Cdr:$5];
}
;

singlecond: LPAREN form RPAREN {
    $$ = [Triple newTag:FORM_SCOND1 Arg1:$2];
}
| LPAREN form sequence RPAREN {
    $$ = [Triple newTag:FORM_SCOND2 Arg1:$2 Arg2:$3];
}
| LPAREN form ARROW form RPAREN {
    $$ = [Triple newTag:FORM_SCOND3 Arg1:$2 Arg2:$4];
}
;

elsecasecond:  LPAREN ELSE sequence RPAREN {
    $$ = [Pair newCar:[NSNull null] Cdr:$3];
}
;

cases: singlecase {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| cases singlecase {
    $$ = [Pair newCar:$2 Cdr:$1];
}
;

conditions: singlecond {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| conditions singlecond {
    $$ = [Pair newCar:$2 Cdr:$1];
}
;

case: LPAREN CASE form cases RPAREN {
    $$ = [Triple newTag:FORM_CASE Arg1:$3 Arg2:$4];
}
|  LPAREN CASE form cases elsecasecond RPAREN {
    $$ = [Triple newTag:FORM_CASE Arg1:$3 
                 Arg2:[Pair newCar:$5 Cdr:$4]];
}
;

cond: LPAREN COND conditions RPAREN {
    $$ = [Triple newTag:FORM_COND Arg1:$3];
}
|  LPAREN COND conditions elsecasecond RPAREN {
    $$ = [Triple newTag:FORM_COND Arg1:[Pair newCar:$4 Cdr:$3]];
}
;

and: LPAREN AND revsequence RPAREN { 
    $$ = [Triple newTag:FORM_AND Arg1:$3];
}
| LPAREN AND RPAREN { 
    $$ = [Triple newTag:FORM_AND Arg1:[NSNull null]];
}
;

or: LPAREN OR revsequence RPAREN { 
    $$ = [Triple newTag:FORM_OR Arg1:$3];
}
| LPAREN OR RPAREN { 
    $$ = [Triple newTag:FORM_OR Arg1:[NSNull null]];
}
;

begin: LPAREN BEGINTOK sequence RPAREN { 
    $$ = [Triple newTag:FORM_BEGIN Arg1:$3];
}
;

set: LPAREN SET SYMBOL form RPAREN { 
    $$ = [Triple newTag:FORM_SET Arg1:$3 Arg2:$4];
}
;

apply: LPAREN APPLY form form RPAREN {
    $$ = [Triple newTag:FORM_APPLY Arg1:$3 Arg2:$4];
}
;

if: LPAREN IF form form RPAREN {
    $$ = [Triple newTag:FORM_IF1 Arg1:$3 Arg2:$4];
}
| LPAREN IF form form form RPAREN {
    $$ = [Triple newTag:FORM_IF2 Arg1:$3 Arg2:$4 Arg3:$5];
} 
;

lambda: LPAREN LAMBDA SYMBOL sequence RPAREN {
    $$ = [Triple newTag:FORM_LAMBDA1 Arg1:$3 Arg2:$4];
}
| LPAREN LAMBDA symlist sequence RPAREN {
    $$ = [Triple newTag:FORM_LAMBDA2 Arg1:$3 Arg2:$4];
} 
;

quote: QUOTECHAR qform {
    $$ = [Triple newTag:FORM_QUOTE Arg1:$2];
}
| LPAREN QUOTE qform RPAREN {
    $$ = [Triple newTag:FORM_QUOTE Arg1:$3];
}
;

singlebinding: LPAREN SYMBOL form RPAREN {
    $$ = [Triple newTag:FORM_BINDING Arg1:$2 Arg2:$3];
}
;

listofbindings: singlebinding {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| singlebinding listofbindings {
    $$ = [Pair newCar:$1 Cdr:$2];
}
;

let: LPAREN LET LPAREN listofbindings RPAREN sequence RPAREN {
    $$ = [Triple newTag:FORM_LET Arg1:$4 Arg2:$6];
}
;

letstar: LPAREN LETSTAR LPAREN listofbindings RPAREN sequence RPAREN {
    $$ = [Triple newTag:FORM_LETSTAR Arg1:$4 Arg2:$6];
}
;

letrec: LPAREN LETREC LPAREN listofbindings RPAREN sequence RPAREN {
    $$ = [Triple newTag:FORM_LETREC Arg1:$4 Arg2:$6];
}
;

emptylist: LPAREN RPAREN { 
    $$ = [NSNull null];
}
;

nonemptylistdata:  form {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| form DOT form {
    $$ = [Pair newCar:$1 Cdr:$3];
}
| form nonemptylistdata {
    $$ = [Pair newCar:$1 Cdr:$2];
}
;

qnonemptylistdata:  qform {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| qform DOT qform {
    $$ = [Pair newCar:$1 Cdr:$3];
}
| qform qnonemptylistdata {
    $$ = [Pair newCar:$1 Cdr:$2];
}
;

nonemptyvectdata:  form {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| form nonemptyvectdata {
    $$ = [Pair newCar:$1 Cdr:$2];
}
;

qnonemptyvectdata:  qform {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| qform qnonemptyvectdata {
    $$ = [Pair newCar:$1 Cdr:$2];
}
;

nonemptylist: LPAREN nonemptylistdata RPAREN {
    $$ = $2;
}
;

qnonemptylist: LPAREN qnonemptylistdata RPAREN {
    $$ = $2;
}
;

list: nonemptylist {
    $$ = $1;
}
| emptylist {
    $$ = $1;
}
;

qlist: qnonemptylist {
    $$ = $1;
}
| emptylist {
    $$ = $1;
}
;

vector: LVECTPAREN nonemptyvectdata RPAREN {
    $$ = [Vector newFromList:$2];
}
| LVECTPAREN RPAREN {
    $$ = [Vector newFromList:(Pair *)[NSNull null]];
}
;

qvector: LVECTPAREN qnonemptyvectdata RPAREN {
    $$ = [Vector newFromList:$2];
}
| LVECTPAREN RPAREN {
    $$ = [Vector newFromList:(Pair *)[NSNull null]];
}
;

nonemptysymlistdata: SYMBOL {
    $$ = [Pair newCar:$1 Cdr:[NSNull null]];
}
| SYMBOL DOT SYMBOL {
    $$ = [Pair newCar:$1 Cdr:$3];
}
| SYMBOL nonemptysymlistdata {
    $$ = [Pair newCar:$1 Cdr:$2];
}
;

nonemptysymlist: LPAREN nonemptysymlistdata RPAREN {
    $$ = $2;
}
;

symlist: nonemptysymlist {
    $$ = $1;
}
| emptylist {
    $$ = $1;
}
;

%%