Commit 8535f6b3 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-05-05 21:14:46 by afrisch] New semantics for 'using'

Original author: afrisch
Date: 2004-05-05 21:14:47+00:00
parent ea45944e
......@@ -194,6 +194,9 @@ let namespace (tenv,cenv,codes) pr ns =
let tenv = Typer.enter_ns pr ns tenv in
(tenv,cenv,codes)
let find_cu (tenv,_,_) cu =
Typer.find_cu cu tenv
let using (tenv,cenv,codes) x cu =
let tenv = Typer.enter_cu x cu tenv in
(tenv,cenv,codes)
......@@ -222,6 +225,7 @@ let rec phrases ~run ~show ~loading ~directive =
| { descr = Ast.Namespace (pr,ns) } :: rest ->
loop (namespace accu pr ns) rest
| { descr = Ast.Using (x,cu) } :: rest ->
let cu = find_cu accu cu in
loading cu;
loop (using accu x cu) rest
| { descr = Ast.EvalStatement e } :: rest ->
......
......@@ -121,6 +121,10 @@ let rec print_exn ppf = function
| Typer.UnboundId (x,tn) ->
Format.fprintf ppf "Unbound identifier %a%s@." U.print (Id.value x)
(if tn then " (it is a type name)" else "")
| Typer.UnboundExtId (cu,x) ->
Format.fprintf ppf "Unbound external identifier %a:%a@."
U.print (Types.CompUnit.value cu)
U.print (Id.value x)
| Ulexer.Error (i,j,s) ->
let loc = Location.loc_of_pos (i,j), `Full in
Format.fprintf ppf "Error %a:@." Location.print_loc loc;
......
(* Abstract syntax as produced by the parsed *)
(* Abstract syntax as produced by the parser *)
open Location
open Ident
......@@ -12,7 +12,7 @@ and pmodule_item' =
| LetDecl of ppat * pexpr
| FunDecl of pexpr
| Namespace of U.t * Ns.t
| Using of U.t * Types.CompUnit.t
| Using of U.t * U.t
| EvalStatement of pexpr
| Directive of toplevel_directive
and debug_directive =
......
......@@ -108,8 +108,8 @@ EXTEND
| (_,p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
[ mk loc (EvalStatement (exp loc (Match (e1,[p,e2])))) ]
| "type"; x = IDENT; "="; t = pat -> [ mk loc (TypeDecl (ident x,t)) ]
| "using"; name = IDENT; "="; cu = STRING2 ->
[ mk loc (Using (U.mk name, Types.CompUnit.mk (U.mk cu))) ]
| "using"; name = IDENT; "="; cu = [ IDENT | STRING2 ] ->
[ mk loc (Using (U.mk name, U.mk cu)) ]
| "schema"; name = IDENT; "="; uri = STRING2 ->
protect_op "schema";
let schema = match Url.process uri with
......@@ -192,7 +192,7 @@ EXTEND
| "if" | "then" | "else"
| "transform" | "fun" | "in"
| "let" | "type" | "debug" | "include"
| "and" | "validate" | "schema" | "namespace" | "ref" | "using"
| "and" | "validate" | "schema" | "namespace" | "ref" | "alias"
| "not" | "as"
]
-> a
......
......@@ -20,10 +20,12 @@ type item =
| Type of Types.t
| Val of Types.t
module UEnv = Map.Make(U)
type t = {
ids : item Env.t;
ns: Ns.table;
cu: Types.CompUnit.t Env.t;
cu: Types.CompUnit.t UEnv.t;
}
let hash _ = failwith "Typer.hash"
......@@ -50,25 +52,23 @@ let deserialize s =
let ids =
Serialize.Get.env Id.deserialize deserialize_item Env.add Env.empty s in
let ns = Ns.deserialize_table s in
{ ids = ids; ns = ns; cu = Env.empty }
{ ids = ids; ns = ns; cu = UEnv.empty }
let empty_env = {
ids = Env.empty;
ns = Ns.empty_table;
cu = Env.empty;
cu = UEnv.empty;
}
let from_comp_unit = ref (fun cu -> assert false)
let enter_cu x cu env =
{ env with cu = Env.add (ident x) cu env.cu }
{ env with cu = UEnv.add x cu env.cu }
let find_cu loc x env =
try Env.find x env.cu
with Not_found ->
raise_loc_generic loc
("Unbound compunit prefix " ^ (Ident.to_string x))
let find_cu x env =
try UEnv.find x env.cu
with Not_found -> Types.CompUnit.mk x
let enter_type id t env =
......@@ -82,7 +82,7 @@ let find_type id env =
| Val _ -> raise Not_found
let find_type_global loc cu id env =
let cu = find_cu loc cu env in
let cu = find_cu cu env in
let env = !from_comp_unit cu in
find_type id env
......@@ -173,6 +173,7 @@ exception ShouldHave of Types.descr * string
exception ShouldHave2 of Types.descr * string * Types.descr
exception WrongLabel of Types.descr * label
exception UnboundId of id * bool
exception UnboundExtId of Types.CompUnit.t * id
exception Error of string
let raise_loc loc exn = raise (Location (loc,`Full,exn))
......@@ -493,7 +494,7 @@ let rec derecurs env p = match p.descr with
with Not_found -> PCapture v)
| cu, v ->
try
let cu = ident (U.mk cu) in
let cu = U.mk cu in
PType (find_type_global p.loc cu (ident v) env.penv_tenv)
with Not_found ->
raise_loc_generic p.loc
......@@ -842,7 +843,7 @@ let rec expr env loc = function
| "", id -> let id = ident id in
exp loc (Fv.singleton id) (Typed.Var id)
| cu, id ->
let cu = find_cu loc (ident (U.mk cu)) env in
let cu = find_cu (U.mk cu) env in
exp loc Fv.empty (Typed.ExtVar (cu, ident id)))
| Apply (e1,e2) ->
let (fv1,e1) = expr env loc e1 and (fv2,e2) = expr env loc e2 in
......@@ -1101,7 +1102,7 @@ and type_check' loc env e constr precise = match e with
let t =
try find_value_global cu s env
with Not_found ->
raise_loc loc (UnboundId (s, false) ) in
raise_loc loc (UnboundExtId (cu,s) ) in
verify loc t constr
| Cst c ->
verify loc (Types.constant c) constr
......
......@@ -6,6 +6,7 @@ exception Constraint of Types.descr * Types.descr
exception ShouldHave of Types.descr * string
exception WrongLabel of Types.descr * label
exception UnboundId of id * bool
exception UnboundExtId of Types.CompUnit.t * id
exception ShouldHave2 of Types.descr * string * Types.descr
exception Error of string
val warning: loc -> string -> unit
......@@ -22,6 +23,7 @@ val register_types : Types.CompUnit.t -> t -> unit
val enter_ns : U.t -> Ns.t -> t -> t
val enter_cu : U.t -> Types.CompUnit.t -> t -> t
val find_cu : U.t -> t -> Types.CompUnit.t
val enter_value: id -> Types.t -> t -> t
val enter_values: (id * Types.t) list -> t -> t
......
......@@ -144,9 +144,13 @@ and global namespace default <code>namespace "%%...%%"</code>
<li>Schema declaration <code>schema %%name%% = "%%...%%"</code>
(see <local href="manual_schema">XML Schema</local>).</li>
<li>Import external unit <code>using %%name%% = "%%unit%%"</code>:
import a pre-compiled <code>%%unit%%.cdo</code> CDuce unit. Values
and types from this unit can be referred to as <code>%%name%%:%%ident%%</code>
<li>Import external unit <code>using %%name%% = "%%unit%%"</code>
or <code>using %%name%% = %%unit%%</code>:
imports a pre-compiled <code>%%unit%%.cdo</code> CDuce unit. Values
and types from this unit can be referred to as
<code>%%name%%:%%ident%%</code>
instead of
<code>%%unit%%:%%ident%%</code>.
</li>
</ul>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment