if !line_start < 0 then 0 else lex_start - !line_start in
(*line_start := -1;*)
prev_plus := (c = D.PLUS) or (c = D.PLUSPLUS);
- (c,l,ll,lex_start,preceeding_spaces,[],[],Ast0.NoMetaPos)
+ (c,l,ll,lex_start,preceeding_spaces,[],[],[])
let current_line_started = ref false
let col_zero = ref true
Hashtbl.replace metavariables (get_name name) fn);
Data.add_id_meta :=
(fun name constraints pure ->
- let fn clt = TMetaId(name,constraints,pure,clt) in
+ let fn clt = TMetaId(name,constraints,Ast.NoVal,pure,clt) in
Hashtbl.replace metavariables (get_name name) fn);
Data.add_virt_id_meta_found :=
(fun name vl ->
Hashtbl.replace metavariables name fn);
Data.add_virt_id_meta_not_found :=
(fun name pure ->
- let fn clt = TMetaId(name,Ast.IdNoConstraint,pure,clt) in
+ let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast.NoVal,pure,clt) in
Hashtbl.replace metavariables (get_name name) fn);
Data.add_fresh_id_meta :=
- (fun name ->
- let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast0.Impure,clt) in
+ (fun name seed ->
+ let fn clt = TMetaId(name,Ast.IdNoConstraint,seed,Ast0.Impure,clt) in
Hashtbl.replace metavariables (get_name name) fn);
Data.add_type_meta :=
(fun name pure ->
(fun name pure ->
let fn clt = TMetaInit(name,pure,clt) in
Hashtbl.replace metavariables (get_name name) fn);
+ Data.add_initlist_meta :=
+ (function name -> function lenname -> function pure ->
+ let fn clt = TMetaInitList(name,lenname,pure,clt) in
+ Hashtbl.replace metavariables (get_name name) fn);
Data.add_param_meta :=
(function name -> function pure ->
let fn clt = TMetaParam(name,pure,clt) in
| [' ' '\t' ]+ { start_line false; token lexbuf }
- | "//" [^ '\n']* {
+ | [' ' '\t' ]* (("//" [^ '\n']*) as after) {
match !current_line_type with
(D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
+ let str =
+ if !current_line_started
+ then (tok lexbuf)
+ else after in
start_line true;
- TPragma (Ast.Indent (tok lexbuf), get_current_line_type lexbuf)
+ TPragma (Ast.Indent str, get_current_line_type lexbuf)
| _ -> start_line false; token lexbuf }
| "__attribute__" [' ' '\t']* "((" _* "))"
then (start_line true; TArob)
else (check_minus_context_linetype "@"; TPArob) }
- | "~=" { start_line true; TTildeEq (get_current_line_type lexbuf) }
- | "!~=" { start_line true; TTildeExclEq (get_current_line_type lexbuf) }
+ | "=~" { start_line true; TTildeEq (get_current_line_type lexbuf) }
+ | "!=~" { start_line true; TTildeExclEq (get_current_line_type lexbuf) }
| "WHEN" | "when"
{ start_line true; check_minus_context_linetype (tok lexbuf);
TWhen (get_current_line_type lexbuf) }
TUndef
(lt,
check_var ident
- (arity,line,lline,offset+off,col+off,[],[],Ast0.NoMetaPos)) }
+ (arity,line,lline,offset+off,col+off,[],[],[])) }
| (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def)
( (letter (letter |digit)*) as ident)
{ start_line true;
TDefine
(lt,
check_var ident
- (arity,line,lline,offset+off,col+off,[],[],Ast0.NoMetaPos)) }
+ (arity,line,lline,offset+off,col+off,[],[],[])) }
| (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def)
( (letter (letter | digit)*) as ident)
'('
{ start_line true; check_plus_linetype (tok lexbuf);
TPragma (Ast.Noindent(tok lexbuf), get_current_line_type lexbuf) }
| "/*"
- { start_line true; check_plus_linetype (tok lexbuf);
+ {
+ match !current_line_type with
+ (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
+ start_line true;
(* second argument to TPragma is not quite right, because
it represents only the first token of the comment, but that
should be good enough *)
- TPragma (Ast.Indent("/*"^(comment lexbuf)),
- get_current_line_type lexbuf) }
+ TPragma (Ast.Indent("/*"^(comment check_comment lexbuf)),
+ get_current_line_type lexbuf)
+ | _ -> let _ = comment (fun _ -> ()) lexbuf in token lexbuf }
| "---" [^'\n']*
{ (if !current_line_started
then lexerr "--- must be at the beginning of the line" "");
and char = parse
- | (_ as x) "'" { String.make 1 x }
- | (("\\" (oct | oct oct | oct oct oct)) as x "'") { x }
- | (("\\x" (hex | hex hex)) as x "'") { x }
- | (("\\" (_ as v)) as x "'")
- { (match v with
- | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> ()
- | 'r' -> () | 'f' -> () | 'a' -> ()
- | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
- | 'e' -> ()
- | _ -> lexerr "unrecognised symbol: " (tok lexbuf)
- );
- x
+ | (_ as x) { String.make 1 x ^ restchars lexbuf }
+ (* todo?: as for octal, do exception beyond radix exception ? *)
+ | (("\\" (oct | oct oct | oct oct oct)) as x ) { x ^ restchars lexbuf }
+ (* this rule must be after the one with octal, lex try first longest
+ * and when \7 we want an octal, not an exn.
+ *)
+ | (("\\x" ((hex | hex hex))) as x ) { x ^ restchars lexbuf }
+ | (("\\" (_ as v)) as x )
+ {
+ (match v with (* Machine specific ? *)
+ | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> ()
+ | 'f' -> () | 'a' -> ()
+ | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
+ | 'e' -> () (* linuxext: ? *)
+ | _ ->
+ Common.pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf);
+ );
+ x ^ restchars lexbuf
}
- | _ { lexerr "unrecognised symbol: " (tok lexbuf) }
+ | _
+ { Common.pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf);
+ tok lexbuf ^ restchars lexbuf
+ }
+
+and restchars = parse
+ | "'" { "" }
+ | (_ as x) { String.make 1 x ^ restchars lexbuf }
+ (* todo?: as for octal, do exception beyond radix exception ? *)
+ | (("\\" (oct | oct oct | oct oct oct)) as x ) { x ^ restchars lexbuf }
+ (* this rule must be after the one with octal, lex try first longest
+ * and when \7 we want an octal, not an exn.
+ *)
+ | (("\\x" ((hex | hex hex))) as x ) { x ^ restchars lexbuf }
+ | (("\\" (_ as v)) as x )
+ {
+ (match v with (* Machine specific ? *)
+ | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> ()
+ | 'f' -> () | 'a' -> ()
+ | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
+ | 'e' -> () (* linuxext: ? *)
+ | _ ->
+ Common.pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf);
+ );
+ x ^ restchars lexbuf
+ }
+ | _
+ { Common.pr2 ("LEXER: unrecognised symbol in char:"^tok lexbuf);
+ tok lexbuf ^ restchars lexbuf
+ }
and string = parse
| '"' { "" }
}
| _ { lexerr "unrecognised symbol: " (tok lexbuf) }
-and comment = parse
+and comment check_comment = parse
| "*/" { let s = tok lexbuf in check_comment s; start_line true; s }
| ['\n' '\r' '\011' '\012']
{ let s = tok lexbuf in
(* even blank line should have a + *)
check_comment s;
- reset_line lexbuf; s ^ comment lexbuf }
+ reset_line lexbuf; s ^ comment check_comment lexbuf }
| "+" { pass_zero();
if !current_line_started
- then (start_line true; let s = tok lexbuf in s^(comment lexbuf))
- else (start_line true; comment lexbuf) }
+ then (start_line true;
+ let s = tok lexbuf in s^(comment check_comment lexbuf))
+ else (start_line true; comment check_comment lexbuf) }
(* noteopti: *)
| [^ '*']
{ let s = tok lexbuf in
- check_comment s; start_line true; s ^ comment lexbuf }
+ check_comment s; start_line true; s ^ comment check_comment lexbuf }
| [ '*']
{ let s = tok lexbuf in
- check_comment s; start_line true; s ^ comment lexbuf }
+ check_comment s; start_line true; s ^ comment check_comment lexbuf }
| _
{ start_line true; let s = tok lexbuf in
Common.pr2 ("LEXER: unrecognised symbol in comment:"^s);
- s ^ comment lexbuf
+ s ^ comment check_comment lexbuf
}