デカルト言語 - 並列ロジック プログラミング言語

#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include <stdlib.h>
#include <iostream>
#include <fstream>
#include <string>
#include <vector>
#include <map>
using namespace std;
#include "nwcc.h"
#include "nwcclex.h"






#include "config.h"

#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <string.h>
#include <stdarg.h>
#include <sys/time.h>
#include <libgen.h>
#include <setjmp.h>
#include <getopt.h>
#include <signal.h>

#include <complex>

#include "syserr.h"

#include "bin_node.h"
#include "gc.h"
#include "var.h"
#include "pred.h"
#include "module.h"
#include "context.h"
#include "unify.h"
#include "builtin.h"
#include "sysmodule.h"
#include "winsock2util.h"

const char *VERSION = "0.27.0";
void
optver ()
{
  extern std::string code;
  printf ("Descartes %s\t(code:%s) \n", VERSION, code.c_str ());
  printf ("Copyright (C) 2009 - 2013 Hideyuki Niwa\n\n");
}

#define STARTRC "dstartrc"

extern int pllexSpace (int c);
extern int pllexCkSpace (int c);

char TOKEN[TOKEN_LEN];
int tokenPt = 0;
int Char;

int ErrorFlg = 0;
FILE *RdFp, *pr;
const char *MESG = NULL;

int EndFlg = 0;

int resultflg = 1;

void
opthelp ()
{
  printf ("usage: descartes [OPTION...] [FILE]\n");
  printf ("\n");
  printf (" -?, --help\tShow this help message\n");
  printf (" -v, --version\tprint the version of descartes being used\n");
  printf ("\n");
  printf (" -u, --utf8\tUTF8 code is used\n");
  printf (" -e, --euc\tEUC code is used\n");
  printf (" -s, --sjis\tSJIS code is used\n");
  printf ("\n");
  printf (" -t, --trace\ttrace becomes effective\n");
  printf (" -r, --result\tresult is not displayed\n");
  printf ("\n");
}

int sigint_flag = 0;
void
sigint_handler_catch_sigint (int signum)
{
  sigint_flag = 1;
}

void
sigint_handler_cmdline (int signum)
{
  int i;
  char buf[80];
  int c;

  printf ("\nquit ? [y or n] ");
  if (fgets (buf, 80 - 1, stdin) == NULL)
    {
      return;
    }

  for (i = 0; i < 80; i++)
    {
      c = buf[i];
      if (c == ' ')
	{
	  continue;
	}
      else if ((c == 'y') || (c == 'Y'))
	{
	  exit (0);
	}
      else
	{
	  break;
	}
    }
}

#ifdef __MINGW32__
void
set_sigint_handler_catch_sigint ()
{
  signal (SIGINT, sigint_handler_catch_sigint);
}

void
set_sigint_handler_cmdline ()
{
  signal (SIGINT, sigint_handler_cmdline);
}

void
reset_sigint_handler ()
{
  signal (SIGINT, SIG_DFL);
}

#else
struct sigaction sigint_action;
struct sigaction save_sigint_action;

void
set_sigint_handler_catch_sigint ()
{
  sigint_action.sa_handler = sigint_handler_catch_sigint;
  sigemptyset (&(sigint_action.sa_mask));
  sigint_action.sa_flags = 0;
  sigaction (SIGINT, &sigint_action, &save_sigint_action);
}

void
set_sigint_handler_cmdline ()
{
  sigint_action.sa_handler = sigint_handler_cmdline;
  sigemptyset (&(sigint_action.sa_mask));
  sigint_action.sa_flags = 0;
  sigaction (SIGINT, &sigint_action, &save_sigint_action);
}

void
reset_sigint_handler ()
{
  sigaction (SIGINT, &save_sigint_action, NULL);
}

#endif

int pargc;
char **pargv;

