/*****************************************************************************\
*                                                                             *
* 				    MAIN.C                                    *
*                                                                             *
* 		 Exemple of an application built with klone:                  *
* 	       "klone" a small command-line interface to klone,               *
* 		       a toplevel read/eval/print loop                        *
*                                                                             *
\*****************************************************************************/

char *usage = "\n\
   klone        = interactive, pool, prompt, profile\n\
   klone -      = same (for no args under gdb)\n\
   klone t      = run tests in tests/test.kl nopool, noprompt, noprofile\n\
   klone T      = run tests in kl/t.kl nopool, nprompt, noprofile\n\
   klone s      = silent, pool, noprompt, profile\n\
   klone r      = no built-in inits, pool, prompt, profile\n\
   klone p      = no profile reading\n\
   klone q      = quiet, raw read of stdin as in file mode (no prompts)\n\
   klone file   = raw, do not use klone_pool & reads from file\n\
";

#ifndef KLONE_EXTENSIONS
#define KLONE_EXTENSIONS
#endif
#ifndef KLONE_ADDINIT
#define KLONE_ADDINIT
#endif

#define KlPROFILE_USER_VARIABLE "KLONEPROFILE"
#define KlPATH_SHELL_VARIABLE   "KLONEPATH"
#ifndef KLPATH
#ifndef AMIGA
#define KLPATH ".:kl:../klone/kl"
#else
#define KLPATH ":kl:/klone"
#endif
#endif

#include <signal.h>
#include <stdio.h>
#ifdef SYSV
#include <sys/types.h>
#endif                                  /* SYSV */
#include <sys/file.h>

#ifdef c_plus_plus
extern "C" {
#endif
#include "EXTERN.h"
#include "klone.h"
#include "kl_atom.h"
#include "kl_coll.h"
#include "kl_func.h"
#include "kl_list.h"
#include "kl_number.h"
#include "kl_string.h"
#include "kl_stream.h"
#ifdef c_plus_plus
}

#endif

#include "klone-ic.h"

DECLARE_strchr;

int noisy = 1;
char *input_file = 0;
int use_pool = 1;
int use_built_in = 1;
int script = 0;
int KlArgc;
char **KlArgv;
int toplevel();
int KlPoolToplevel();

main_init()
{
    KlActivePointerToIntMake("stack-level", &KlStackPtr);

    /*
     * execution the built-in klone code. made here to be done before the user
     * profile is read
     */
    if (use_built_in)
        KlExecuteStringNoReturn(KlStartupCode);

    /* make klone list of args */
    KlDeclareCommandLineArguments(KlArgc, KlArgv);
}


int toplevel();

main(argc, argv)
    int argc;
    char *argv[];

