Commits

HongboZhang  committed 18a77cf

revert changes to Lexer.mll

  • Participants
  • Parent commits 9c9f16e

Comments (0)

Files changed (1)

File camlp4/Camlp4/Struct/Lexer.mll

 
   open Lexing
   open Sig
-  let debug = ref false
-  let opt_char_len  = function Some _ -> 1 | None -> 0
-  let print_opt_char fmt = function Some c ->
-    Format.fprintf fmt "Some %c" c | None -> Format.fprintf fmt "None"
-  module Stack=struct
-    include Stack
-    let push v stk= begin 
-      if!debug then Format.eprintf "Push %a@." print_opt_char v else ();
-      push v stk
-    end 
-    let pop stk = begin
-      if !debug then Format.eprintf "Pop %a@." print_opt_char (top stk);
-      pop stk
-    end 
-  end
-  (* the trailing char after "<<" *)    
-  let opt_char : char option Stack.t = Stack.create ()      
-  let show_stack () = begin
-    Stack.iter (Format.eprintf "%a@." print_opt_char ) opt_char 
-  end
-  (* the trailing char after "$" *)    
-  (* let anti_char : char Stack.t = Stack.create ()
-   * let show_anti_stack() = begin
-   *   Stack.iter (Format.eprintf "%c@." ) anti_char
-   * end  *)
+
   (* Error report *)
   module Error = struct
 
     exception E of t
 
     open Format
+
     let print ppf =
       function
       | Illegal_character c ->
   let shift n c = { (c) with loc = Loc.move `both n c.loc }
   let store_parse f c = store c ; f c c.lexbuf
   let parse f c = f c c.lexbuf
-
-  let mk_quotation quotation c name loc shift back =
+  let mk_quotation quotation c name loc shift =
     let s = parse_nested quotation (update_loc c) in
-    let contents = String.sub s 0 (String.length s - back) in
+    let contents = String.sub s 0 (String.length s - 2) in
     QUOTATION { q_name     = name     ;
                 q_loc      = loc      ;
                 q_shift    = shift    ;
       pos_lnum = if absolute then line else pos.pos_lnum + line;
       pos_bol = pos.pos_cnum - chars;
     }
-
+	
     (* To convert integer literals, copied from "../parsing/lexer.mll" *)
-
+	
     let cvt_int_literal s =
       - int_of_string ("-" ^ s)
     let cvt_int32_literal s =
     | "*)"
         { warn Comment_not_end (Loc.of_lexbuf lexbuf)                           ;
           move_start_p (-1) c; SYMBOL "*"                                       }
-    | "<<" (symbolchar as p)? (quotchar* as beginning)
+    | "<<" (quotchar* as beginning)
       { if quotations c
         then (move_start_p (-String.length beginning);
-              (* FIXME: partial application *)
-              Stack.push p opt_char;
-              let len = 2 + opt_char_len p in 
-              mk_quotation quotation c "" "" len len;
-             )
-        else parse
-          (symbolchar_star ("<<" ^ (match p with Some x -> String.make 1 x | None -> "")
-                            ^ beginning)) c   }
+              mk_quotation quotation c "" "" 2)
+        else parse (symbolchar_star ("<<" ^ beginning)) c                       }
     | "<<>>"
       { if quotations c
         then QUOTATION { q_name = ""; q_loc = ""; q_shift = 2; q_contents = "" }
     | ( "#"  | "`"  | "'"  | ","  | "."  | ".." | ":"  | "::"
       | ":=" | ":>" | ";"  | ";;" | "_"
       | left_delimitor | right_delimitor ) as x  { SYMBOL x }
-    | ".$" 
-        { if antiquots c
-            (* $() is more beautiful but () are not symbol chars *)
-        then
-          with_curr_loc dollar (shift 2 c)
-        else parse (symbolchar_star ".$") c } 
+    | '$' { if antiquots c
+            then with_curr_loc dollar (shift 1 c)
+            else parse (symbolchar_star "$") c }
     | ['~' '?' '!' '=' '<' '>' '|' '&' '@' '^' '+' '-' '*' '/' '%' '\\'] symbolchar *
                                                                 as x { SYMBOL x }
     | eof
       "(*"
         { store c; with_curr_loc comment c; parse comment c                     }
     | "*)"                                                            { store c }
-    | '<' (':' ident)? ('@' locname)? '<' (symbolchar as p)?
+    | '<' (':' ident)? ('@' locname)? '<'
         { store c;
-          if quotations c then
-            Stack.push p opt_char; (* It's weird that we handle quotation in comment *)
-            with_curr_loc quotation c; parse comment c       }
+          if quotations c then with_curr_loc quotation c; parse comment c       }
     | ident                                             { store_parse comment c }
     | "\""
         { store c;
                                                         SYMBOL(beginning ^ tok) }
 
   and maybe_quotation_at c = parse