int
main (int argc, char **argv)
{
  int c, i;

  extern std::string code;

  extern char *optarg;
  extern int optind, opterr, optopt;

  int optc;
  int digit_optind = 0;

  static struct option long_options[] = {
    {"help", 0, 0, 'h'},
    {"?", 0, 0, 'h'},
    {"version", 0, 0, 'v'},
    {"utf8", 0, 0, 'u'},
    {"euc", 0, 0, 'e'},
    {"sjis", 0, 0, 's'},
    {"trace", 0, 0, 't'},
    {"result", 0, 0, 'r'},
    {0, 0, 0, 0}
  };

  extern Atom AllNodesBody;
  AllNodesBody.nextnode = NULL;
  AllNodes = &AllNodesBody;
  extern List *Module;
  Module = (List *) Nil->Cons (Nil);


#ifdef __CYGWIN__
  code = "UTF8";
#endif

  while (1)
    {
      int this_option_optind = optind ? optind : 1;
      int option_index = 0;

      optc = getopt_long (argc, argv, "h?vuestr",
			  long_options, &option_index);
      if (optc == -1)
	{
	  break;
	}

      switch (optc)
	{
	case 'h':
	  opthelp ();
	  exit (0);
	  break;
	case 'v':
	  optver ();
	  exit (0);
	  break;
	case 'u':
	  code = "UTF8";
	  break;
	case 'e':
	  code = "EUC";
	  break;
	case 's':
	  code = "SJIS";
	  break;
	case 't':
	  Tron ();
	  break;
	case 'r':
	  resultflg = 0;
	  break;
	default:
	  opthelp ();
	  exit (0);
	  break;
	}
    }

#ifdef __MINGW32__
  winsock2init ();
#endif

#ifdef __CYGWIN__
  char inputrcpath[MAXPATHLEN + 10];

  char *homepath = getenv ("HOME");
  strncpy (inputrcpath, homepath, MAXPATHLEN);
  strcat (inputrcpath, "/inputrc");
  setenv ("INPUTRC", inputrcpath, 0);
#endif

#ifdef __MINGW32__
  extern std::string code;

#ifdef MINGW_UTF8
  code = "UTF8";
#else
  code = "SJIS";
#endif

  struct timeval tv;
  gettimeofday (&tv, NULL);
  extern struct timeval gctv_last;
  gettimeofday (&gctv_last, NULL);
  extern struct timeval gctv_long_last;
  gettimeofday (&gctv_long_last, NULL);

  srand (tv.tv_usec);
#else
  struct timeval tv;
  gettimeofday (&tv, NULL);
  extern struct timeval gctv_last;
  gettimeofday (&gctv_last, NULL);
  extern struct timeval gctv_long_last;
  gettimeofday (&gctv_long_last, NULL);

  srandom (tv.tv_usec);
#endif

  extern void StackBase ();
  StackBase ();

  GetLibPath ();
  GetTmpPath ();
  GetEditorPath ();

#if 0
  Context *cx = new Context (Module);
  IncludeSub (cx, Nil, Module, "sys");
  delete cx;
#endif

  int startrcflag = 0;
  char *argstr = NULL;
  FILE *startrcfd = fopen (STARTRC, "rb");
  if (startrcfd == NULL)
    {
      startrcflag = 0;
    }
  else
    {
      startrcflag = 1;
      fclose (startrcfd);
    }

  if (!startrcflag && (argc <= optind))
    {
      DResultFlag = 1;

      optver ();

      set_sigint_handler_cmdline ();

      GetlineEval ();

#ifdef __MINGW32__
      winsock2end ();
#endif

      exit (0);

    }
  else
    {
      if (argc > optind)
	{
	  startrcflag = 0;
	}

      char *dargv1;
      char *bargv1;

      if (startrcflag)
	{
	  argstr = (char *) STARTRC;
	  dargv1 = strdup (STARTRC);
	  bargv1 = strdup (STARTRC);
	}
      else
	{
	  argstr = argv[optind];
	  dargv1 = strdup (argv[optind]);
	  bargv1 = strdup (argv[optind]);
	}

      char *dname = dirname (dargv1);
      char *bname = basename (bargv1);
      free (dargv1);
      free (bargv1);

      if ((dname[0] == '.') && (dname[1] == 0) && ((argstr)[1] != '/'))
	{
	  Node *nd;
	  RdFp = NULL;

	  if (dlibpathnode == Nil)
	    {
	      RdFp = fopen (argstr, "rb");
	    }
	  else
	    {
	      for (nd = dlibpathnode; nd != Nil; nd = nd->Cdr ())
		{
		  std::string s = "";

		  if (nd->Car ()->kind () != ATOM)
		    {
		      continue;
		    }

		  ((Atom *) (nd->Car ()))->toString (s);
		  s = s + "/" + argstr;

		  RdFp = fopen (s.c_str (), "rb");
		  if (RdFp != NULL)
		    {
		      break;
		    }
		}
	    }
	}
      else
	{
	  RdFp = fopen (argstr, "rb");
	}

      if (RdFp == NULL)
	{
	  fprintf (stderr, "can not open File : %s \n", argstr);
	  return 0;
	}

      pargc = argc - optind + 1;
      pargv = &argv[optind - 1];

      NwccMain ();

      if (RdFp == NULL)
	{
	  fclose (RdFp);
	  RdFp = NULL;
	}


#ifdef __MINGW32__
      winsock2end ();
#endif

      exit (0);
    }
#ifdef __MINGW32__
  winsock2end ();
#endif
  exit (0);
}



