-
Notifications
You must be signed in to change notification settings - Fork 50
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.
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
Implement Labeled Tuples #1235
base: dev
Are you sure you want to change the base?
Implement Labeled Tuples #1235
Changes from 26 commits
3d2a351
6889f4f
c137ded
5af500f
9927605
55500e6
f08c114
7ab1470
1cdeb3a
0598c9c
b3e7c84
dfdf051
07275db
44841b8
56d9a50
3d294dd
cbe3125
e0952df
bf1137c
9ab0f49
db194f8
c20706a
fe24986
773fa9b
e76f5e2
a802eb7
65eec8e
4753f3f
cae4bb5
bc22754
e810400
840f06f
58fc12c
2b1eda8
2be5a46
f7a2666
a2c34df
50536fe
4226bb4
8eef13c
998caeb
000b853
76247f0
8379dec
d5dfa8f
7d707c9
20c51f9
49c11d9
38b10c1
c315caa
5707718
e4fb061
8d6528e
a5c83bc
f4d778e
32173ea
318cfb3
c8ef191
22cd8d6
f04c976
78e817c
7008809
59ff548
158a62d
0669d9c
c27642b
bcd9fe2
926c5c7
5f790cb
39cbba1
b242321
de85c69
3c36566
72b4cac
828da51
7688a2b
c86e5f0
dac5119
3420d2c
1fa320c
c87048d
01f84c5
e018126
11804a2
523177e
c4db0d0
03208ff
0f8521a
1bee9bb
e66dd80
b42c613
9a918ef
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,295 @@ | ||
open Util; | ||
|
||
exception Exception; | ||
|
||
[@deriving (show({with_path: false}), sexp, yojson)] | ||
type t = string; | ||
|
||
let equal: (option((t, 'a)), option((t, 'b))) => bool = | ||
(left, right) => { | ||
switch (left, right) { | ||
| (Some((s1, _)), Some((s2, _))) => String.equal(s1, s2) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Personal note: It would be great if we had There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This exists in OptUtil |
||
| (_, _) => false | ||
}; | ||
}; | ||
|
||
let length = String.length; | ||
|
||
let compare = String.compare; | ||
|
||
let find_opt: ('a => bool, list('a)) => option('a) = List.find_opt; | ||
|
||
// returns a pair containing a list of option(t) and a list of 'a | ||
let seperate_labels: | ||
('a => option((t, 'a)), list('a)) => (list(option(t)), list('a)) = | ||
(get_label, es) => { | ||
let results = | ||
List.fold_left( | ||
((ls, ns), e) => | ||
switch (get_label(e)) { | ||
| Some((s1, e)) => (ls @ [Some(s1)], ns @ [e]) | ||
| None => (ls @ [None], ns @ [e]) | ||
}, | ||
([], []), | ||
es, | ||
); | ||
results; | ||
}; | ||
|
||
// returns ordered list of (Some(string), TupLabel) | ||
// and another of (None, not-TupLabel) | ||
// TODO: Need to check uniqueness earlier | ||
// TODO: Make more efficient | ||
let validate_uniqueness: | ||
('a => option((t, 'a)), list('a)) => | ||
(bool, list((option(t), 'a)), list('a)) = | ||
(get_label, es) => { | ||
let results = | ||
List.fold_left( | ||
((b, ls, ns), e) => | ||
switch (get_label(e)) { | ||
| Some((s1, _)) | ||
when | ||
b | ||
&& List.fold_left( | ||
(v, l) => | ||
switch (l) { | ||
| (Some(s2), _) when v => compare(s1, s2) != 0 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I think you can just use |
||
| _ => false | ||
}, | ||
true, | ||
ls, | ||
) => ( | ||
b, | ||
ls @ [(Some(s1), e)], | ||
ns, | ||
) | ||
| None => (b, ls, ns @ [e]) | ||
| _ => (false, ls, ns) | ||
}, | ||
(true, [], []), | ||
es, | ||
); | ||
results; | ||
}; | ||
|
||
// Assumes all labels are unique | ||
// filt returns Some(string) if TupLabel or None if not a TupLabel | ||
// returns a permutation of l2 that matches labels in l1 | ||
// other labels are in order, even if not matching. | ||
let rearrange: | ||
( | ||
'a => option((t, 'a)), | ||
'b => option((t, 'b)), | ||
list('a), | ||
list('b), | ||
(t, 'b) => 'b | ||
) => | ||
list('b) = | ||
(get_label1, get_label2, l1, l2, constructor) => { | ||
// TODO: Error handling in case of bad arguments | ||
let (_, l1_lab, _) = validate_uniqueness(get_label1, l1); | ||
let (_, l2_lab, _) = validate_uniqueness(get_label2, l2); | ||
// Second item in the pair is the full tuplabel | ||
let l2_matched = | ||
List.fold_left( | ||
(l2_matched, l1_item) => { | ||
let l2_item = | ||
find_opt( | ||
l2_item => { | ||
switch (l1_item, l2_item) { | ||
| ((Some(s1), _), (Some(s2), _)) => compare(s1, s2) == 0 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Same here with |
||
| (_, _) => false | ||
} | ||
}, | ||
l2_lab, | ||
); | ||
switch (l2_item) { | ||
| Some(l2_item) => l2_matched @ [l2_item] | ||
| None => l2_matched | ||
}; | ||
}, | ||
[], | ||
l1_lab, | ||
); | ||
// Second item in the pair is just the element half of the tuplabel | ||
let l2_rem = | ||
List.fold_left( | ||
(l2_rem, item) => { | ||
switch (get_label2(item)) { | ||
| Some((s1, _)) | ||
when | ||
List.exists( | ||
l => { | ||
switch (l) { | ||
| (Some(s2), _) => compare(s1, s2) == 0 | ||
| _ => false | ||
} | ||
}, | ||
l2_matched, | ||
) => l2_rem | ||
| Some((s1, it)) => l2_rem @ [(Some(s1), it)] | ||
| _ => l2_rem @ [(None, item)] | ||
} | ||
}, | ||
[], | ||
l2, | ||
); | ||
let rec rearrange_helper = | ||
( | ||
l1: list('x), | ||
l2_matched: list((option(t), 'y)), | ||
l2_rem: list((option(t), 'y)), | ||
) | ||
: list('y) => | ||
switch (l1) { | ||
| [hd, ...tl] => | ||
switch (get_label1(hd)) { | ||
| Some((s1, _)) => | ||
switch (l2_matched) { | ||
| [] => | ||
switch (l2_rem) { | ||
| [hd2, ...tl2] => | ||
switch (hd2) { | ||
| (Some(s2), rem_val) => | ||
[constructor(s2, rem_val)] | ||
@ rearrange_helper(tl, l2_matched, tl2) | ||
| (None, rem_val) => | ||
[constructor(s1, rem_val)] | ||
@ rearrange_helper(tl, l2_matched, tl2) | ||
} | ||
| [] => raise(Exception) | ||
} | ||
| [hd2, ...tl2] => | ||
switch (hd2) { | ||
| (Some(s2), l2_val) when compare(s1, s2) == 0 => | ||
[l2_val] @ rearrange_helper(tl, tl2, l2_rem) | ||
| _ => | ||
switch (l2_rem) { | ||
| [hd2, ...tl2] => | ||
switch (hd2) { | ||
| (Some(s2), rem_val) => | ||
[constructor(s2, rem_val)] | ||
@ rearrange_helper(tl, l2_matched, tl2) | ||
| (None, rem_val) => | ||
[constructor(s1, rem_val)] | ||
@ rearrange_helper(tl, l2_matched, tl2) | ||
} | ||
| [] => raise(Exception) | ||
} | ||
} | ||
} | ||
| None => | ||
switch (l2_rem) { | ||
| [(_, hd2), ...tl2] => | ||
[hd2] @ rearrange_helper(tl, l2_matched, tl2) | ||
| [] => raise(Exception) | ||
} | ||
} | ||
| [] => [] | ||
}; | ||
rearrange_helper(l1, l2_matched, l2_rem); | ||
}; | ||
|
||
// Rename and clean this | ||
// Assumes all labels are unique | ||
// filt returns Some(string) if TupLabel or None if not a TupLabel | ||
// In order of operations: | ||
// Checks all labeled pairs in l2 are in l1 and performs f on each pair | ||
// Checks all labeled pairs in l1 are in l2 and performs f on each pair | ||
// Checks remaining None pairs in order and performs f on each pair | ||
let ana_tuple: | ||
( | ||
'b => option((t, 'b)), | ||
'c => option((t, 'c)), | ||
('a, 'b, 'c) => 'a, | ||
'a, | ||
'a, | ||
list('b), | ||
list('c) | ||
) => | ||
'a = | ||
(get_label1, get_label2, f, accu, accu_fail, l1, l2) => { | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I think these would be slightly easier to read if the types were on the params as opposed to on the function itself. I'm open to other viewpoints on it though. |
||
let (l1_valid, l1_lab, l1_none) = validate_uniqueness(get_label1, l1); | ||
let (l2_valid, l2_lab, _) = validate_uniqueness(get_label2, l2); | ||
// temporary solution if mess up earlier in tuple, such as make_term | ||
if (!l1_valid || !l2_valid) { | ||
accu_fail; | ||
} else { | ||
// this result represents to accu, and the matched l2 labels | ||
let (accu, l2_labels_matched) = | ||
List.fold_left( | ||
((accu, l2_matched), l1_item) => { | ||
let l2_item = | ||
find_opt( | ||
l2_item => { | ||
switch (l1_item, l2_item) { | ||
| ((Some(s1), _), (Some(s2), _)) => compare(s1, s2) == 0 | ||
| (_, _) => false | ||
} | ||
}, | ||
l2_lab, | ||
); | ||
switch (l1_item, l2_item) { | ||
| ((_, l1_val), Some((l2_lab, l2_val))) => ( | ||
f(accu, l1_val, l2_val), | ||
l2_matched @ [l2_lab], | ||
) | ||
| (_, None) => (accu_fail, l2_matched) | ||
}; | ||
}, | ||
(accu, []), | ||
l1_lab, | ||
); | ||
// short circuit on failure | ||
if (accu == accu_fail) { | ||
accu_fail; | ||
} else { | ||
// filter l2 to remove matched labels and remove labels | ||
// TODO: Can be optimized | ||
let l2_rem = | ||
List.fold_left( | ||
(l2_rem, item) => { | ||
switch (get_label2(item)) { | ||
| Some((s1, _)) | ||
when | ||
List.exists( | ||
l => { | ||
switch (l) { | ||
| Some(s2) => compare(s1, s2) == 0 | ||
| _ => false | ||
} | ||
}, | ||
l2_labels_matched, | ||
) => l2_rem | ||
| _ => l2_rem @ [item] | ||
} | ||
}, | ||
[], | ||
l2, | ||
); | ||
// remaining checks are in order | ||
let accu = | ||
List.fold_left2( | ||
(accu, l1_val, l2_val) => f(accu, l1_val, l2_val), | ||
accu, | ||
l1_none, | ||
l2_rem, | ||
); | ||
accu; | ||
}; | ||
}; | ||
}; | ||
|
||
let find_label: ('a => option((t, 'a)), list('a), t) => option('a) = | ||
(filt, es, label) => { | ||
find_opt( | ||
e => { | ||
switch (filt(e)) { | ||
| Some((s, _)) => compare(s, label) == 0 | ||
| None => false | ||
} | ||
}, | ||
es, | ||
); | ||
}; |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Should this type be
label
instead ofLabeledTuple.t
? I believe it's just used for the labels.