-    | (ident as loc) '<' (symbolchar as p)?
-        (* bug fix 2 is for <@ *)
-      { Stack.push p opt_char;
-        mk_quotation quotation c "" loc
-          (2 + 1 + String.length loc + (opt_char_len p)) (2 + opt_char_len p)
-      } (* into the quotaion context *)
+    | (ident as loc) '<'
+      { mk_quotation quotation c "" loc (1 + String.length loc)                 }
     | symbolchar* as tok                                   { SYMBOL("<@" ^ tok) }
 
   and maybe_quotation_colon c = parse
-    | (ident as name) '<' (symbolchar as p)?
-        (* bug fix 2 is for <: *)
-      { Stack.push p opt_char;
-        mk_quotation quotation c name ""
-          (2 + 1 + String.length name + opt_char_len p) (2 + opt_char_len p)
-      } (* into the quotation context *)
-        (* bug fix 2 is for <: *)
-    | (ident as name) '@' (locname as loc) '<' (symbolchar as p)?
-      { Stack.push p opt_char;
-        mk_quotation quotation c name loc
-          (2 + 2 + String.length loc + String.length name + opt_char_len p)
-      (2 + opt_char_len p)}
+    | (ident as name) '<'
+      { mk_quotation quotation c name "" (1 + String.length name)               }
+    | (ident as name) '@' (locname as loc) '<'
+      { mk_quotation quotation c name loc
+                     (2 + String.length loc + String.length name)               }
     | symbolchar* as tok                                   { SYMBOL("<:" ^ tok) }
 
   and quotation c = parse
-    | '<' (':' ident)? ('@' locname)? '<'  (symbolchar as p)?
-                                             {                          store c ; (* nested case*)
-                                                          Stack.push  p opt_char;                                                                        
-                                                      with_curr_loc quotation c ; (* *)
+    | '<' (':' ident)? ('@' locname)? '<'    {                          store c ;
+                                                      with_curr_loc quotation c ;
                                                               parse quotation c }
-
-    | (symbolchar as p)? ">>"              {
-      if not (Stack.is_empty opt_char) then 
-        let top = Stack.top opt_char in 
-        if p <> top then
-          store_parse quotation c (* move on *)
-        else  begin
-          Stack.pop opt_char;
-          store c ;
-        end
-      else store_parse quotation c;
-                                             }
-
-    | eof                                  { show_stack (); err Unterminated_quotation (loc c) }
+    | ">>"                                                            { store c }
+    | eof                                  { err Unterminated_quotation (loc c) }
     | newline                                     { update_loc c None 1 false 0 ;
                                                         store_parse quotation c }
     | _                                               { store_parse quotation c }
 
   and dollar c = parse
-    | "$."                                     { set_start_p c; ANTIQUOT("", "") }
-    | ('`'? (identchar+) as name) ':' 
-      { with_curr_loc (antiquot name 0) (shift (1 + String.length name) c)        }
-    (*handle special case .$.$x$.$.*)
-    | ".$"                                     {store_parse (antiquot "" 1 ) c }  
-
-    | _                                           { store_parse (antiquot "" 0) c }
-
-  and antiquot name depth c = parse
-    | "$."
-        { if depth = 0 then let () = set_start_p c in ANTIQUOT(name, buff_contents c)
-          else store_parse (antiquot name (depth - 1)) c  }
-    | ".$" {store_parse (antiquot name (depth + 1 )) c }
+    | '$'                                     { set_start_p c; ANTIQUOT("", "") }
+    | ('`'? (identchar*|['.' '!']+) as name) ':'
+      { with_curr_loc (antiquot name) (shift (1 + String.length name) c)        }
+    | _                                           { store_parse (antiquot "") c }
+
+  and antiquot name c = parse
+    | '$'                      { set_start_p c; ANTIQUOT(name, buff_contents c) }
     | eof                                   { err Unterminated_antiquot (loc c) }
     | newline
-      { update_loc c None 1 false 0; store_parse (antiquot name depth) c              }
-    | '<' (':' ident)? ('@' locname)? '<' (symbolchar as p)?
-      { let () = Stack.push p opt_char in
-        let () = store c in
-        let () = with_curr_loc quotation c in
-        parse (antiquot name depth) c }
-    | _                                         { store_parse (antiquot name depth) c }
+      { update_loc c None 1 false 0; store_parse (antiquot name) c              }
+    | '<' (':' ident)? ('@' locname)? '<'
+      { store c; with_curr_loc quotation c; parse (antiquot name) c             }
+    | _                                         { store_parse (antiquot name) c }
 
   {