home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / parsing.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  2.3 KB  |  87 lines  |  [TEXT/MPS ]
  1. (* The parsing engine *)
  2.  
  3. #open "eq";;
  4. #open "exc";;
  5. #open "int";;
  6. #open "fvect";;
  7. #open "obj";;
  8. #open "lexing";;
  9. #open "iparsing";;
  10.  
  11. let env =
  12.   { s_stack = make_vect 100 0;
  13.     v_stack = make_vect 100 (repr ());
  14.     symb_start_stack = make_vect 100 0;
  15.     symb_end_stack = make_vect 100 0;
  16.     stacksize = 100;
  17.     curr_char = 0;
  18.     lval = repr ();
  19.     symb_start = 0;
  20.     symb_end = 0;
  21.     sp = 0;
  22.     rule_len = 0;
  23.     rule_number = 0 }
  24. ;;
  25.  
  26. let grow_stacks() =
  27.   let oldsize = env.stacksize in
  28.   let newsize = oldsize * 2 in
  29.   let new_s = make_vect newsize 0
  30.   and new_v = make_vect newsize (repr ())
  31.   and new_start = make_vect newsize 0
  32.   and new_end = make_vect newsize 0 in
  33.     blit_vect env.s_stack 0 new_s 0 oldsize;
  34.     env.s_stack <- new_s;
  35.     blit_vect env.v_stack 0 new_v 0 oldsize;
  36.     env.v_stack <- new_v;
  37.     blit_vect env.symb_start_stack 0 new_start 0 oldsize;
  38.     env.symb_start_stack <- new_start;
  39.     blit_vect env.symb_end_stack 0 new_end 0 oldsize;
  40.     env.symb_end_stack <- new_end;
  41.     env.stacksize <- newsize
  42. ;;
  43.  
  44. let clear_parser() =
  45.   fill_vect env.v_stack 0 env.stacksize (repr ());
  46.   env.lval <- repr ()
  47. ;;
  48.  
  49. let yyparse tables start lexer lexbuf =
  50.   let rec loop cmd arg =
  51.     match parse_engine tables env cmd arg with
  52.       Read_token ->
  53.         let t = repr(lexer lexbuf) in
  54.         env.symb_start <- lexbuf.lex_abs_pos + lexbuf.lex_start_pos;
  55.         env.symb_end   <- lexbuf.lex_abs_pos + lexbuf.lex_curr_pos;
  56.         loop Token_read t
  57.     | Raise_parse_error ->
  58.         let c = env.curr_char in
  59.         raise (Parse_error (fun tok -> tables.transl.(obj_tag tok) == c))
  60.     | Compute_semantic_action ->
  61.         loop Semantic_action_computed (tables.actions.(env.rule_number) ())
  62.     | Grow_stacks_1 ->
  63.         grow_stacks(); loop Stacks_grown_1 (repr ())
  64.     | Grow_stacks_2 ->
  65.         grow_stacks(); loop Stacks_grown_2 (repr ())
  66.   in
  67.     env.curr_char <- start;
  68.     env.sp <- 0;
  69.     try loop Start (repr ()) with yyexit v -> magic_obj v
  70. ;;
  71.  
  72. let peek_val n =
  73.   magic_obj env.v_stack.(env.sp - n)
  74. ;;
  75.  
  76. let symbol_start () =
  77.   env.symb_start_stack.(env.sp - env.rule_len + 1)
  78. and symbol_end () =
  79.   env.symb_end_stack.(env.sp)
  80. ;;
  81.  
  82. let rhs_start n =
  83.   env.symb_start_stack.(env.sp - (env.rule_len - n))
  84. and rhs_end n =
  85.   env.symb_end_stack.(env.sp - (env.rule_len - n))
  86. ;;
  87.