-
-let initial_level1_pattern_lexer () = mk_lexer level1_pattern_token
-let initial_level2_ast_lexer () = mk_lexer level2_ast_token
-let initial_level2_meta_lexer () = mk_lexer level2_meta_token
-
-
-let level1_pattern_lexer_ref = ref (initial_level1_pattern_lexer ())
-let level2_ast_lexer_ref = ref (initial_level2_ast_lexer ())
-let level2_meta_lexer_ref = ref (initial_level2_meta_lexer ())
-
-let level1_pattern_lexer () = !level1_pattern_lexer_ref
-let level2_ast_lexer () = !level2_ast_lexer_ref
-let level2_meta_lexer () = !level2_meta_lexer_ref
-
-let history = ref [];;
-
-let push () =
- history :=
- (!level2_ast_keywords,!level1_pattern_lexer_ref,
- !level2_ast_lexer_ref,!level2_meta_lexer_ref) :: !history;
- level2_ast_keywords := initial_level2_ast_keywords ();
- initialize_keywords ();
- level1_pattern_lexer_ref := initial_level1_pattern_lexer ();
- level2_ast_lexer_ref := initial_level2_ast_lexer ();
- level2_meta_lexer_ref := initial_level2_meta_lexer ();
-;;
-
-let pop () =
- match !history with
- | [] -> assert false
- | (kwd,pl,al,ml) :: tl ->
- level2_ast_keywords := kwd;
- level1_pattern_lexer_ref := pl;
- level2_ast_lexer_ref := al;
- level2_meta_lexer_ref := ml;
- history := tl
+type lexers = {
+ level1_pattern_lexer : (string * string) Token.glexer;
+ level2_ast_lexer : (string * string) Token.glexer;
+ level2_meta_lexer : (string * string) Token.glexer
+}
+
+let mk_lexers keywords =
+ let initial_keywords =
+ [ "CProp"; "Prop"; "Type"; "Set"; "let"; "match";
+ "with"; "in"; "and"; "to"; "as"; "on"; "return"; "done" ]
+ in
+ let status =
+ List.fold_right StringSet.add (initial_keywords @ keywords) StringSet.empty
+ in
+ {
+ level1_pattern_lexer = mk_lexer level1_pattern_token;
+ level2_ast_lexer = mk_lexer (level2_ast_token status);
+ level2_meta_lexer = mk_lexer level2_meta_token
+ }