Permalink
Browse files

erlang: basic highlighter

  • Loading branch information...
aryx committed Jan 23, 2011
1 parent 66c4e09 commit ebdc9adec5fd6862a6c426d1dfc7e82594f9ffae
View
@@ -262,3 +262,7 @@ external/ocamlbdb/libcamlbdb.a
/DB_LIGHT.marshall
/lang_erlang/parsing/parse_erlang.ml
/lang_erlang/parsing/parse_erlang.mli
+/lang_erlang/parsing/lexer_erlang.ml
+/lang_erlang/parsing/parser_erlang.ml
+/lang_erlang/parsing/parser_erlang.mli
+/lang_erlang/parsing/parser_erlang.output
View
@@ -201,6 +201,7 @@ LIBS= commons/commons.cma \
lang_csharp/parsing/lib.cma \
lang_csharp/analyze/lib.cma \
lang_erlang/parsing/lib.cma \
+ lang_erlang/analyze/lib.cma \
MAKESUBDIRS=commons \
$(BDBDIR) $(REGEXPDIR) $(MPIDIR) \
@@ -235,6 +236,7 @@ MAKESUBDIRS=commons \
lang_csharp/parsing \
lang_csharp/analyze \
lang_erlang/parsing \
+ lang_erlang/analyze \
lang_php/analyze \
lang_php/analyze/basic \
lang_php/analyze/foundation \
@@ -0,0 +1,293 @@
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2010 Facebook
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * version 2.1 as published by the Free Software Foundation, with the
+ * special exception on linking described in file license.txt.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
+ * license.txt for more details.
+ *)
+
+open Common
+
+open Ast_erlang
+
+module Ast = Ast_erlang
+(*module V = Visitor_erlang *)
+
+open Highlight_code
+
+module T = Parser_erlang
+module TH = Token_helpers_erlang
+
+(*****************************************************************************)
+(* Prelude *)
+(*****************************************************************************)
+
+(*****************************************************************************)
+(* Helpers *)
+(*****************************************************************************)
+
+(* we generate fake value here because the real one are computed in a
+ * later phase in rewrite_categ_using_entities in pfff_visual.
+ *)
+let fake_no_def2 = NoUse
+let fake_no_use2 = (NoInfoPlace, UniqueDef, MultiUse)
+
+let lexer_based_tagger = true
+
+(*****************************************************************************)
+(* Code highlighter *)
+(*****************************************************************************)
+
+(* The idea of the code below is to visit the program either through its
+ * AST or its list of tokens. The tokens are easier for tagging keywords,
+ * number and basic entities. The Ast is better for tagging idents
+ * to figure out what kind of ident it is.
+ *)
+
+let visit_toplevel
+ ~tag_hook
+ prefs
+ (*db_opt *)
+ (toplevel, toks)
+ =
+ let already_tagged = Hashtbl.create 101 in
+ let atom_already_tagged = Hashtbl.create 101 in
+
+ let tag = (fun ii categ ->
+ tag_hook ii categ;
+ Hashtbl.replace already_tagged ii true
+ )
+ in
+
+ (* -------------------------------------------------------------------- *)
+ (* ast phase 1 *)
+
+ (* -------------------------------------------------------------------- *)
+ (* toks phase 1 *)
+
+ let rec aux_toks xs =
+ match xs with
+ | [] -> ()
+ (* a little bit pad specific *)
+ | T.TComment(ii)
+ ::T.TCommentNewline (ii2)
+ ::T.TComment(ii3)
+ ::T.TCommentNewline (ii4)
+ ::T.TComment(ii5)
+ ::xs ->
+ let s = Parse_info.str_of_info ii in
+ let s5 = Parse_info.str_of_info ii5 in
+ (match () with
+ | _ when s =~ ".*\\*\\*\\*\\*" && s5 =~ ".*\\*\\*\\*\\*" ->
+ tag ii CommentEstet;
+ tag ii5 CommentEstet;
+ tag ii3 CommentSection0
+ | _ when s =~ ".*=========" && s5 =~ ".*========" ->
+ tag ii CommentEstet;
+ tag ii5 CommentEstet;
+ tag ii3 CommentSection0
+ | _ when s =~ ".*------" && s5 =~ ".*------" ->
+ tag ii CommentEstet;
+ tag ii5 CommentEstet;
+ tag ii3 CommentSection1
+ | _ when s =~ ".*####" && s5 =~ ".*####" ->
+ tag ii CommentEstet;
+ tag ii5 CommentEstet;
+ tag ii3 CommentSection2
+ | _ ->
+ ()
+ );
+ aux_toks xs
+
+ (* poor's man identifier tagger *)
+
+ (* defs *)
+ | T.TIdent (s, ii1)::xs when Ast.col_of_info ii1 = 0 ->
+ if not (Hashtbl.mem atom_already_tagged s) then begin
+ Hashtbl.add atom_already_tagged s true;
+ tag ii1 (Function (Def2 fake_no_def2));
+ end;
+ aux_toks xs
+
+ (* uses *)
+ | T.TIdent(s, ii1)::T.TColon (ii2)::xs ->
+ tag ii1 (Module Use);
+ aux_toks xs
+
+ | T.TIdent(s, ii1)::T.TOParen (ii2)::xs ->
+ tag ii1 (Function (Use2 fake_no_use2));
+ aux_toks xs
+
+(*
+ | T.TIdent (s1, ii1)::T.TDot ii2
+ ::T.TIdent (s3, ii3)::T.TOParen(ii4)::xs ->
+ if not (Hashtbl.mem already_tagged ii3) && lexer_based_tagger
+ then begin
+ tag ii3 (Method (Use2 fake_no_use2));
+ (*
+ if not (Hashtbl.mem already_tagged ii1)
+ then tag ii1 (Local Use);
+ *)
+ if is_module_name s1 then tag ii1 (Module (Use))
+ end;
+ aux_toks xs
+
+ | T.TIdent (s1, ii1)::T.TDot ii2
+ ::T.TIdent (s3, ii3)::T.TEq ii4::xs ->
+ if not (Hashtbl.mem already_tagged ii3) && lexer_based_tagger
+ then begin
+ tag ii3 (Field (Use2 fake_no_use2));
+ if is_module_name s1 then tag ii1 (Module (Use))
+ end;
+ aux_toks xs
+
+
+ | T.TIdent (s1, ii1)::T.TDot ii2
+ ::T.TIdent (s3, ii3)::T.TDot ii4::xs ->
+ if not (Hashtbl.mem already_tagged ii1) && lexer_based_tagger
+ then begin
+ if is_module_name s1 then tag ii1 (Module Use)
+ end;
+ aux_toks (T.TIdent (s3, ii3)::T.TDot ii4::xs)
+*)
+
+ | x::xs ->
+ aux_toks xs
+ in
+ let toks' = toks +> Common.exclude (function
+ | T.TCommentSpace _ -> true
+ | _ -> false
+ )
+ in
+ aux_toks toks';
+
+ (* -------------------------------------------------------------------- *)
+ (* toks phase 2 *)
+
+ toks +> List.iter (fun tok ->
+ match tok with
+
+ (* comments *)
+ | T.TComment ii ->
+ if not (Hashtbl.mem already_tagged ii)
+ then tag ii Comment
+ | T.TCommentSpace ii ->
+ if not (Hashtbl.mem already_tagged ii)
+ then ()
+ else ()
+ | T.TCommentNewline ii | T.TCommentMisc ii -> ()
+ | T.TUnknown ii -> tag ii Error
+ | T.EOF ii-> ()
+
+ (* values *)
+ | T.TString (s,ii) ->
+ tag ii String
+ | T.TChar (s, ii) ->
+ tag ii String
+ | T.TFloat (s,ii) | T.TInt (s,ii) ->
+ tag ii Number
+
+ (* keywords *)
+ | T.Tif ii
+ | T.Tcond ii
+ | T.Tcase ii
+ | T.Twhen ii
+ -> tag ii KeywordConditional
+
+ | T.Treceive ii
+ | T.Tquery ii
+ | T.Tafter ii
+ -> tag ii Keyword
+
+ | T.Tfun ii
+ | T.Tlet ii
+ | T.Tof ii
+ -> tag ii Keyword
+
+ | T.Tend ii |T.Tbegin ii ->
+ tag ii Keyword
+
+ | T.Tcatch ii
+ -> tag ii KeywordExn
+
+ | T.TIdent (("module" | "include" | "export"), ii) ->
+ tag ii KeywordModule
+
+ | T.TIdent ("record", ii) ->
+ tag ii Keyword
+ | T.TIdent (("true" | "false"), ii) ->
+ tag ii Boolean
+
+ (* symbols *)
+ | T.TEq ii ->
+ if not (Hashtbl.mem already_tagged ii)
+ then
+ tag ii Punctuation
+
+ | T.TOBracket ii | T.TCBracket ii
+ | T.TOBrace ii | T.TCBrace ii
+ | T.TOParen ii | T.TCParen ii
+ -> tag ii Punctuation
+
+ | T.TPlus ii | T.TMinus ii
+ | T.TStar ii | T.TDiv ii
+
+ | T.TLess ii | T.TMore ii
+ | T.TLessEq ii | T.TMoreEq ii
+ | T.TEqEq ii | T.TEqSlashEq ii| T.TEqColonEq ii | T.TSlashEq ii
+ -> tag ii Operator
+
+ | T.TDot (ii)
+ | T.TColon (ii)
+ ->
+ tag ii Punctuation
+
+ | T.TComma ii
+ -> tag ii Punctuation
+
+ | T.TDec ii | T.TInc ii
+ | T.TBang ii
+ -> tag ii Operator
+
+ (* todo? put in pink/bad-smell ? *)
+ | T.TAssign ii ->
+ tag ii Operator
+
+ | T.TArrow ii
+ | T.TQuestion ii
+ | T.TSemiColon ii
+ -> tag ii Punctuation
+
+ | T.Tbnot ii | T.Tnot ii
+ | T.Tband ii | T.Tand ii
+ | T.Tbsr ii | T.Tbsl ii | T.Tbxor ii | T.Tbor ii
+ | T.Txor ii | T.Tor ii
+ | T.Trem ii | T.Tdiv ii
+ -> tag ii Operator
+
+ | T.TUnderscore ii
+ | T.TSharp ii
+ | T.TPipePipe ii
+ | T.TPipe ii
+ -> tag ii Punctuation
+
+
+ | T.TIdent (s, ii) ->
+ ()
+ | T.TVariable (s, ii) ->
+ if not (Hashtbl.mem already_tagged ii)
+ then tag ii (Local Use)
+
+
+ );
+ (* -------------------------------------------------------------------- *)
+ (* ast phase 2 *)
+
+ ()
@@ -0,0 +1,8 @@
+
+val visit_toplevel :
+ tag_hook:
+ (Ast_erlang.info -> Highlight_code.category -> unit) ->
+ Highlight_code.highlighter_preferences ->
+ (*(Database_php.id * Common.filename * Database_php.database) option -> *)
+ Ast_erlang.toplevel * Parser_erlang.token list ->
+ unit
No changes.
@@ -58,3 +58,8 @@ type program = unit
(*****************************************************************************)
(* Wrappers *)
(*****************************************************************************)
+
+let str_of_info x = Parse_info.str_of_info x
+let col_of_info x = Parse_info.col_of_info x
+let line_of_info x = Parse_info.line_of_info x
+let pos_of_info x = Parse_info.pos_of_info x
View
@@ -53,6 +53,8 @@ INCLUDEDIRS=$(TOP)/commons $(TOP)/globals \
$(TOP)/lang_csharp/analyze \
$(TOP)/lang_java/parsing \
$(TOP)/lang_java/analyze \
+ $(TOP)/lang_erlang/parsing \
+ $(TOP)/lang_erlang/analyze \
SYSINCLUDES=\
@@ -293,6 +293,7 @@ let draw_content2 ~cr ~layout ~context ~file rect =
| FT.PL (FT.Csharp)
| FT.PL (FT.Java)
| FT.PL (FT.Prolog _)
+ | FT.PL (FT.Erlang)
) ->
let column = ref 0 in
Oops, something went wrong.

0 comments on commit ebdc9ad

Please sign in to comment.