lang_lisp: can now lex my .emacs and backquote.lisp

facebookarchive · Oct 21, 2010 · fe5281a · fe5281a
1 parent dd50723
commit fe5281a
Show file tree

Hide file tree

Showing 7 changed files with 44 additions and 11 deletions.
diff --git a/commons/file_type.ml b/commons/file_type.ml
@@ -37,11 +37,10 @@ type file_type =
  and pl_type = 
   | ML of string  (* mli, ml, mly, mll *)
   | Haskell of string
+  | Lisp of lisp_type
   | Makefile
   | Script of string (* sh, csh, awk, sed, etc *)
   | C | Cplusplus | Java | Csharp
-  | Scheme | Lisp 
-  | Elisp
   | Perl | Python | Ruby
   | Erlang
   | Beta
@@ -51,6 +50,8 @@ type file_type =
   | Thrift
   | MiscPL of string
 
+   and lisp_type = CommonLisp | Elisp | Scheme
+
     and webpl_type = 
       | Php of string (* php or phpt or script *)
       | Js
@@ -113,10 +114,10 @@ let file_type_of_file2 file =
 
   | "thrift" -> PL Thrift
 
-  | "scm" | "rkt" -> PL Scheme
-  | "lisp" -> PL Lisp
+  | "scm" | "rkt" -> PL (Lisp Scheme)
+  | "lisp" -> PL (Lisp CommonLisp)
+  | "el" -> PL (Lisp Elisp)
 
-  | "el" -> PL Elisp
   | "pl" | "perl" -> PL Perl (* could be prolog too *)
   | "py" -> PL Python
   | "rb" -> PL Ruby

diff --git a/commons/file_type.mli b/commons/file_type.mli
@@ -10,12 +10,10 @@ type file_type =
   | Other of string
 
  and pl_type = 
-  | ML of string | Haskell of string
+  | ML of string | Haskell of string | Lisp of lisp_type
   | Makefile
   | Script of string
   | C | Cplusplus | Java | Csharp
-  | Scheme | Lisp 
-  | Elisp
   | Perl | Python | Ruby
   | Erlang
   | Beta
@@ -25,6 +23,8 @@ type file_type =
   | Thrift
   | MiscPL of string
 
+   and lisp_type = CommonLisp | Elisp | Scheme
+
    and webpl_type = 
      | Php of string
      | Js

diff --git a/lang_lisp/parsing/lexer_lisp.mll b/lang_lisp/parsing/lexer_lisp.mll
@@ -49,7 +49,6 @@ let symbol =
   ['-' '+' '=' '~'  '.'  ',' '/' ':' '<' '>' '*' ';' '#' 
      '_'  '?' '^' '|' '!' '&' ] 
 (*
-'\''
 '\\'
 '@'
 '"'
@@ -75,6 +74,15 @@ rule token = parse
   | '(' { TOParen (tokinfo lexbuf) } | ')' { TCParen (tokinfo lexbuf) }
   | "[" { TOBracket(tokinfo lexbuf) }  | "]" { TCBracket(tokinfo lexbuf) }
 
+  | '\'' { TQuote (tokinfo lexbuf) }
+  (* special rule for symbols e.g. 'foo ? or because '(foo) is also
+   * valid just let the parser differentiate those different quoted
+   * things ?
+   *)
+  | '`'  { TBackQuote (tokinfo lexbuf) }
+  | ','  { TComma (tokinfo lexbuf) }
+  | '@'  { TAt (tokinfo lexbuf) }
+
   (* ----------------------------------------------------------------------- *)
   (* Strings *)
   (* ----------------------------------------------------------------------- *)

diff --git a/lang_lisp/parsing/parse_lisp.ml b/lang_lisp/parsing/parse_lisp.ml
@@ -28,6 +28,13 @@ module TH = Parser_lisp
 (* Prelude *)
 (*****************************************************************************)
 
+(* 
+ * alt: 
+ *  - Could reuse the parser in ocamlsexp ? but they just have Atom | Sexp
+ *    and I need to differentiate numbers in the highlighter, and
+ *    also handling quoted, anti-quoted and other lisp special things.
+ *)
+
 (*****************************************************************************)
 (* Types *)
 (*****************************************************************************)

diff --git a/lang_lisp/parsing/parser_lisp.ml b/lang_lisp/parsing/parser_lisp.ml
@@ -33,6 +33,12 @@ type token =
   | TOBracket of (Ast_lisp.info)
   | TCBracket of (Ast_lisp.info)
 
+  | TQuote of (Ast_lisp.info)
+  (* anti-quote expressions tokens, as in `(foo ,v ,@xs) *)
+  | TBackQuote of (Ast_lisp.info)
+  | TComma  of (Ast_lisp.info)
+  | TAt  of (Ast_lisp.info)
+
   | TUnknown of (Ast_lisp.info)
   | EOF of (Ast_lisp.info)
 
@@ -69,6 +75,11 @@ let visitor_info_of_tok f = function
   | TOBracket ii -> TOBracket (f ii)
   | TCBracket ii -> TCBracket (f ii)
 
+  | TQuote ii -> TQuote (f ii)
+  | TBackQuote ii -> TBackQuote (f ii)
+  | TComma ii -> TComma (f ii)
+  | TAt ii -> TAt (f ii)
+
   | TUnknown ii -> TUnknown (f ii)
   | EOF ii -> EOF (f ii)
 

diff --git a/lang_lisp/parsing/test_parsing_lisp.ml b/lang_lisp/parsing/test_parsing_lisp.ml
@@ -11,8 +11,10 @@ open OUnit
 (*****************************************************************************)
 
 let test_tokens_lisp file = 
-  if not (file =~ ".*\\.nw") 
-  then pr2 "warning: seems not a noweb file";
+  (match File_type.file_type_of_file file with
+  | File_type.PL (File_type.Lisp _) -> ()
+  | _ -> pr2 "warning: seems not a lisp file";
+  );
 
   Flag.verbose_lexing := true;
   Flag.verbose_parsing := true;

diff --git a/tests/lisp/backquote.lisp b/tests/lisp/backquote.lisp
@@ -0,0 +1,4 @@
+
+(setq bar '(1 2 3))
+
+(setq foo `(this is a ,bar and ,@bar))