Skip to content

AST-27 Desugar objects and functions into let #188

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
nomeata merged 13 commits into from
Feb 28, 2019
Merged

AST-27 Desugar objects and functions into let #188

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
e33f447
Let returns it RHS
rossberg Feb 19, 2019
c860fb0
WIP
rossberg Feb 19, 2019
1b493ab
AST FuncD -> FuncE
rossberg Feb 24, 2019
12ac11f
Remove grammar hacks
rossberg Feb 24, 2019
cef9266
Merge branch 'master' into let
nomeata Feb 27, 2019
ff7d689
Merge remote-tracking branch 'origin/master' into let
nomeata Feb 27, 2019
2e6caa5
Leave note in definedness check that it is too permissive for actors
nomeata Feb 27, 2019
cb960ee
Implement letD using letP
nomeata Feb 27, 2019
abdedf9
Resurrect use-before-define5.as
nomeata Feb 27, 2019
0c3acd6
Update test output
nomeata Feb 27, 2019
9e9dcef
Really update test output
nomeata Feb 27, 2019
5efabdc
Arrange: FuncE, not FuncD
nomeata Feb 28, 2019
d82432c
Jira link
nomeata Feb 28, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 14 additions & 14 deletions src/arrange.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,17 +10,27 @@ let rec exp e = match e.it with
| VarE x -> "VarE" $$ [id x]
| LitE l -> "LitE" $$ [lit !l]
| UnE (ot, uo, e) -> "UnE" $$ [operator_type !ot; unop uo; exp e]
| BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; binop bo; exp e2]
| RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; relop ro; exp e2]
| BinE (ot, e1, bo, e2) -> "BinE" $$ [operator_type !ot; exp e1; binop bo; exp e2]
| RelE (ot, e1, ro, e2) -> "RelE" $$ [operator_type !ot; exp e1; relop ro; exp e2]
| TupE es -> "TupE" $$ List.map exp es
| ProjE (e, i) -> "ProjE" $$ [exp e; Atom (string_of_int i)]
| ObjE (s, i, efs) -> "ObjE" $$ [obj_sort s; id i] @ List.map exp_field efs
| ObjE (s, efs) -> "ObjE" $$ [obj_sort s] @ List.map exp_field efs
| DotE (e, x) -> "DotE" $$ [exp e; id x]
| AssignE (e1, e2) -> "AssignE" $$ [exp e1; exp e2]
| ArrayE (m, es) -> "ArrayE" $$ [mut m] @ List.map exp es
| IdxE (e1, e2) -> "IdxE" $$ [exp e1; exp e2]
| FuncE (x, s, tp, p, t, e') ->
"FuncE" $$ [
Atom (Type.string_of_typ e.note.note_typ);
Atom (sharing s.it);
Atom x] @
List.map typ_bind tp @ [
pat p;
typ t;
exp e'
]
| CallE (e1, ts, e2) -> "CallE" $$ [exp e1] @ List.map typ ts @ [exp e2]
| BlockE (ds) -> "BlockE" $$ List.map dec ds
| BlockE ds -> "BlockE" $$ List.map dec ds
| NotE e -> "NotE" $$ [exp e]
| AndE (e1, e2) -> "AndE" $$ [exp e1; exp e2]
| OrE (e1, e2) -> "OrE" $$ [exp e1; exp e2]
Expand Down Expand Up @@ -146,16 +156,6 @@ and dec d = match d.it with
| ExpD e -> "ExpD" $$ [exp e ]
| LetD (p, e) -> "LetD" $$ [pat p; exp e]
| VarD (x, e) -> "VarD" $$ [id x; exp e]
| FuncD (s, x, tp, p, t, e) ->
"FuncD" $$ [
Atom (Type.string_of_typ d.note.note_typ);
Atom (sharing s.it);
id x] @
List.map typ_bind tp @ [
pat p;
typ t;
exp e
]
| TypD (x, tp, t) ->
"TypD" $$ [id x] @ List.map typ_bind tp @ [typ t]
| ClassD (x, tp, s, p, i', efs) ->
Expand Down
40 changes: 19 additions & 21 deletions src/async.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,21 +68,19 @@ module Transform() = struct
[t1]
(tupE [])
(T.seq (new_async_ret unary t1)) in
let async = fresh_id (typ (projE call_new_async 0)) in
let fullfill = fresh_id (typ (projE call_new_async 1)) in
let async = fresh_var (typ (projE call_new_async 0)) in
let fullfill = fresh_var (typ (projE call_new_async 1)) in
(async,fullfill),call_new_async

let letP p e = {it = LetD(p, e);
at = no_region;
note = {e.note with note_typ = T.unit}}
let letP p e = {it = LetD(p, e); at = no_region; note = e.note}

let new_nary_async_reply t1 =
let (unary_async,unary_fullfill),call_new_async = new_async t1 in
let v' = fresh_id t1 in
let v' = fresh_var t1 in
let ts1 = T.as_seq t1 in
(* construct the n-ary async value, coercing the continuation, if necessary *)
let nary_async =
let k' = fresh_id (contT t1) in
let k' = fresh_var (contT t1) in
match ts1 with
| [t] ->
unary_async
Expand All @@ -95,23 +93,23 @@ module Transform() = struct
let vs,seq_of_vs =
match ts1 with
| [t] ->
let v = fresh_id t in
let v = fresh_var t in
[v],v
| ts ->
let vs = List.map fresh_id ts in
let vs = List.map fresh_var ts in
vs, tupE vs
in
vs -@>* (unary_fullfill -*- seq_of_vs)
in
let async,reply = fresh_id (typ nary_async), fresh_id (typ nary_reply) in
(async,reply),blockE [letP (tupP [varP unary_async;varP unary_fullfill]) call_new_async;
expD (tupE [nary_async;nary_reply])]
let async,reply = fresh_var (typ nary_async), fresh_var (typ nary_reply) in
(async,reply),blockE [letP (tupP [varP unary_async; varP unary_fullfill]) call_new_async;
expD (tupE [nary_async; nary_reply])]


let letEta e scope =
match e.it with
| VarE _ -> scope e (* pure, so reduce *)
| _ -> let f = fresh_id (typ e) in
| _ -> let f = fresh_var (typ e) in
letD f e :: (scope f) (* maybe impure; sequence *)

let isAwaitableFunc exp =
Expand Down Expand Up @@ -142,11 +140,11 @@ module Transform() = struct
| [] ->
(expD e)::d_of_vs []
| [t] ->
let x = fresh_id t in
let x = fresh_var t in
let p = varP x in
(letP p e)::d_of_vs [x]
| ts ->
let xs = List.map fresh_id ts in
let xs = List.map fresh_var ts in
let p = tupP (List.map varP xs) in
(letP p e)::d_of_vs (xs)

Expand Down Expand Up @@ -266,10 +264,10 @@ module Transform() = struct
[]) -> (* TBR, why isn't this []? *)
(t_typ (T.seq ts1),t_typ contT)
| t -> assert false in
let k = fresh_id contT in
let v1 = fresh_id t1 in
let post = fresh_id (T.Func(T.Sharable,T.Returns,[],[],[])) in
let u = fresh_id T.unit in
let k = fresh_var contT in
let v1 = fresh_var t1 in
let post = fresh_var (T.Func(T.Sharable,T.Returns,[],[],[])) in
let u = fresh_var T.unit in
let ((nary_async,nary_reply),def) = new_nary_async_reply t1 in
(blockE [letP (tupP [varP nary_async; varP nary_reply]) def;
funcD k v1 (nary_reply -*- v1);
Expand Down Expand Up @@ -361,10 +359,10 @@ module Transform() = struct
let pat = t_pat pat in
let reply_typ = replyT nary res_typ in
let typ' = T.Tup [] in
let k = fresh_id reply_typ in
let k = fresh_var reply_typ in
let pat',d = extendTupP pat (varP k) in
let typbinds' = t_typ_binds typbinds in
let x = fresh_id res_typ in
let x = fresh_var res_typ in
let exp' =
match exp.it with
| CallE(_, async,_,cps) ->
Expand Down
34 changes: 17 additions & 17 deletions src/await.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ let letcont k scope =
| ContVar k' -> scope k' (* letcont eta-contraction *)
| MetaCont (typ, cont) ->
let k' = fresh_cont typ in
let v = fresh_id typ in
let v = fresh_var typ in
blockE [funcD k' v (cont v); (* at this point, I'm really worried about variable capture *)
expD (scope k')]

Expand All @@ -39,7 +39,7 @@ let ( -@- ) k exp2 =
match exp2.it with
| VarE _ -> k exp2
| _ ->
let u = fresh_id typ in
let u = fresh_var typ in
letE u exp2
(k u)

Expand Down Expand Up @@ -170,7 +170,7 @@ and unary context k unE e1 =
and binary context k binE e1 e2 =
match eff e1, eff e2 with
| T.Triv, T.Await ->
let v1 = fresh_id (typ e1) in (* TBR *)
let v1 = fresh_var (typ e1) in (* TBR *)
letE v1 (t_exp context e1)
(c_exp context e2 (meta (typ e2) (fun v2 -> k -@- binE v1 v2)))
| T.Await, T.Await ->
Expand All @@ -194,7 +194,7 @@ and nary context k naryE es =
| e1 :: es ->
match eff e1 with
| T.Triv ->
let v1 = fresh_id (typ e1) in
let v1 = fresh_var (typ e1) in
letE v1 (t_exp context e1)
(nary_aux (v1 :: vs) es)
| T.Await ->
Expand All @@ -220,8 +220,8 @@ and c_if context k e1 e2 e3 =
)

and c_while context k e1 e2 =
let loop = fresh_id (contT T.unit) in
let v2 = fresh_id T.unit in
let loop = fresh_var (contT T.unit) in
let v2 = fresh_var T.unit in
let e2 = match eff e2 with
| T.Triv -> loop -*- t_exp context e2
| T.Await -> c_exp context e2 (ContVar loop)
Expand All @@ -245,20 +245,20 @@ and c_while context k e1 e2 =
expD (loop -*- unitE)]

and c_loop_none context k e1 =
let loop = fresh_id (contT T.unit) in
let loop = fresh_var (contT T.unit) in
match eff e1 with
| T.Triv ->
assert false
| T.Await ->
let v1 = fresh_id T.unit in
let v1 = fresh_var T.unit in
blockE [funcD loop v1
(c_exp context e1 (ContVar loop));
expD(loop -*- unitE)]

and c_loop_some context k e1 e2 =
let loop = fresh_id (contT T.unit) in
let u = fresh_id T.unit in
let v1 = fresh_id T.unit in
let loop = fresh_var (contT T.unit) in
let u = fresh_var T.unit in
let v1 = fresh_var T.unit in
let e2 = match eff e2 with
| T.Triv -> ifE (t_exp context e2)
(loop -*- unitE)
Expand All @@ -283,11 +283,11 @@ and c_loop_some context k e1 e2 =
expD (loop -*- unitE)]

and c_for context k pat e1 e2 =
let v1 = fresh_id (typ e1) in
let v1 = fresh_var (typ e1) in
let next_typ = (T.Func(T.Local, T.Returns, [], [], [T.Opt pat.note])) in
let dotnext v = dotE v nextN next_typ -*- unitE in
let loop = fresh_id (contT T.unit) in
let v2 = fresh_id T.unit in
let loop = fresh_var (contT T.unit) in
let v2 = fresh_var T.unit in
let e2 = match eff e2 with
| T.Triv -> loop -*- t_exp context e2
| T.Await -> c_exp context e2 (ContVar loop) in
Expand Down Expand Up @@ -462,8 +462,8 @@ and c_dec context dec (k:kont) =
end
| FuncD (_, id, _ (* typbinds *), _ (* pat *), _ (* typ *), _ (* exp *) ) ->
let func_typ = typ dec in
let v = fresh_id func_typ in
let u = fresh_id T.unit in
let v = fresh_var func_typ in
let u = fresh_var T.unit in
blockE [letD v (decE (t_dec context dec));
letD u (define_idE id constM v);
expD (k -@- v)]
Expand Down Expand Up @@ -521,7 +521,7 @@ and rename_pat' pat =
| WildP
| LitP _ -> (PatEnv.empty, pat.it)
| VarP id ->
let v = fresh_id pat.note in
let v = fresh_var pat.note in
(PatEnv.singleton id.it v,
VarP (id_of_exp v))
| TupP pats ->
Expand Down
4 changes: 2 additions & 2 deletions src/check_ir.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -696,10 +696,10 @@ and check_dec env dec =
(* check typing *)
let t = typ dec in
match dec.it with
| ExpD exp ->
| ExpD exp | LetD (_, exp) ->
check_exp env exp;
(typ exp) <: t
| LetD (_, exp) | VarD (_, exp) ->
| VarD (_, exp) ->
check_exp env exp;
T.unit <: t
| FuncD (cc, id, typ_binds, pat, t2, exp) ->
Expand Down
15 changes: 5 additions & 10 deletions src/construct.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,11 +42,11 @@ let fresh () =
id_stamp := !id_stamp + 1;
name

let fresh_lab () =
let fresh_id () =
let name = fresh () in
name @@ no_region

let fresh_id typ =
let fresh_var typ =
let name = fresh () in
idE (name @@ no_region) typ

Expand Down Expand Up @@ -255,15 +255,10 @@ let newObjE sort ids typ =
let letP pat exp =
{ it = LetD (pat, exp);
at = no_region;
note = { S.note_typ = T.unit; (* ! *)
S.note_eff = eff exp; }
note = exp.note;
Copy link
Contributor

@crusso crusso Feb 28, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this deliberate? Joachim, have you changed the IR letD to also return the value of rhs?This contradics Andreas first comment on the PR:

" Note that it's not necessary for Ir.LetD to return values, since that is taken care fo by desugaring. After FuncD is replaced with FuncE in the IR, all non-ExpD decs should have type () there"

Copy link
Contributor

@nomeata nomeata Feb 28, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh, I guess I was confused when I wrote that. But I am fixing this in #196 in any case (including Check_ir), so it’s fine for now if we merge both.

In fact, I want to refactor BlockE further to (dec list * exp), and then declarations have no type at all (which means less to check in Check_ir and worry about in Construct).

Copy link
Contributor

@crusso crusso Feb 28, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Both sound good

}

let letD x exp = { it = LetD (varP x, exp);
at = no_region;
note = { S.note_eff = eff exp;
S.note_typ = T.unit; } (* ! *)
}
let letD x exp = letP (varP x) exp

let varD x exp = { it = VarD (x, exp);
at = no_region;
Expand Down Expand Up @@ -326,7 +321,7 @@ let answerT = T.unit
let contT typ = T.Func (T.Local, T.Returns, [], T.as_seq typ, [])
let cpsT typ = T.Func (T.Local, T.Returns, [], [contT typ], [])

let fresh_cont typ = fresh_id (contT typ)
let fresh_cont typ = fresh_var (contT typ)

(* Sequence expressions *)

Expand Down
6 changes: 3 additions & 3 deletions src/construct.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,8 +23,8 @@ val nextN : name

(* Identifiers *)

val fresh_lab : unit -> id
val fresh_id : typ -> var
val fresh_id : unit -> id
val fresh_var : typ -> var

val idE : id -> typ -> exp
val id_of_exp : exp -> id
Expand Down Expand Up @@ -59,7 +59,7 @@ val breakE: id -> exp -> exp
val retE: exp -> exp
val assignE : exp -> exp -> exp
val labelE : id -> typ -> exp -> exp
val loopE: exp -> exp option -> exp
val loopE : exp -> exp option -> exp

val declare_idE : id -> typ -> exp -> exp
val define_idE : id -> mut -> exp -> exp
Expand Down
16 changes: 6 additions & 10 deletions src/definedness.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -89,16 +89,15 @@ let rec exp msgs e : f = match e.it with
| RelE (_, e1, ro, e2)-> exps msgs [e1; e2]
| TupE es -> exps msgs es
| ProjE (e, i) -> exp msgs e
| ObjE (s, i, efs) ->
let f = close (exp_fields msgs efs) // i.it in
begin match s.it with
| Type.Actor -> eagerify f
| Type.Object _ -> f
end
| ObjE (s, efs) ->
(* For actors, this may be too permissive; to be revised when we work on actors again *)
(* Also see https://dfinity.atlassian.net/browse/AST-49 *)
close (exp_fields msgs efs)
| DotE (e, i) -> exp msgs e
| AssignE (e1, e2) -> exps msgs [e1; e2]
| ArrayE (m, es) -> exps msgs es
| IdxE (e1, e2) -> exps msgs [e1; e2]
| FuncE (_, s, tp, p, t, e) -> delayify (exp msgs e /// pat msgs p)
| CallE (e1, ts, e2) -> eagerify (exps msgs [e1; e2])
| BlockE ds -> decs msgs ds
| NotE e -> exp msgs e
Expand Down Expand Up @@ -145,10 +144,7 @@ and exp_fields msgs efs : fd = union_binders (exp_field msgs) efs
and dec msgs d = match d.it with
| ExpD e -> (exp msgs e, S.empty)
| LetD (p, e) -> pat msgs p +++ exp msgs e
| VarD (i, e) ->
(M.empty, S.singleton i.it) +++ exp msgs e
| FuncD (s, i, tp, p, t, e) ->
(M.empty, S.singleton i.it) +++ delayify (exp msgs e /// pat msgs p)
| VarD (i, e) -> (M.empty, S.singleton i.it) +++ exp msgs e
| TypD (i, tp, t) -> (M.empty, S.empty)
| ClassD (i, tp, s, p, i', efs) ->
(M.empty, S.singleton i.it) +++ delayify (close (exp_fields msgs efs) /// pat msgs p // i'.it)
Expand Down
Loading