Automate a tables pour le lexing

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@671 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

byterun/lexing.c

@@ -0,0 +1,90 @@
+/***********************************************************************/
+/*                                                                     */
+/*                         Caml Special Light                          */
+/*                                                                     */
+/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
+/*                                                                     */
+/*  Copyright 1995 Institut National de Recherche en Informatique et   */
+/*  Automatique.  Distributed only by permission.                      */
+/*                                                                     */
+/***********************************************************************/
+
+/* $Id$ */
+
+/* The table-driven automaton for lexers generated by camllex. */
+
+#include "mlvalues.h"
+#include "stacks.h"
+#include "str.h"
+
+struct lexer_buffer {
+  value refill_buff;
+  value lex_buffer;
+  value lex_buffer_len;
+  value lex_abs_pos;
+  value lex_start_pos;
+  value lex_curr_pos;
+  value lex_last_pos;
+};
+
+struct lexing_table {
+  value lex_base;
+  value lex_backtrk;
+  value lex_default;
+  value lex_trans;
+  value lex_check;
+};
+
+#ifdef BIG_ENDIAN
+#define Short(tbl,n) \
+  (*((unsigned char *)((tbl) + (n) * sizeof(short))) + \
+          (*((schar *)((tbl) + (n) * sizeof(short) + 1)) << 8))
+#else
+#define Short(tbl,n) (((short *)(tbl))[n])
+#endif
+
+value lex_engine(tbl, start_state, lexbuf)     /* ML */
+     struct lexing_table * tbl;
+     value start_state;
+     struct lexer_buffer * lexbuf;
+{
+  int state, last_action, base, backtrk, c;
+
+  state = Int_val(start_state);
+  lexbuf->lex_last_pos = lexbuf->lex_start_pos = lexbuf->lex_curr_pos;
+  last_action = -1;
+  while(1) {
+    /* Lookup base address or action number for current state */
+    base = Short(tbl->lex_base, state);
+    if (base < 0) return Val_int(-base-1);
+    /* See if it's a backtrack point */
+    backtrk = Short(tbl->lex_backtrk, state);
+    if (backtrk >= 0) {
+      lexbuf->lex_last_pos = lexbuf->lex_curr_pos;
+      last_action = backtrk;
+    }
+    /* Read next input char */
+    if (lexbuf->lex_curr_pos >= lexbuf->lex_buffer_len) {
+      Push_roots (r, 2);
+      r[0] = (value) tbl;
+      r[1] = (value) lexbuf;
+      callback(lexbuf->refill_buff, (value) lexbuf);
+      tbl = (struct lexing_table *) r[0];
+      lexbuf = (struct lexer_buffer *) r[1];
+      Pop_roots ();
+    }
+    c = Byte_u(lexbuf->lex_buffer, Long_val(lexbuf->lex_curr_pos));
+    lexbuf->lex_curr_pos += 2;
+    /* Determine next state */
+    if (Short(tbl->lex_check, base + c) == state)
+      state = Short(tbl->lex_trans, base + c);
+    else
+      state = Short(tbl->lex_default, state);
+    /* If no transition on this char, return to last backtrack point */
+    if (state < 0) {
+      lexbuf->lex_curr_pos = lexbuf->lex_last_pos;
+      return Val_int(last_action);
+    }
+  }
+}
+