Skip to content

Commit

Permalink
compile
Browse files Browse the repository at this point in the history
  • Loading branch information
Jun FURUSE committed Jul 26, 2011
1 parent 68a814a commit 929a732
Show file tree
Hide file tree
Showing 6 changed files with 31 additions and 32 deletions.
1 change: 1 addition & 0 deletions ocamlspot/ocaml.ml
View file
Expand Up @@ -16,3 +16,4 @@
module Ident = Ident module Ident = Ident
module Path = Path module Path = Path
module Format = Utils.Format module Format = Utils.Format
module Env = Env
2 changes: 1 addition & 1 deletion ocamlspot/spot.ml
View file
Expand Up @@ -305,7 +305,7 @@ module Kind = struct
| "ct" | "class_type" -> Class_type | "ct" | "class_type" -> Class_type
| _ -> raise Not_found | _ -> raise Not_found


(* CR jfuruse: DUP *) (* CR jfuruse: DUP (kident_of_sigitem in include_coercion) *)
let kidents_of_mty env mty = let kidents_of_mty env mty =
let open Typedtree in let open Typedtree in
let open Types in let open Types in
Expand Down
39 changes: 18 additions & 21 deletions ocamlspot/spoteval.ml
View file
Expand Up @@ -44,10 +44,10 @@ module Value : sig
| Module_type of Typedtree.module_type | Module_type of Typedtree.module_type


type t = type t =
| Ident of PIdent.t * TypeEnv.t | Ident of PIdent.t
| Structure of PIdent.t * structure * structure option (* sig part *) * TypeEnv.t | Structure of PIdent.t * structure * structure option (* sig part *) * TypeEnv.t
| Closure of PIdent.t * env * Ident.t * module_expr_or_type * TypeEnv.t | Closure of PIdent.t * env * Ident.t * module_expr_or_type * TypeEnv.t
| Parameter of PIdent.t * TypeEnv.t | Parameter of PIdent.t
| Error of exn | Error of exn


and structure = structure_item list and structure = structure_item list
Expand Down Expand Up @@ -106,10 +106,10 @@ end = struct
| Module_type of Typedtree.module_type | Module_type of Typedtree.module_type


type t = type t =
| Ident of PIdent.t * TypeEnv.t | Ident of PIdent.t
| Structure of PIdent.t * structure * structure option (* sig part *) * TypeEnv.t | Structure of PIdent.t * structure * structure option (* sig part *) * TypeEnv.t
| Closure of PIdent.t * env * Ident.t * module_expr_or_type * TypeEnv.t | Closure of PIdent.t * env * Ident.t * module_expr_or_type * TypeEnv.t
| Parameter of PIdent.t * TypeEnv.t | Parameter of PIdent.t
| Error of exn | Error of exn


and structure = structure_item list and structure = structure_item list
Expand Down Expand Up @@ -162,8 +162,7 @@ end = struct
items := items :=
(id, (id,
(kind, eager (Ident ({ PIdent.filepath = ""; (kind, eager (Ident ({ PIdent.filepath = "";
ident = Some id }, ident = Some id } ))))
TypeEnv.initial))))
:: !items :: !items
in in
Predef.build_initial_env Predef.build_initial_env
Expand Down Expand Up @@ -206,8 +205,8 @@ end = struct
open Format open Format


let rec t ppf = function let rec t ppf = function
| Ident (id, _) -> fprintf ppf "Ident(%a)" PIdent.format id | Ident id -> fprintf ppf "Ident(%a)" PIdent.format id
| Parameter (id, _) -> fprintf ppf "Parameter(%a)" PIdent.format id | Parameter id -> fprintf ppf "Parameter(%a)" PIdent.format id
| Structure (pid, str, None, _) -> | Structure (pid, str, None, _) ->
fprintf ppf "@[<v2>Structure(%a)@ %a None@]" fprintf ppf "@[<v2>Structure(%a)@ %a None@]"
PIdent.format pid PIdent.format pid
Expand Down Expand Up @@ -283,7 +282,7 @@ module Eval = struct
let str_of_global_ident = ref (fun ~load_paths:_ _ -> assert false : load_paths: string list -> Ident.t -> string * Value.structure) let str_of_global_ident = ref (fun ~load_paths:_ _ -> assert false : load_paths: string list -> Ident.t -> string * Value.structure)
let packed = ref (fun _ _ -> assert false : Env.t -> string -> Value.t) let packed = ref (fun _ _ -> assert false : Env.t -> string -> Value.t)


let z_of_id tenv env id = eager (Ident ({ PIdent.filepath = env.Env.path; ident = Some id }, tenv)) let z_of_id env id = eager (Ident { PIdent.filepath = env.Env.path; ident = Some id })


