Skip to content
This repository was archived by the owner on Jun 4, 2019. It is now read-only.

Commit dd50723

Browse files
aryxaryx
committed
lang_lisp: ./pfff -tokens_lisp tests/lisp/foo.lisp now works
1 parent 270df00 commit dd50723

4 files changed

Lines changed: 165 additions & 9 deletions

File tree

‎lang_lisp/parsing/flag_parsing_lisp.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,5 @@
22

33
let verbose_lexing = ref false
44
let verbose_parsing = ref false
5+
6+
let debug_lexer = ref false

‎lang_lisp/parsing/lexer_lisp.mll‎

Lines changed: 54 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -39,38 +39,63 @@ let tok lexbuf =
3939
Lexing.lexeme lexbuf
4040
let tokinfo lexbuf =
4141
Parse_info.tokinfo_str_pos (Lexing.lexeme lexbuf) (Lexing.lexeme_start lexbuf)
42-
4342
}
4443

4544
(*****************************************************************************)
46-
4745
let letter = ['a'-'z''A'-'Z']
4846
let digit = ['0'-'9']
4947

48+
let symbol =
49+
['-' '+' '=' '~' '.' ',' '/' ':' '<' '>' '*' ';' '#'
50+
'_' '?' '^' '|' '!' '&' ]
51+
(*
52+
'\''
53+
'\\'
54+
'@'
55+
'"'
56+
'`'
57+
*)
58+
5059
(*****************************************************************************)
51-
rule sexp = parse
60+
rule token = parse
5261

5362
(* ----------------------------------------------------------------------- *)
5463
(* spacing/comments *)
5564
(* ----------------------------------------------------------------------- *)
5665
| ";" [^'\n' '\r']* {
5766
TComment(tokinfo lexbuf)
5867
}
59-
| [' ''\t'] { TCommentSpace (tokinfo lexbuf) }
68+
| [' ''\t']+ { TCommentSpace (tokinfo lexbuf) }
6069
| "\n" { TCommentNewline (tokinfo lexbuf) }
6170

6271
(* ----------------------------------------------------------------------- *)
6372
(* Symbols *)
6473
(* ----------------------------------------------------------------------- *)
6574

66-
| '(' { TOParen (tokinfo lexbuf) }
67-
| ')' { TCParen (tokinfo lexbuf) }
75+
| '(' { TOParen (tokinfo lexbuf) } | ')' { TCParen (tokinfo lexbuf) }
76+
| "[" { TOBracket(tokinfo lexbuf) } | "]" { TCBracket(tokinfo lexbuf) }
6877

6978
(* ----------------------------------------------------------------------- *)
70-
(* Keywords and ident *)
79+
(* Strings *)
7180
(* ----------------------------------------------------------------------- *)
81+
| '"' {
82+
(* opti: use Buffer because some autogenerated files can
83+
* contains huge strings
84+
*)
85+
let info = tokinfo lexbuf in
86+
let buf = Buffer.create 100 in
87+
string buf lexbuf;
88+
let s = Buffer.contents buf in
89+
TString (s, info +> Parse_info.tok_add_s (s ^ "\""))
90+
}
7291

7392
(* ----------------------------------------------------------------------- *)
93+
(* Keywords and ident *)
94+
(* ----------------------------------------------------------------------- *)
95+
| (letter | symbol) (letter | digit | symbol)* {
96+
TIdent (tok lexbuf, tokinfo lexbuf)
97+
}
98+
(* ----------------------------------------------------------------------- *)
7499
(* Constant *)
75100
(* ----------------------------------------------------------------------- *)
76101

@@ -85,3 +110,25 @@ rule sexp = parse
85110
then pr2_once ("LEXER:unrecognised symbol, in token rule:"^tok lexbuf);
86111
TUnknown (tokinfo lexbuf)
87112
}
113+
114+
(*****************************************************************************)
115+
116+
and string buf = parse
117+
| '"' { Buffer.add_string buf "" }
118+
(* opti: *)
119+
| [^ '"' '\\']+ {
120+
Buffer.add_string buf (tok lexbuf);
121+
string buf lexbuf
122+
}
123+
124+
| ("\\" (_ as v)) as x {
125+
(* todo: check char ? *)
126+
(match v with
127+
| _ -> ()
128+
);
129+
Buffer.add_string buf x;
130+
string buf lexbuf
131+
}
132+
| eof {
133+
pr2 "LEXER: WIERD end of file in double quoted string";
134+
}

‎lang_lisp/parsing/parse_lisp.ml‎

Lines changed: 43 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,10 @@ module Flag = Flag_parsing_lisp
1919

2020
module PI = Parse_info
2121

22+
(* we don't need a full grammar for lisp code, so we put everything,
23+
* the token type, the helper in parser_ml. No token_helpers_lisp.ml
24+
*)
25+
module TH = Parser_lisp
2226