long
FilePointSave ()
{
  return ftell (RdFp);
}

void
FilePointResume (long tellpt)
{
  fseek (RdFp, tellpt, 0);
}


int qt_flag = 0;

void
SkipComment (int &Char)
{
  int c;

  if (Char == EOF)
    {
      return;
    }

  if (qt_flag)
    {
      return;
    }

  for (;;)
    {
      if (Char == EOF)
	{
	  break;
	}

      if (Char == '#')
	{
	  c = fgetc (RdFp);
	  if (c == EOF)
	    {
	      break;
	    }
	  if (c == '!')
	    {
	      for (;;)
		{
		  c = fgetc (RdFp);
		  if (c == EOF)
		    {
		      break;
		    }
		  if (c == '\n')
		    {
		      break;
		    }
		}
	      Char = fgetc (RdFp);
	    }
	  else
	    {
	      ungetc (c, RdFp);
	      return;
	    }
	}
      else if (Char == '/')
	{
	  c = fgetc (RdFp);
	  if (c == EOF)
	    {
	      break;
	    }
	  if (c == '/')
	    {
	      for (;;)
		{
		  c = fgetc (RdFp);
		  if (c == EOF)
		    {
		      break;
		    }
		  if (c == '\n')
		    {
		      break;
		    }
		}
	      Char = fgetc (RdFp);
	    }
	  else if (c == '*')
	    {
	      for (;;)
		{
		  c = fgetc (RdFp);
		  if (c == EOF)
		    {
		      break;
		    }
		  if (c == '*')
		    {
		      c = fgetc (RdFp);
		      if (c == EOF)
			{
			  break;
			}
		      if (c == '/')
			{
			  break;
			}
		      else
			{
			  ungetc (c, RdFp);
			}
		    }
		  else if (c == '/')
		    {
		      if ((c = fgetc (RdFp)) == '*')
			{
			  ungetc ('*', RdFp);
			  Char = '/';
			  SkipComment (Char);
			}
		      if (c == EOF)
			{
			  break;
			}
		    }
		}
	      Char = fgetc (RdFp);
	    }
	  else
	    {
	      ungetc (c, RdFp);
	      break;
	    }
	}
      else
	{
	  return;
	}
    }
}

int
GetChar ()
{
  Char = fgetc (RdFp);

  SkipComment (Char);

  return Char;
}

void
UnGetChar (int c)
{
  ungetc (c, RdFp);
}

void
PutChar (int Char)
{
  if (fputc (Char, pr) == EOF)
    {
      ErrorStop ("can't write file ");
    }
}