let rec find_path env (kind, p) : Value.z = let rec find_path env (kind, p) : Value.z =
match p with match p with
Expand Down Expand Up @@ -338,7 +337,7 @@ module Eval = struct
lazy begin lazy begin
match !!(find_path env (Kind.Module, p)) with match !!(find_path env (Kind.Module, p)) with
| Ident _ -> (try assert false with e -> Error e) | Ident _ -> (try assert false with e -> Error e)
| Parameter (pid, tenv) -> Parameter (pid, tenv) | Parameter pid -> Parameter pid
| Closure _ -> (try assert false with e -> Error e) | Closure _ -> (try assert false with e -> Error e)
| Error exn -> Error exn | Error exn -> Error exn
| Structure (pid, str, _ (* CR jfuruse *), _tenv) -> | Structure (pid, str, _ (* CR jfuruse *), _tenv) ->
Expand Down Expand Up @@ -428,9 +427,8 @@ module Eval = struct
(* expand internal Include and get alist by Ident.t *) (* expand internal Include and get alist by Ident.t *)
(* the list order is REVERSED and is last-defined-first, (* the list order is REVERSED and is last-defined-first,
but it is REQUIRED for environment query *) but it is REQUIRED for environment query *)
and structure tenv env0 str : Value.structure = and structure _tenv env0 str : Value.structure =