2327
(*****************************************************************************)
2428
(* Prelude *)
@@ -51,10 +55,47 @@ let lexbuf_to_strpos lexbuf =
5155
(* Lexing only *)
5256
(*****************************************************************************)
5357

58+
(* could factorize and take the tokenf and visitor_of_infof in argument
59+
* but sometimes copy-paste is ok.
60+
*)
5461
let tokens2 file =
55-
let table = PI.full_charpos_to_pos_large file in
62+
let table = Parse_info.full_charpos_to_pos_large file in
63+
64+
Common.with_open_infile file (fun chan ->
65+
let lexbuf = Lexing.from_channel chan in
66+
67+
try
68+
let ftoken lexbuf =
69+
Lexer_lisp.token lexbuf
70+
in
71+
72+
let rec tokens_aux acc =
73+
let tok = ftoken lexbuf in
74+
if !Flag.debug_lexer then Common.pr2_gen tok;
75+
76+
let tok = tok +> TH.visitor_info_of_tok (fun ii ->
77+
{ ii with PI.token=
78+
(* could assert pinfo.filename = file ? *)
79+
match PI.pinfo_of_info ii with
80+
| PI.OriginTok pi ->
81+
PI.OriginTok
82+
(PI.complete_parse_info_large file table pi)
83+
| _ -> raise Todo
84+
})
85+
in
86+
87+
if TH.is_eof tok
88+
then List.rev (tok::acc)
89+
else tokens_aux (tok::acc)
90+
in
91+
tokens_aux []
92+
with
93+
| Lexer_lisp.Lexical s ->
94+
failwith ("lexical error " ^ s ^ "\n =" ^
95+
(PI.error_message file (lexbuf_to_strpos lexbuf)))
96+
| e -> raise e
97+
)
5698

57-
raise Todo
5899

59100
let tokens a =
60101
Common.profile_code "Parse_lisp.tokens" (fun () -> tokens2 a)

‎lang_lisp/parsing/parser_lisp.ml‎

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,79 @@
1+
(* Yoann Padioleau
2+
*
3+
* Copyright (C) 2010 Facebook
4+
*
5+
* This library is free software; you can redistribute it and/or
6+
* modify it under the terms of the GNU Lesser General Public License
7+
* version 2.1 as published by the Free Software Foundation, with the
8+
* special exception on linking described in file license.txt.
9+
*
10+
* This library is distributed in the hope that it will be useful, but
11+
* WITHOUT ANY WARRANTY; without even the implied warranty of
12+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
13+
* license.txt for more details.
14+
*)
15+
16+
open Common
17+
18+
(*****************************************************************************)
19+
(* Types *)
20+
(*****************************************************************************)
121

222
type token =
323
| TComment of (Ast_lisp.info)
424
| TCommentSpace of (Ast_lisp.info)
525
| TCommentNewline of (Ast_lisp.info)
626

727
| TNumber of (string * Ast_lisp.info)
28+
| TIdent of (string * Ast_lisp.info)
29+
| TString of (string * Ast_lisp.info)
30+
831
| TOParen of (Ast_lisp.info)
932
| TCParen of (Ast_lisp.info)
33+
| TOBracket of (Ast_lisp.info)
34+
| TCBracket of (Ast_lisp.info)
1035

1136
| TUnknown of (Ast_lisp.info)
1237
| EOF of (Ast_lisp.info)
1338

39+
(*****************************************************************************)
40+
(* Token Helpers *)
41+
(*****************************************************************************)
42+
43+
let is_eof = function
44+
| EOF _ -> true
45+
| _ -> false
46+
47+
let is_comment = function
48+
| TComment _ | TCommentSpace _ | TCommentNewline _ -> true
49+
| _ -> false
50+
51+
let is_just_comment = function
52+
| TComment _ -> true
53+
| _ -> false
54+
55+
(*****************************************************************************)
56+
(* Visitors *)
57+
(*****************************************************************************)
58+
let visitor_info_of_tok f = function
59+
| TComment ii -> TComment (f ii)
60+
| TCommentSpace ii -> TCommentSpace (f ii)
61+
| TCommentNewline ii -> TCommentNewline (f ii)
62+
63+
| TNumber (s, ii) -> TNumber (s, f ii)
64+
| TIdent (s, ii) -> TIdent (s, f ii)
65+
| TString (s, ii) -> TString (s, f ii)
66+
67+
| TOParen ii -> TOParen (f ii)
68+
| TCParen ii -> TCParen (f ii)
69+
| TOBracket ii -> TOBracket (f ii)
70+
| TCBracket ii -> TCBracket (f ii)
71+
72+
| TUnknown ii -> TUnknown (f ii)
73+
| EOF ii -> EOF (f ii)
74+
75+
let info_of_tok tok =
76+
let res = ref None in
77+
visitor_info_of_tok (fun ii -> res := Some ii; ii) tok +> ignore;
78+
Common.some !res
79+

0 commit comments

Comments
 (0)