void
SkipSpace ()
{
  int c;

  do
    {
      c = GetChar ();
    }
  while (pllexSpace (c));
  UnGetChar (c);

}

int
CHECK (const char *Pt)
{
  long TelSav;
  int r;

  TelSav = FilePointSave ();
  r = COMP (Pt);
  FilePointResume (TelSav);
  return r;
}


int
NotSkipSpCOMP (const char *Pt)
{
  long TelSav;
  int c;

  TelSav = FilePointSave ();

  c = GetChar ();
  if ((char) c != *Pt)
    {
      FilePointResume (TelSav);
      return -1;
    }
  Pt++;
  while (*Pt)
    {
      c = GetChar ();
      if ((char) Char != *Pt)
	{
	  FilePointResume (TelSav);
	  return -1;
	}
      Pt++;
    }
  return 0;
}

int
COMP (const char *Pt)
{
  long TelSav;
  int r, c;

  TelSav = FilePointSave ();

  SkipSpace ();

  r = NotSkipSpCOMP (Pt);

  if (r != 0)
    {
      FilePointResume (TelSav);
      return r;
    }
  else
    {
      fseek (RdFp, ftell (RdFp) - 1, 0);
      if (!isalpha (GetChar ()))
	{
	  return 0;
	}

      c = GetChar ();
      UnGetChar (c);

      if (isalpha (c) || (c == '_'))
	{
	  FilePointResume (TelSav);
	  return -1;
	}

      return 0;
    }
}

int
LineNumber ()
{
  int LineNo = 1;
  long TelSav;
  int c;

  TelSav = FilePointSave ();
  rewind (RdFp);
  while (TelSav != FilePointSave ())
    {
      c = fgetc (RdFp);
      if (c == '\n')
	{
	  LineNo++;
	}
      if (c == EOF)
	break;
    }
  FilePointResume (TelSav);
  return LineNo;
}

static char errorbuf[1024];
int ErrorStopFlag = 0;

void
ErrorStop (const char *fmt, ...)
{
  va_list argptr;
  int LineNo = 1;
  long TelSav;

  if (ErrorStopFlag)
    {
      return;
    }

  LineNo = LineNumber ();

  errorbuf[0] = '\0';

  va_start (argptr, fmt);
  vsprintf (errorbuf, fmt, argptr);
  va_end (argptr);

  if (strlen (errorbuf) == 0)
    {
      strncpy (errorbuf, "Syntax Error ", 1023);
    }

  fprintf (stderr, "# %d : error... %s\n", LineNo, errorbuf);

  ErrorFlg = -1;
  ErrorStopFlag = 1;

  extern jmp_buf program_jb;

  longjmp (program_jb, -1);

  exit (-1);
}

void
UNTIL (const char *s)
{
  const char *Pt;
  int c;
  int matchFlg = 0;
  long tellsave;

  while (matchFlg == 0)
    {
      Pt = s;
      while ((char) (c = GetChar ()) != *Pt)
	{
	  PutChar (c);
	}

      matchFlg = 1;
      Pt++;

      tellsave = FilePointSave () - 1;
      while (*Pt)
	{
	  c = GetChar ();
	  if ((char) c != *Pt)
	    {
	      FilePointResume (tellsave);
	      c = GetChar ();
	      PutChar (c);
	      matchFlg = 0;
	      break;
	    }
	  Pt++;
	}
    }
}

void
SKIP (const char *s)
{
  const char *Pt;
  int c;
  int matchFlg = 0;

  while (matchFlg == 0)
    {
      Pt = s;
      while ((char) (c = GetChar ()) != *Pt)
	;

      matchFlg = 1;
      Pt++;
      while (*Pt)
	{
	  c = GetChar ();
	  if ((char) c != *Pt)
	    {
	      matchFlg = 0;
	      break;
	    }
	  Pt++;
	}
    }
}


int
NotSkipSpNOT (const char *s)
{
  long TelSav;
  int rc;

  TelSav = FilePointSave ();
  rc = !NotSkipSpCOMP (s);
  FilePointResume (TelSav);
  return rc;
}

