From 0c1bfabbd4bfb39e63f379b9ce42d78dfa233826 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sat, 20 Jun 2015 10:00:39 -0400 Subject: [PATCH] move ast_filters into original syntax --- src/cold/ast_filters.ml | 101 +++++++++++++++++++------------------- src/main/ast_filters.ml | 53 +------------------- src/main/ast_filters.mli | 40 +-------------- src/main/ast_quotation.ml | 7 ++- src/main/test.sh | 5 ++ 5 files changed, 62 insertions(+), 144 deletions(-) mode change 100644 => 120000 src/main/ast_filters.ml mode change 100644 => 120000 src/main/ast_filters.mli create mode 100755 src/main/test.sh diff --git a/src/cold/ast_filters.ml b/src/cold/ast_filters.ml index cfe20d89..97694117 100644 --- a/src/cold/ast_filters.ml +++ b/src/cold/ast_filters.ml @@ -1,53 +1,52 @@ + open Util -open Astf +open Astf + type key = string -type 'a filter = 'a -> 'a -let interf_filters: (key,sigi filter) Hashtbl.t = Hashtbl.create 40 -let implem_filters: (key,stru filter) Hashtbl.t = Hashtbl.create 40 -let topphrase_filters: (key,stru filter) Hashtbl.t = Hashtbl.create 40 -let applied_interf_filters: (string* sigi filter) Queue.t = Queue.create () -let applied_implem_filters: (string* stru filter) Queue.t = Queue.create () -let applied_topphrase_filters: (string* stru filter) Queue.t = - Queue.create () -let apply_interf_filters = - function - | i -> - Queue.fold (function | ast -> (function | (_name,f) -> f ast)) i - applied_interf_filters -let apply_implem_filters = - function - | i -> - Queue.fold (function | ast -> (function | (_name,f) -> f ast)) i - applied_implem_filters -let apply_topphrase_filters = - function - | i -> - Queue.fold (function | ast -> (function | (_name,f) -> f ast)) i - applied_topphrase_filters -let use_interf_filter = - function - | s -> - let u = - try Hashtbl.find interf_filters s - with | Not_found -> failwithf "filter %s is not registered" s in - Queue.add (s, u) applied_interf_filters -let use_implem_filter = - function - | s -> - let u = - try Hashtbl.find implem_filters s - with | Not_found -> failwithf "filter %s is not registered" s in - Queue.add (s, u) applied_implem_filters -let use_topphrase_filter = - function - | s -> - let u = - try Hashtbl.find topphrase_filters s - with | Not_found -> failwithf "filter %s is not registered" s in - Queue.add (s, u) applied_topphrase_filters -let register_sigi_filter = - function | (k,f) -> Hashtbl.replace interf_filters k f -let register_stru_filter = - function | (k,f) -> Hashtbl.replace implem_filters k f -let register_topphrase_filter = - function | (k,f) -> Hashtbl.replace topphrase_filters k f +type 'a filter = 'a -> 'a + + +let interf_filters: ( key, sigi filter ) Hashtbl.t = Hashtbl.create 40 +let implem_filters: (key, stru filter ) Hashtbl.t = Hashtbl.create 40 + +let topphrase_filters: (key, stru filter ) Hashtbl.t = Hashtbl.create 40 + +let applied_interf_filters: (string * sigi filter ) Queue.t = Queue.create () +let applied_implem_filters: (string * stru filter ) Queue.t = Queue.create () +let applied_topphrase_filters: (string * stru filter ) Queue.t = Queue.create () + +let apply_interf_filters i = + Queue.fold (fun ast (_name,f) -> f ast) i applied_interf_filters +let apply_implem_filters i = + Queue.fold (fun ast (_name,f) -> f ast) i applied_implem_filters +let apply_topphrase_filters i = + Queue.fold (fun ast (_name,f) -> f ast) i applied_topphrase_filters + +let use_interf_filter s = + let u = + try Hashtbl.find interf_filters s + with Not_found -> failwithf "filter %s is not registered" s in + Queue.add (s,u) applied_interf_filters + +let use_implem_filter s = + let u = + try Hashtbl.find implem_filters s + with Not_found -> failwithf "filter %s is not registered" s in + Queue.add (s,u) applied_implem_filters + +let use_topphrase_filter s = + let u = + try Hashtbl.find topphrase_filters s + with Not_found -> failwithf "filter %s is not registered" s in + Queue.add (s,u) applied_topphrase_filters + +let register_sigi_filter (k,f) = + Hashtbl.replace interf_filters k f + +let register_stru_filter (k,f) = + Hashtbl.replace implem_filters k f + + +let register_topphrase_filter (k,f) = + Hashtbl.replace topphrase_filters k f + diff --git a/src/main/ast_filters.ml b/src/main/ast_filters.ml deleted file mode 100644 index 97694117..00000000 --- a/src/main/ast_filters.ml +++ /dev/null @@ -1,52 +0,0 @@ - -open Util -open Astf - -type key = string -type 'a filter = 'a -> 'a - - -let interf_filters: ( key, sigi filter ) Hashtbl.t = Hashtbl.create 40 -let implem_filters: (key, stru filter ) Hashtbl.t = Hashtbl.create 40 - -let topphrase_filters: (key, stru filter ) Hashtbl.t = Hashtbl.create 40 - -let applied_interf_filters: (string * sigi filter ) Queue.t = Queue.create () -let applied_implem_filters: (string * stru filter ) Queue.t = Queue.create () -let applied_topphrase_filters: (string * stru filter ) Queue.t = Queue.create () - -let apply_interf_filters i = - Queue.fold (fun ast (_name,f) -> f ast) i applied_interf_filters -let apply_implem_filters i = - Queue.fold (fun ast (_name,f) -> f ast) i applied_implem_filters -let apply_topphrase_filters i = - Queue.fold (fun ast (_name,f) -> f ast) i applied_topphrase_filters - -let use_interf_filter s = - let u = - try Hashtbl.find interf_filters s - with Not_found -> failwithf "filter %s is not registered" s in - Queue.add (s,u) applied_interf_filters - -let use_implem_filter s = - let u = - try Hashtbl.find implem_filters s - with Not_found -> failwithf "filter %s is not registered" s in - Queue.add (s,u) applied_implem_filters - -let use_topphrase_filter s = - let u = - try Hashtbl.find topphrase_filters s - with Not_found -> failwithf "filter %s is not registered" s in - Queue.add (s,u) applied_topphrase_filters - -let register_sigi_filter (k,f) = - Hashtbl.replace interf_filters k f - -let register_stru_filter (k,f) = - Hashtbl.replace implem_filters k f - - -let register_topphrase_filter (k,f) = - Hashtbl.replace topphrase_filters k f - diff --git a/src/main/ast_filters.ml b/src/main/ast_filters.ml new file mode 120000 index 00000000..e4b0fdc3 --- /dev/null +++ b/src/main/ast_filters.ml @@ -0,0 +1 @@ +../cold/ast_filters.ml \ No newline at end of file diff --git a/src/main/ast_filters.mli b/src/main/ast_filters.mli deleted file mode 100644 index a9c3feba..00000000 --- a/src/main/ast_filters.mli +++ /dev/null @@ -1,39 +0,0 @@ - -(** manage filters in fan *) -open Astf - -type 'a filter = 'a -> 'a - -type key = string - -val interf_filters : (key, sigi filter) Hashtbl.t - -val implem_filters : (key, stru filter) Hashtbl.t - -val topphrase_filters : (key, stru filter) Hashtbl.t - -val applied_interf_filters : (key * sigi filter) Queue.t - -val applied_implem_filters : (key * stru filter) Queue.t - -val applied_topphrase_filters : (key * stru filter) Queue.t - - -val apply_interf_filters : sigi -> sigi - -val apply_implem_filters : stru -> stru - -val apply_topphrase_filters : stru -> stru - - -val use_interf_filter : key -> unit - -val use_implem_filter : key -> unit - -val use_topphrase_filter : key -> unit - -val register_sigi_filter : key * sigi filter -> unit - -val register_stru_filter : key * stru filter -> unit - -val register_topphrase_filter : key * stru filter -> unit diff --git a/src/main/ast_filters.mli b/src/main/ast_filters.mli new file mode 120000 index 00000000..ec81e7cd --- /dev/null +++ b/src/main/ast_filters.mli @@ -0,0 +1 @@ +../cold/ast_filters.mli \ No newline at end of file diff --git a/src/main/ast_quotation.ml b/src/main/ast_quotation.ml index 53ab3b3b..bb9876e4 100644 --- a/src/main/ast_quotation.ml +++ b/src/main/ast_quotation.ml @@ -1,6 +1,6 @@ - +(* %import{ Format: pp_print_string @@ -8,7 +8,10 @@ Format: fprintf ; };; - +*) +let pp_print_string = Format.pp_print_string +let bprintf = Format.bprintf +let fprintf = Format.fprintf (** [parse_quotation_result parse_function loc position_tag quotation quotation_result] It's a parser wrapper, this function handles the error reporting for you. *) diff --git a/src/main/test.sh b/src/main/test.sh new file mode 100755 index 00000000..ebb219c1 --- /dev/null +++ b/src/main/test.sh @@ -0,0 +1,5 @@ +#!/bin/sh +# echo $1 +mv -f $1.ml $1.mli ../cold/ +ln -s ../cold/$1.ml +ln -s ../cold/$1.mli