diff options
Diffstat (limited to 'stdlib/source/library/lux/tool/compiler/meta/archive.lux')
| -rw-r--r-- | stdlib/source/library/lux/tool/compiler/meta/archive.lux | 400 |
1 files changed, 200 insertions, 200 deletions
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index 83bbc51e9..0f1f5ef2c 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -79,208 +79,208 @@ [#next ID #resolver (Dictionary Module [ID (Maybe [Descriptor (Document Any) Output])])]) - [(def: next - (-> Archive ID) - (|>> :representation (value@ #next))) - - (def: .public empty - Archive - (:abstraction [#next 0 - #resolver (dictionary.empty text.hash)])) - - (def: .public (id module archive) - (-> Module Archive (Try ID)) - (let [(^slots [#..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - {#.Some [id _]} - {#try.Success id} - - #.None - (exception.except ..unknown_document [module - (dictionary.keys resolver)])))) - - (def: .public (reserve module archive) - (-> Module Archive (Try [ID Archive])) - (let [(^slots [#..next #..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - {#.Some _} - (exception.except ..module_has_already_been_reserved [module]) - - #.None - {#try.Success [next - (|> archive - :representation - (revised@ #..resolver (dictionary.has module [next #.None])) - (revised@ #..next ++) - :abstraction)]}))) - - (def: .public (has module [descriptor document output] archive) - (-> Module [Descriptor (Document Any) Output] Archive (Try Archive)) - (let [(^slots [#..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - {#.Some [id #.None]} - {#try.Success (|> archive + (def: next + (-> Archive ID) + (|>> :representation (value@ #next))) + + (def: .public empty + Archive + (:abstraction [#next 0 + #resolver (dictionary.empty text.hash)])) + + (def: .public (id module archive) + (-> Module Archive (Try ID)) + (let [(^slots [#..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + {#.Some [id _]} + {#try.Success id} + + #.None + (exception.except ..unknown_document [module + (dictionary.keys resolver)])))) + + (def: .public (reserve module archive) + (-> Module Archive (Try [ID Archive])) + (let [(^slots [#..next #..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + {#.Some _} + (exception.except ..module_has_already_been_reserved [module]) + + #.None + {#try.Success [next + (|> archive :representation - (revised@ #..resolver (dictionary.has module [id {#.Some [descriptor document output]}])) - :abstraction)} - - {#.Some [id {#.Some [existing_descriptor existing_document existing_output]}]} - (if (same? document existing_document) - ... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy... - {#try.Success archive} - (exception.except ..cannot_replace_document [module existing_document document])) - - #.None - (exception.except ..module_must_be_reserved_before_it_can_be_added [module])))) - - (def: .public (find module archive) - (-> Module Archive (Try [Descriptor (Document Any) Output])) - (let [(^slots [#..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - {#.Some [id {#.Some entry}]} - {#try.Success entry} - - {#.Some [id #.None]} - (exception.except ..module_is_only_reserved [module]) - - #.None - (exception.except ..unknown_document [module - (dictionary.keys resolver)])))) - - (def: .public (archived? archive module) - (-> Archive Module Bit) - (case (..find module archive) - {#try.Success _} - bit.yes - - {#try.Failure _} - bit.no)) - - (def: .public archived - (-> Archive (List Module)) - (|>> :representation - (value@ #resolver) + (revised@ #..resolver (dictionary.has module [next #.None])) + (revised@ #..next ++) + :abstraction)]}))) + + (def: .public (has module [descriptor document output] archive) + (-> Module [Descriptor (Document Any) Output] Archive (Try Archive)) + (let [(^slots [#..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + {#.Some [id #.None]} + {#try.Success (|> archive + :representation + (revised@ #..resolver (dictionary.has module [id {#.Some [descriptor document output]}])) + :abstraction)} + + {#.Some [id {#.Some [existing_descriptor existing_document existing_output]}]} + (if (same? document existing_document) + ... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy... + {#try.Success archive} + (exception.except ..cannot_replace_document [module existing_document document])) + + #.None + (exception.except ..module_must_be_reserved_before_it_can_be_added [module])))) + + (def: .public (find module archive) + (-> Module Archive (Try [Descriptor (Document Any) Output])) + (let [(^slots [#..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + {#.Some [id {#.Some entry}]} + {#try.Success entry} + + {#.Some [id #.None]} + (exception.except ..module_is_only_reserved [module]) + + #.None + (exception.except ..unknown_document [module + (dictionary.keys resolver)])))) + + (def: .public (archived? archive module) + (-> Archive Module Bit) + (case (..find module archive) + {#try.Success _} + bit.yes + + {#try.Failure _} + bit.no)) + + (def: .public archived + (-> Archive (List Module)) + (|>> :representation + (value@ #resolver) + dictionary.entries + (list.all (function (_ [module [id descriptor+document]]) + (case descriptor+document + {#.Some _} {#.Some module} + #.None #.None))))) + + (def: .public (reserved? archive module) + (-> Archive Module Bit) + (let [(^slots [#..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + {#.Some [id _]} + bit.yes + + #.None + bit.no))) + + (def: .public reserved + (-> Archive (List Module)) + (|>> :representation + (value@ #resolver) + dictionary.keys)) + + (def: .public reservations + (-> Archive (List [Module ID])) + (|>> :representation + (value@ #resolver) + dictionary.entries + (list\each (function (_ [module [id _]]) + [module id])))) + + (def: .public (merged additions archive) + (-> Archive Archive Archive) + (let [[+next +resolver] (:representation additions)] + (|> archive + :representation + (revised@ #next (n.max +next)) + (revised@ #resolver (function (_ resolver) + (list\mix (function (_ [module [id entry]] resolver) + (case entry + {#.Some _} + (dictionary.has module [id entry] resolver) + + #.None + resolver)) + resolver + (dictionary.entries +resolver)))) + :abstraction))) + + (type: Reservation + [Module ID]) + + (type: Frozen + [Version ID (List Reservation)]) + + (def: reader + (Parser ..Frozen) + ($_ <>.and + <binary>.nat + <binary>.nat + (<binary>.list (<>.and <binary>.text <binary>.nat)))) + + (def: writer + (Writer ..Frozen) + ($_ binary.and + binary.nat + binary.nat + (binary.list (binary.and binary.text binary.nat)))) + + (def: .public (export version archive) + (-> Version Archive Binary) + (let [(^slots [#..next #..resolver]) (:representation archive)] + (|> resolver dictionary.entries (list.all (function (_ [module [id descriptor+document]]) (case descriptor+document - {#.Some _} {#.Some module} - #.None #.None))))) - - (def: .public (reserved? archive module) - (-> Archive Module Bit) - (let [(^slots [#..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - {#.Some [id _]} - bit.yes - - #.None - bit.no))) - - (def: .public reserved - (-> Archive (List Module)) - (|>> :representation - (value@ #resolver) - dictionary.keys)) - - (def: .public reservations - (-> Archive (List [Module ID])) - (|>> :representation - (value@ #resolver) - dictionary.entries - (list\each (function (_ [module [id _]]) - [module id])))) - - (def: .public (merged additions archive) - (-> Archive Archive Archive) - (let [[+next +resolver] (:representation additions)] - (|> archive - :representation - (revised@ #next (n.max +next)) - (revised@ #resolver (function (_ resolver) - (list\mix (function (_ [module [id entry]] resolver) - (case entry - {#.Some _} - (dictionary.has module [id entry] resolver) - - #.None - resolver)) - resolver - (dictionary.entries +resolver)))) - :abstraction))) - - (type: Reservation - [Module ID]) - - (type: Frozen - [Version ID (List Reservation)]) - - (def: reader - (Parser ..Frozen) - ($_ <>.and - <binary>.nat - <binary>.nat - (<binary>.list (<>.and <binary>.text <binary>.nat)))) - - (def: writer - (Writer ..Frozen) - ($_ binary.and - binary.nat - binary.nat - (binary.list (binary.and binary.text binary.nat)))) - - (def: .public (export version archive) - (-> Version Archive Binary) - (let [(^slots [#..next #..resolver]) (:representation archive)] - (|> resolver - dictionary.entries - (list.all (function (_ [module [id descriptor+document]]) - (case descriptor+document - {#.Some _} {#.Some [module id]} - #.None #.None))) - [version next] - (binary.result ..writer)))) - - (exception: .public (version_mismatch [expected Version - actual Version]) - (exception.report - ["Expected" (%.nat expected)] - ["Actual" (%.nat actual)])) - - (exception: .public corrupt_data) - - (def: (correct_modules? reservations) - (-> (List Reservation) Bit) - (n.= (list.size reservations) - (|> reservations - (list\each product.left) - (set.of_list text.hash) - set.size))) - - (def: (correct_ids? reservations) - (-> (List Reservation) Bit) - (n.= (list.size reservations) - (|> reservations - (list\each product.right) - (set.of_list n.hash) - set.size))) - - (def: (correct_reservations? reservations) - (-> (List Reservation) Bit) - (and (correct_modules? reservations) - (correct_ids? reservations))) - - (def: .public (import expected binary) - (-> Version Binary (Try Archive)) - (do try.monad - [[actual next reservations] (<binary>.result ..reader binary) - _ (exception.assertion ..version_mismatch [expected actual] - (n\= expected actual)) - _ (exception.assertion ..corrupt_data [] - (correct_reservations? reservations))] - (in (:abstraction - [#next next - #resolver (list\mix (function (_ [module id] archive) - (dictionary.has module [id #.None] archive)) - (value@ #resolver (:representation ..empty)) - reservations)]))))] + {#.Some _} {#.Some [module id]} + #.None #.None))) + [version next] + (binary.result ..writer)))) + + (exception: .public (version_mismatch [expected Version + actual Version]) + (exception.report + ["Expected" (%.nat expected)] + ["Actual" (%.nat actual)])) + + (exception: .public corrupt_data) + + (def: (correct_modules? reservations) + (-> (List Reservation) Bit) + (n.= (list.size reservations) + (|> reservations + (list\each product.left) + (set.of_list text.hash) + set.size))) + + (def: (correct_ids? reservations) + (-> (List Reservation) Bit) + (n.= (list.size reservations) + (|> reservations + (list\each product.right) + (set.of_list n.hash) + set.size))) + + (def: (correct_reservations? reservations) + (-> (List Reservation) Bit) + (and (correct_modules? reservations) + (correct_ids? reservations))) + + (def: .public (import expected binary) + (-> Version Binary (Try Archive)) + (do try.monad + [[actual next reservations] (<binary>.result ..reader binary) + _ (exception.assertion ..version_mismatch [expected actual] + (n\= expected actual)) + _ (exception.assertion ..corrupt_data [] + (correct_reservations? reservations))] + (in (:abstraction + [#next next + #resolver (list\mix (function (_ [module id] archive) + (dictionary.has module [id #.None] archive)) + (value@ #resolver (:representation ..empty)) + reservations)])))) ) |