Commit 44f030a7 authored by Pietro Abate's avatar Pietro Abate

[r2005-06-13 12:08:21 by afrisch] Nested OCaml modules

Original author: afrisch
Date: 2005-06-13 12:08:21+00:00
parent 38c16cdb
......@@ -504,24 +504,8 @@ let rec expr env loc = function
let (fv1,e1) = expr env loc e1 and (fv2,e2) = expr env loc e2 in
let n = if env.keep_ns then Some env.ns else None in
exp loc (Fv.cup fv1 fv2) (Typed.Xml (e1,e2,n))
| Dot (LocatedExpr (_,Var cu), id, tyargs) when not (has_value cu env) ->
(match find_cu loc cu env with
| ECDuce cu ->
if tyargs != [] then
error loc "CDuce externals cannot have type argument";
let id = ident env loc id in
let t = find_value_global loc cu id env in
exp loc Fv.empty (Typed.ExtVar (cu, id, t))
| EOCaml cu ->
extern loc env (cu ^ "." ^ U.get_str id) tyargs
(* TODO: allow nested OCaml modules A.B.C.x *)
| ESchema _ ->
error loc "Schema don't export values")
| Dot (e,l,[]) ->
let (fv,e) = expr env loc e in
exp loc fv (Typed.Dot (e,parse_label env loc l))
| Dot (_,_,_::_) ->
error loc "Field access cannot have type arguments"
| Dot _ as e ->
dot loc env e
| RemoveField (e,l) ->
let (fv,e) = expr env loc e in
exp loc fv (Typed.RemoveField (e,parse_label env loc l))
......@@ -588,6 +572,39 @@ and if_then_else loc cond yes no =
Typed.br_accept = Builtin_defs.bool;
} in
exp' loc (Typed.Match (cond,b))
and dot loc env e =
let dot_access loc (fv,e) l =
exp loc fv (Typed.Dot (e,parse_label env loc l)) in
let rec aux loc fields args = function
| Var cu when not (has_value cu env) ->
(match find_cu loc cu env with
| ECDuce cu ->
if args != [] then
error loc "CDuce externals cannot have type argument";
let id,fields =
(match fields with (hd,_)::tl -> hd,tl | _ -> assert false) in
let id = ident env loc id in
let t = find_value_global loc cu id env in
let e = exp loc Fv.empty (Typed.ExtVar (cu, id, t)) in
List.fold_left (fun e (x,loc) -> dot_access loc e x) e fields
| EOCaml cu ->
let fields = List.map fst fields in
let s = String.concat "." (cu :: List.map U.get_str fields) in
extern loc env s args
| ESchema _ ->
error loc "Schema don't export values")
| LocatedExpr (loc,e) -> aux loc fields args e
| Dot (e,id,a) -> aux loc ((id,loc) :: fields) (a @ args) e
| e ->
if args != [] then
error loc "Field access cannot have type arguments"
else
let e = expr env loc e in
List.fold_left (fun e (x,loc) -> dot_access loc e x) e fields
in
aux loc [] [] e
and extern loc env s args =
let args = List.map (typ env) args in
......
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