let z_of_id = z_of_id tenv in
List.fold_left (fun str sitem -> List.fold_left (fun str sitem ->
match sitem.str_desc with match sitem.str_desc with
| Tstr_eval _ -> str | Tstr_eval _ -> str
Expand Down Expand Up @@ -513,8 +511,8 @@ module Eval = struct
match v_mexp with match v_mexp with
| Structure (_, str, _ (* CR jfuruse *), _) -> | Structure (_, str, _ (* CR jfuruse *), _) ->
List.map (fun (id, (k, v)) -> (k, Ocaml.Ident.name id), v) str List.map (fun (id, (k, v)) -> (k, Ocaml.Ident.name id), v) str
| Parameter (pid, tenv) -> | Parameter pid ->
List.map (fun (k,_,id) -> (k, Ocaml.Ident.name id), eager (Parameter (pid, tenv))) kids List.map (fun (k,_,id) -> (k, Ocaml.Ident.name id), eager (Parameter pid)) kids
| Ident _ -> assert false | Ident _ -> assert false
| Closure _ -> assert false | Closure _ -> assert false
| Error _ -> [] (* error *) | Error _ -> [] (* error *)
Expand All @@ -534,9 +532,8 @@ module Eval = struct
in in
str' @ str) [] str.str_items str' @ str) [] str.str_items


and signature tenv env0 sg : Value.structure = and signature _tenv env0 sg : Value.structure =


let z_of_id = z_of_id tenv in
List.fold_left (fun str sitem -> List.fold_left (fun str sitem ->
match sitem.sig_desc with match sitem.sig_desc with
| Tsig_open _ -> str | Tsig_open _ -> str
Expand Down Expand Up @@ -603,8 +600,8 @@ module Eval = struct
match v_mexp with match v_mexp with
| Structure (_, str, _ (* CR jfuruse *), _) -> | Structure (_, str, _ (* CR jfuruse *), _) ->
List.map (fun (id, (k, v)) -> (k, Ocaml.Ident.name id), v) str List.map (fun (id, (k, v)) -> (k, Ocaml.Ident.name id), v) str
| Parameter (pid, tenv) -> | Parameter pid ->
List.map (fun (k,id) -> (k, Ocaml.Ident.name id), eager (Parameter (pid, tenv))) kids List.map (fun (k,id) -> (k, Ocaml.Ident.name id), eager (Parameter pid)) kids
| Ident _ -> assert false | Ident _ -> assert false
| Closure _ -> assert false | Closure _ -> assert false
| Error _ -> [] (* error *) | Error _ -> [] (* error *)
Expand All @@ -627,7 +624,7 @@ module Eval = struct
and apply v1 v2 = and apply v1 v2 =
lazy begin match !!v1 with lazy begin match !!v1 with
| Ident _ -> assert false | Ident _ -> assert false
| Parameter (pid, tenv) -> Parameter (pid, tenv) | Parameter pid -> Parameter pid
| Structure _ -> assert false | Structure _ -> assert false
| Error exn -> Error exn | Error exn -> Error exn
| Closure (_, env, id, mexp_or_mty, _tenv) -> | Closure (_, env, id, mexp_or_mty, _tenv) ->
Expand All @@ -652,7 +649,7 @@ module Eval = struct
let z = lazy begin let z = lazy begin
let str = let str =
match !!(module_expr env None mexp) with match !!(module_expr env None mexp) with
| Structure (_pid, str, _) -> str | Structure (_pid, str, _, _) -> str
| _ -> assert false | _ -> assert false
in in
!!(find_ident str (k, Ocaml.Ident.name id', Ocaml.Ident.binding_time id')) !!(find_ident str (k, Ocaml.Ident.name id', Ocaml.Ident.binding_time id'))
Expand All @@ -663,7 +660,7 @@ module Eval = struct
let z = lazy begin let z = lazy begin
let str = let str =
match !!(module_type env None mty) with match !!(module_type env None mty) with
| Structure (_pid, str, _) -> str | Structure (_pid, str, _, _) -> str
| _ -> assert false | _ -> assert false
in in
!!(find_ident str (k, Ocaml.Ident.name id, Ocaml.Ident.binding_time id)) !!(find_ident str (k, Ocaml.Ident.name id, Ocaml.Ident.binding_time id))
Expand Down
10 changes: 5 additions & 5 deletions ocamlspot/spoteval.mli
View file
Expand Up @@ -28,10 +28,10 @@ module Value : sig


type t = type t =
| Ident of PIdent.t | Ident of PIdent.t
| Structure of PIdent.t * structure * structure option | Structure of PIdent.t * structure * structure option (* sig part *) * Ocaml.Env.t
| Closure of PIdent.t * env * Ident.t * module_expr_or_type | Closure of PIdent.t * env * Ident.t * module_expr_or_type * Ocaml.Env.t
| Parameter of PIdent.t | Parameter of PIdent.t
| Error of exn | Error of exn


and structure = structure_item list and structure = structure_item list


Expand Down Expand Up @@ -116,8 +116,8 @@ module Eval : sig
Ident.t option -> Ident.t option ->
Value.module_expr_or_type -> Value.z Value.module_expr_or_type -> Value.z


val structure : Env.t -> Typedtree.structure -> Value.structure val structure : Ocaml.Env.t -> Env.t -> Typedtree.structure -> Value.structure
val signature : Env.t -> Typedtree.signature -> Value.structure val signature : Ocaml.Env.t -> Env.t -> Typedtree.signature -> Value.structure


val apply : Value.z -> Value.z -> Value.z val apply : Value.z -> Value.z -> Value.z


Expand Down
10 changes: 5 additions & 5 deletions ocamlspot/spotfile.ml
View file
Expand Up @@ -372,8 +372,8 @@ module Make(Spotconfig : Spotconfig_intf.S) = struct
match v with match v with
| Value.Ident id -> id, find_loc id | Value.Ident id -> id, find_loc id
| Value.Parameter id -> id, find_loc id | Value.Parameter id -> id, find_loc id
| Value.Structure (id, _, _) -> id, find_loc id | Value.Structure (id, _, _, _) -> id, find_loc id
| Value.Closure (id, _, _, _) -> id, find_loc id | Value.Closure (id, _, _, _, _) -> id, find_loc id
| Value.Error (Failure _ as e) -> raise e | Value.Error (Failure _ as e) -> raise e
| Value.Error (Load.Old_spot _ as exn) -> raise exn | Value.Error (Load.Old_spot _ as exn) -> raise exn
| Value.Error exn -> raise exn | Value.Error exn -> raise exn
Expand All @@ -384,10 +384,10 @@ module Make(Spotconfig : Spotconfig_intf.S) = struct
let structure = let structure =
match file.top with (* The only use of .top *) match file.top with (* The only use of .top *)
| Some (Saved_type (Typedtree.Saved_implementation str)) -> | Some (Saved_type (Typedtree.Saved_implementation str)) ->
Eval.structure (empty_env file) str Eval.structure Ocaml.Env.initial (* XXX *) (empty_env file) str


| Some (Saved_type (Typedtree.Saved_signature sg)) -> | Some (Saved_type (Typedtree.Saved_signature sg)) ->
Eval.signature (empty_env file) sg Eval.signature Ocaml.Env.initial (empty_env file) sg


| Some (Packed paths) -> | Some (Packed paths) ->
let id_strs = let id_strs =
Expand All @@ -399,7 +399,7 @@ module Make(Spotconfig : Spotconfig_intf.S) = struct
) paths ) paths
in in
List.map (fun (id, pident, str) -> List.map (fun (id, pident, str) ->
id, (Kind.Module, eager (Value.Structure (pident, str, None)))) id_strs id, (Kind.Module, eager (Value.Structure (pident, str, None, Ocaml.Env.initial)))) id_strs
| Some _ -> assert false | Some _ -> assert false
| None -> assert false | None -> assert false
in in
Expand Down
1 change: 1 addition & 0 deletions ocamlspot/tests/Makefile.targets
View file
Expand Up @@ -12,6 +12,7 @@ exception.cmo \
external.cmo \ external.cmo \
external_include.cmo \ external_include.cmo \
fstclassmodule.cmo \ fstclassmodule.cmo \
fstclassmodule2.cmo \
functor.cmo \ functor.cmo \
functor_parameter.cmo \ functor_parameter.cmo \
immediate_include.cmo \ immediate_include.cmo \
Expand Down

0 comments on commit 929a732

Please sign in to comment.