int
NOT (const char *s)
{
  long TelSav;
  int rc;

  TelSav = FilePointSave ();
  rc = !COMP (s);
  FilePointResume (TelSav);
  return rc;
}

int
C ()
{
  Char = GetChar ();

  return 0;
}


int
Eof ()
{
  int c;

  do
    {
      c = fgetc (RdFp);
      if (c == EOF)
	{
	  return 0;
	}
    }
  while (pllexSpace (c));
  ungetc (c, RdFp);

  return -1;
}

int
NotEof ()
{
  int c;

  do
    {
      c = fgetc (RdFp);
      if (c == EOF)
	{
	  return -1;
	}
    }
  while (pllexSpace (c));
  ungetc (c, RdFp);

  return 0;
}


int
N ()
{
  C ();

  if (!isdigit (Char))
    {
      UnGetChar (Char);
      return -1;
    }

  return 0;
}

int
A ()
{
  C ();

  if (!isalpha (Char) && (Char != '_'))
    {
      UnGetChar (Char);
      return -1;
    }

  return 0;
}

int
AN ()
{
  C ();

  switch (Char)
    {
    case '_':
      return -1;
    }

  if (!isalnum (Char))
    {
      return 0;
    }

  UnGetChar (Char);
  return -1;
}

int
SPACE ()
{
  C ();

  if (!pllexSpace (Char))
    {
      UnGetChar (Char);
      return -1;
    }

  return 0;
}

void
SetToken (int c)
{
  if (tokenPt >= TOKEN_LEN - 3)
    {
      ErrorStop ("Too long token ");
    }

  if (c & 0xff00)
    {
      TOKEN[tokenPt] = (c >> 8);
      tokenPt++;
      TOKEN[tokenPt] = (c & 0xff);
      tokenPt++;
    }
  else
    {
      TOKEN[tokenPt] = c;
      tokenPt++;
    }
}




int
FNUM ()
{
  int dot = 0;

  SkipSpace ();

  tokenPt = 0;

  C ();
  if ((!isdigit (Char)) && (Char != '.'))
    {
      UnGetChar (Char);
      return -1;
    }
  if (Char == '.')
    {
      dot++;
    }
  SetToken (Char);

  for (;;)
    {
      C ();
      if (Char == '.')
	{
	  if (dot)
	    {
	      UnGetChar (Char);
	      return -1;
	    }
	  dot++;
	  SetToken (Char);
	}
      else if ((Char == 'e') || (Char == 'E'))
	{
	  SetToken (Char);
	  C ();
	  if ((Char == '+') || (Char == '-'))
	    {
	      SetToken (Char);
	      for (;;)
		{
		  C ();
		  if (!isdigit (Char))
		    {
		      UnGetChar (Char);
		      SetToken ('\0');
		      return 0;
		    }
		  SetToken (Char);
		}
	    }
	  else
	    {
	      UnGetChar (Char);
	      return -1;
	    }
	}
      else if (!isdigit (Char))
	{
	  UnGetChar (Char);
	  SetToken ('\0');
	  return 0;
	}
      else
	{
	  SetToken (Char);
	}
    }

  return 0;
}

int
STRINGS ()
{
  char qt;

  SkipSpace ();

  tokenPt = 0;

  C ();
  if ((Char != '\"') && (Char != '\''))
    {
      UnGetChar (Char);
      return -1;
    }
  qt = Char;

  qt_flag = 1;

  for (;;)
    {
      C ();
      if (Char == qt)
	{
	  SetToken (0);
	  qt_flag = 0;
	  return 0;
	}
      else
	{
	  SetToken (Char);
	}
    }

  SetToken (0);

  qt_flag = 0;
  return -1;
}