{
    char *s;
    extern char *KlFixPath();
    KlO result;
    int normal;
    int (*toplevel_evaluator)();

#ifdef MONITOR
    moncontrol(0);                      /* do not trace inits */
#endif /* MONITOR */
    KlMallocInit();

    KlUserProfileName = ".klonerc";
    KlTextExtension = ".kl";
    KlApplicationName = "klone";
    
    /* primitive option parsing */
    if (argc > 1) {
        noisy = 0;
        if (!strcmp(argv[1], "-")) {
            noisy = 1;
        } else if (!strcmp(argv[1], "t")) {
            KlUserProfileName = 0;
            input_file = "tests/test.kl";
            use_pool = 0;
        } else if (!strcmp(argv[1], "T")) {
            KlUserProfileName = 0;
            input_file = "kl/t.kl";
            use_pool = 0;
        } else if (!strcmp(argv[1], "s")) {
            ;
#ifdef MLEAK
        } else if (!strcmp(argv[1], "-ms") && argv[2]) { /* malloc stop */
            extern int MLEAK_num;

            MLEAK_num = atoi(argv[2]);
            noisy = 1;
#endif
        } else if (!strcmp(argv[1], "r")) {
            noisy = 1;
            use_built_in = 0;
            use_pool = 0;
        } else if (!strcmp(argv[1], "p")) {
	    KlUserProfileName = 0;
        } else if (!strcmp(argv[1], "-?")) {
            puts(usage);
	    exit(1);
	} else {
	    input_file = strcmp(argv[1], "q") ? argv[1] : 0;
	    script = 1;
	    KlUserProfileName = 0;
	    use_pool = 0;
	}
    }
    /* initialize paths (put .:$HOME before built-ins) */
    KlPath = KLPATH;
    if ((s = (char *) getenv(KlPROFILE_USER_VARIABLE)) && (s[0] != '\0'))
	KlUserProfileName = s;
    if ((s = (char *) getenv(KlPATH_SHELL_VARIABLE)) && (s[0] != '\0'))
	KlPath = s;

    /* set up command line arguments */
    KlArgc = argc - script;
    KlArgv = argv + script;

    /* first, initialize klone */
    KlDeclareExtension("main", 0, 0, main_init);
    KLONE_EXTENSIONS;			/* inserted at compile-time */
    KlInit();
    KLONE_ADDINIT;			/* inserted at compile-time */

    /* print version number */
    if (noisy)
	KlPrintBanner();

    /* handle the special case of a script given as argument */
    if (input_file) {
	FILE *fd;

	if (fd = fopen(input_file, "r")) {
	    KlStdyyRedirect(KlStreamMake(fd, 1, input_file));
	} else {
	    fprintf(stderr, "Cannot open %s\n", input_file);
	    exit(1);
	}
    }
    /* define a catch-all point */
    KlSetNonCaughtErrorPoint(1);	/* = 0 for set */

    /* check if we closed stdout. in this case, abort */
    if (noisy && !KlStdout->direction)
	KlExit(0);

    if (use_pool)
	toplevel_evaluator = KlPoolToplevel; /* normal mainloop */
    else
	toplevel_evaluator = toplevel;

#ifdef KLPROFILER
    {
	char *dsm = (char *) getenv("DONT_START_MONCONTROL");
	if (!dsm || *dsm == '\0') {
	    KlMonControlled = 1;
	    moncontrol(1);			/* starts monitor after inits */
	}
    }
#endif
    for (;;) {
	KlCatch(KlA_ERROR, CFAPPLY(toplevel_evaluator, ()), result, normal);
	/* aborts if error in scripts */
	if (script && !KlContinueReadingOnError)
	    KlExit(1);
	/* check if we closed stdout. in this case, abort */
	if (noisy && !KlStdout->direction)
	    KlExit(0);
    }
}

/* simplified mainloop for some tests without any processing overhead
 * normal apps should use KlPoolToplevel instead
 */

int
toplevel()
{
    /* main routine: read/eval/print */
    KlGCMark();
    KlO PreviousExpr, result;
    if (!KlRead()) goto end_empty;
    PreviousExpr = KlReadExpr;
    while (KlRead()) {
	if (KlReadExpr == (KlO) KlA_equal && KlInfixAssigns) {
	    /* x = y, create assign */
	    if (!(KlRead()))	/* x = EOF */
		goto end;
	    PreviousExpr = (KlO)KlAssignMake(PreviousExpr, KlReadExpr);
	} else {			/* normal */
	    if ((result = KlSend_eval(PreviousExpr)) && noisy) {
		KlPuts(" = "); KlToplevelPrint(result); KlPutchar('\n');
		KlFlush(0);
	    }
	    PreviousExpr = KlReadExpr;
	}
    }
end:
    if ((result = KlSend_eval(PreviousExpr)) && noisy) {
	KlPuts(" = "); KlToplevelPrint(result); KlPutchar('\n');
	KlFlush(0);
    }
end_empty:
    KlGC();
    KlExit(0);
}

KlPrintBanner()
{
    printf("KLONE toplevel %s\n", KlVersionNumber);
}


syntax highlighted by Code2HTML, v. 0.9.1