int
ANY ()
{
  ErrorFlg = 0;
  MESG = NULL;
  do
    {
      long chktell1, chktell2;
      chktell1 = FilePointSave ();
      int AN ();
      ErrorFlg = AN ();
      MESG = "AN is missing ";
      if (ErrorFlg)
	{
	}
      if (!ErrorFlg)
	{
	}
      chktell2 = FilePointSave ();
      if ((chktell1 == chktell2) && !ErrorFlg)
	ErrorStop ("endless loop occured");
    }
  while (!ErrorFlg);
  ErrorFlg = 0;
  MESG = NULL;
  if (!ErrorFlg)
    {
    }
  return ErrorFlg;
}

int
WRD ()
{
  {
    long tellsave;
    tokenPt = 0;
    tellsave = FilePointSave ();
    SkipSpace ();

    ErrorFlg = 0;
    MESG = NULL;
    int AN ();
    ErrorFlg = AN ();
    MESG = "AN is missing ";
    if (ErrorFlg)
      {
	{
	  FilePointResume (tellsave);
	}
      }
    if (!ErrorFlg)
      {
	SetToken (Char);
	do
	  {
	    long chktell1, chktell2;
	    chktell1 = FilePointSave ();
	    int AN ();
	    ErrorFlg = AN ();
	    MESG = "AN is missing ";
	    if (ErrorFlg)
	      {
	      }
	    if (!ErrorFlg)
	      {
		SetToken (Char);
	      }
	    chktell2 = FilePointSave ();
	    if ((chktell1 == chktell2) && !ErrorFlg)
	      ErrorStop ("endless loop occured");
	  }
	while (!ErrorFlg);
	ErrorFlg = 0;
	MESG = NULL;
	if (ErrorFlg)
	  ErrorStop (MESG);

	SetToken ('\0');
      }

  }
  return ErrorFlg;
}

int
NUM ()
{
  {
    long tellsave;
    tokenPt = 0;
    tellsave = FilePointSave ();
    SkipSpace ();
    ErrorFlg = 0;
    MESG = NULL;
    int N ();
    ErrorFlg = N ();
    MESG = "N is missing ";
    if (ErrorFlg)
      {
	{
	  FilePointResume (tellsave);
	}
      }
    if (!ErrorFlg)
      {
	SetToken (Char);
	do
	  {
	    long chktell1, chktell2;
	    chktell1 = FilePointSave ();
	    int N ();
	    ErrorFlg = N ();
	    MESG = "N is missing ";
	    if (ErrorFlg)
	      {
	      }
	    if (!ErrorFlg)
	      {
		SetToken (Char);
	      }
	    chktell2 = FilePointSave ();
	    if ((chktell1 == chktell2) && !ErrorFlg)
	      ErrorStop ("endless loop occured");
	  }
	while (!ErrorFlg);
	ErrorFlg = 0;
	MESG = NULL;
	if (ErrorFlg)
	  ErrorStop (MESG);
	SetToken ('\0');

      }

  }
  return ErrorFlg;
}

int
ID ()
{
  {
    long tellsave;
    tokenPt = 0;
    tellsave = FilePointSave ();
    SkipSpace ();
    ErrorFlg = 0;
    MESG = NULL;
    int A ();
    ErrorFlg = A ();
    MESG = "A is missing ";
    if (ErrorFlg)
      {
	{
	  FilePointResume (tellsave);
	}
      }
    if (!ErrorFlg)
      {
	SetToken (Char);
	do
	  {
	    long chktell1, chktell2;
	    chktell1 = FilePointSave ();
	    int AN ();
	    ErrorFlg = AN ();
	    MESG = "AN is missing ";
	    if (ErrorFlg)
	      {
	      }
	    if (!ErrorFlg)
	      {
		SetToken (Char);
	      }
	    chktell2 = FilePointSave ();
	    if ((chktell1 == chktell2) && !ErrorFlg)
	      ErrorStop ("endless loop occured");
	  }
	while (!ErrorFlg);
	ErrorFlg = 0;
	MESG = NULL;
	if (ErrorFlg)
	  ErrorStop (MESG);
	SetToken ('\0');

      }

  }
  return ErrorFlg;
}