├── .gitignore ├── .travis.yml ├── Data └── Rope │ └── Mutable.hs ├── Debug ├── Hoed.hs ├── Hoed │ ├── CompTree.hs │ ├── Compat.hs │ ├── Console.hs │ ├── EventForest.hs │ ├── Fields.hs │ ├── Observe.lhs │ ├── Prop.hs │ ├── ReadLine.hs │ ├── Render.hs │ ├── Serialize.hs │ ├── Span.hs │ ├── TH.hs │ ├── TestParEq.hs │ └── Util.hs └── NoHoed.hs ├── Hoed.cabal ├── LICENSE ├── README.md ├── Setup.hs ├── Text └── PrettyPrint │ └── FPretty.hs ├── build ├── changelog ├── configure.Demo ├── configure.Generic ├── configure.Profiling ├── configure.Prop ├── configure.Pure ├── configure.Stk ├── examples ├── AskName-hood.hs ├── AskName.hs ├── BreadthFirst │ ├── BreadthFirst1Defective.hs │ ├── BreadthFirst2Defective.hs │ └── BreadthFirst2Sound.hs ├── CNF_unsound_demorgan__with_properties │ ├── CNF.hs │ └── Main.hs ├── Digraph_not_data_invariant__with_properties │ ├── Digraph.hs │ └── Main.hs ├── DoublingServer.hs ├── DoublingServer2.hs ├── DoublingServer3.hs ├── DoublingServer4.hs ├── DoublingServer5.hs ├── Example1.hs ├── Example3.lhs ├── Example4.hs ├── ExpressionSimplifier │ ├── Main1.hs │ ├── Main2.hs │ └── MyModule.hs ├── FPretty │ ├── FPretty.hs │ ├── Main.hs │ ├── Sequence.hs │ └── containers.h ├── FPretty__CC │ ├── FPretty.hs │ ├── Main.hs │ ├── Sequence.hs │ └── containers.h ├── Flip.hs ├── Foldl.hs ├── Hashmap.hs ├── HeadOnEmpty.hs ├── HeadOnEmpty2.hs ├── IOException.hs ├── IndirectRecursion.lhs ├── Insertion_Sort_elements_disappear.hs ├── Insort.lhs ├── Nubsort │ ├── Main.hs │ └── Nubsort.hs ├── Parity.hs ├── Pretty.hs ├── Queens__with_properties │ ├── Main.hs │ ├── Main2.hs │ ├── Properties.hs │ ├── Queens.hs │ ├── SanityCheck.hs │ ├── Test1.hs │ └── Types.hs ├── Responsibility.lhs ├── Rot13.hs ├── Salary.hs ├── SimpleHO.hs ├── SternBrocot.lhs ├── SternBrocot1 │ ├── SternBrocot.hs │ └── build ├── SternBrocot2 │ ├── SternBrocot.hs │ └── build ├── TightRope.hs ├── TightRope2.hs ├── TightRope3.hs ├── XMonad2__using_properties │ ├── .Hoed │ │ ├── Events │ │ ├── debugTree.dot │ │ ├── exe │ │ │ ├── Main │ │ │ ├── Main.compilerMessages │ │ │ ├── Main.hs │ │ │ └── Main.out │ │ ├── savedCompTree.prop_greedyView_idem │ │ ├── savedCompTree.prop_greedyView_local │ │ ├── savedCompTree.prop_greedyView_reversible │ │ ├── savedCompTree.prop_shift_win_I │ │ ├── savedCompTree.prop_view_I │ │ ├── savedTrace.prop_greedyView_idem │ │ ├── savedTrace.prop_greedyView_local │ │ ├── savedTrace.prop_greedyView_reversible │ │ ├── savedTrace.prop_shift_win_I │ │ ├── savedTrace.prop_view_I │ │ └── wwwroot │ │ │ ├── debugTree.png │ │ │ ├── faulty.png │ │ │ ├── hoed-logo.png │ │ │ ├── loading.gif │ │ │ ├── right.png │ │ │ ├── test.png │ │ │ ├── unassessed.png │ │ │ └── wrong.png │ ├── Main.hs │ ├── Properties.hs │ ├── README │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── XMonad3__using_properties │ ├── .Hoed │ │ ├── Events │ │ ├── debugTree.dot │ │ ├── exe │ │ │ ├── Main.compilerMessages │ │ │ ├── Main.hs │ │ │ └── Main.out │ │ ├── savedCompTree.prop_greedyView_idem │ │ ├── savedCompTree.prop_greedyView_local │ │ ├── savedCompTree.prop_greedyView_reversible │ │ ├── savedCompTree.prop_shift_win_I │ │ ├── savedCompTree.prop_swap_all_l │ │ ├── savedCompTree.prop_swap_all_r │ │ ├── savedCompTree.prop_swap_master_I │ │ ├── savedCompTree.prop_swap_master_idempotent │ │ ├── savedCompTree.prop_swap_right_I │ │ ├── savedCompTree.prop_view_I │ │ ├── savedTrace.prop_greedyView_idem │ │ ├── savedTrace.prop_greedyView_local │ │ ├── savedTrace.prop_greedyView_reversible │ │ ├── savedTrace.prop_shift_win_I │ │ ├── savedTrace.prop_swap_all_l │ │ ├── savedTrace.prop_swap_all_r │ │ ├── savedTrace.prop_swap_master_I │ │ ├── savedTrace.prop_swap_master_idempotent │ │ ├── savedTrace.prop_swap_right_I │ │ ├── savedTrace.prop_view_I │ │ └── wwwroot │ │ │ ├── debugTree.png │ │ │ ├── faulty.png │ │ │ ├── hoed-logo.png │ │ │ ├── loading.gif │ │ │ ├── right.png │ │ │ ├── test.png │ │ │ ├── unassessed.png │ │ │ └── wrong.png │ ├── Main.hs │ ├── Properties.hs │ ├── README │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── XMonad4__using_properties │ ├── .Hoed │ │ ├── Events │ │ ├── debugTree.dot │ │ ├── exe │ │ │ ├── Main │ │ │ ├── Main.compilerMessages │ │ │ ├── Main.hs │ │ │ └── Main.out │ │ ├── savedCompTree.prop_allWindowsMember │ │ ├── savedCompTree.prop_findIndex │ │ ├── savedCompTree.prop_greedyView_idem │ │ ├── savedCompTree.prop_greedyView_local │ │ ├── savedCompTree.prop_greedyView_reversible │ │ ├── savedCompTree.prop_shift_win_I │ │ ├── savedCompTree.prop_swap_all_l │ │ ├── savedCompTree.prop_swap_all_r │ │ ├── savedCompTree.prop_swap_master_I │ │ ├── savedCompTree.prop_swap_master_idempotent │ │ ├── savedCompTree.prop_swap_right_I │ │ ├── savedCompTree.prop_view_I │ │ ├── savedTrace.prop_allWindowsMember │ │ ├── savedTrace.prop_findIndex │ │ ├── savedTrace.prop_greedyView_idem │ │ ├── savedTrace.prop_greedyView_local │ │ ├── savedTrace.prop_greedyView_reversible │ │ ├── savedTrace.prop_shift_win_I │ │ ├── savedTrace.prop_swap_all_l │ │ ├── savedTrace.prop_swap_all_r │ │ ├── savedTrace.prop_swap_master_I │ │ ├── savedTrace.prop_swap_master_idempotent │ │ ├── savedTrace.prop_swap_right_I │ │ ├── savedTrace.prop_view_I │ │ └── wwwroot │ │ │ ├── debugTree.png │ │ │ ├── faulty.png │ │ │ ├── hoed-logo.png │ │ │ ├── loading.gif │ │ │ ├── right.png │ │ │ ├── test.png │ │ │ ├── unassessed.png │ │ │ └── wrong.png │ ├── Main.hs │ ├── Properties.hs │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── XMonad5__using_properties │ ├── .Hoed │ │ ├── Events │ │ ├── debugTree.dot │ │ ├── exe │ │ │ ├── Main.compilerMessages │ │ │ ├── Main.hs │ │ │ └── Main.out │ │ ├── savedCompTree.prop_allWindowsMember │ │ ├── savedCompTree.prop_findIndex │ │ ├── savedCompTree.prop_greedyView_idem │ │ ├── savedCompTree.prop_greedyView_local │ │ ├── savedCompTree.prop_greedyView_reversible │ │ ├── savedCompTree.prop_shift_win_I │ │ ├── savedCompTree.prop_swap_all_l │ │ ├── savedCompTree.prop_swap_all_r │ │ ├── savedCompTree.prop_swap_master_I │ │ ├── savedCompTree.prop_swap_master_idempotent │ │ ├── savedCompTree.prop_swap_right_I │ │ ├── savedCompTree.prop_view_I │ │ ├── savedTrace.prop_allWindowsMember │ │ ├── savedTrace.prop_findIndex │ │ ├── savedTrace.prop_greedyView_idem │ │ ├── savedTrace.prop_greedyView_local │ │ ├── savedTrace.prop_greedyView_reversible │ │ ├── savedTrace.prop_shift_win_I │ │ ├── savedTrace.prop_swap_all_l │ │ ├── savedTrace.prop_swap_all_r │ │ ├── savedTrace.prop_swap_master_I │ │ ├── savedTrace.prop_swap_master_idempotent │ │ ├── savedTrace.prop_swap_right_I │ │ ├── savedTrace.prop_view_I │ │ └── wwwroot │ │ │ ├── debugTree.png │ │ │ ├── faulty.png │ │ │ ├── hoed-logo.png │ │ │ ├── loading.gif │ │ │ ├── right.png │ │ │ ├── test.png │ │ │ ├── unassessed.png │ │ │ └── wrong.png │ ├── Main.hs │ ├── Properties.hs │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── XMonad6__using_properties │ ├── .Hoed │ │ ├── Events │ │ ├── debugTree.dot │ │ ├── exe │ │ │ ├── Main │ │ │ ├── Main.compilerMessages │ │ │ ├── Main.hs │ │ │ └── Main.out │ │ ├── savedCompTree.prop_allWindowsMember │ │ ├── savedCompTree.prop_findIndex │ │ ├── savedCompTree.prop_greedyView_idem │ │ ├── savedCompTree.prop_greedyView_local │ │ ├── savedCompTree.prop_greedyView_reversible │ │ ├── savedCompTree.prop_insertUp_I │ │ ├── savedCompTree.prop_insert_duplicate_weak │ │ ├── savedCompTree.prop_shift_win_I │ │ ├── savedCompTree.prop_swap_all_l │ │ ├── savedCompTree.prop_swap_all_r │ │ ├── savedCompTree.prop_swap_master_I │ │ ├── savedCompTree.prop_swap_master_idempotent │ │ ├── savedCompTree.prop_swap_right_I │ │ ├── savedCompTree.prop_view_I │ │ ├── savedCompTree.spec_member │ │ ├── savedTrace.prop_allWindowsMember │ │ ├── savedTrace.prop_findIndex │ │ ├── savedTrace.prop_greedyView_idem │ │ ├── savedTrace.prop_greedyView_local │ │ ├── savedTrace.prop_greedyView_reversible │ │ ├── savedTrace.prop_insertUp_I │ │ ├── savedTrace.prop_insert_duplicate_weak │ │ ├── savedTrace.prop_shift_win_I │ │ ├── savedTrace.prop_swap_all_l │ │ ├── savedTrace.prop_swap_all_r │ │ ├── savedTrace.prop_swap_master_I │ │ ├── savedTrace.prop_swap_master_idempotent │ │ ├── savedTrace.prop_swap_right_I │ │ ├── savedTrace.prop_view_I │ │ ├── savedTrace.spec_member │ │ └── wwwroot │ │ │ ├── debugTree.png │ │ │ ├── faulty.png │ │ │ ├── hoed-logo.png │ │ │ ├── loading.gif │ │ │ ├── right.png │ │ │ ├── test.png │ │ │ ├── unassessed.png │ │ │ └── wrong.png │ ├── Main.hs │ ├── Properties.hs │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── XMonad_changing_focus_duplicates_windows │ ├── Main.hs │ ├── Properties.hs │ ├── README │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── XMonad_changing_focus_duplicates_windows__CC │ ├── Main.hs │ ├── Properties.hs │ ├── README │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── XMonad_changing_focus_duplicates_windows__test_only │ ├── Main.hs │ ├── Properties.hs │ ├── README │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── XMonad_changing_focus_duplicates_windows__using_properties │ ├── Main.hs │ ├── Properties.hs │ ├── README │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── ZLang │ ├── 1 │ │ ├── .Hoed │ │ │ ├── Events │ │ │ ├── Transcript │ │ │ ├── debugTree.dot │ │ │ └── wwwroot │ │ │ │ ├── faulty.png │ │ │ │ ├── hoed-logo.png │ │ │ │ ├── loading.gif │ │ │ │ ├── right.png │ │ │ │ ├── unassessed.png │ │ │ │ └── wrong.png │ │ ├── .gitignore │ │ ├── Ast.hs │ │ ├── IR.hs │ │ ├── Main.hs │ │ ├── MatchCheck.hs │ │ ├── Parser.hs │ │ ├── README.md │ │ ├── Replace.hs │ │ ├── Subtype.hs │ │ ├── TypeInfer.hs │ │ ├── TypeUtils.hs │ │ ├── TypedAst.hs │ │ ├── Types.hs │ │ ├── Unification.hs │ │ └── Utils.hs │ ├── 2 │ │ ├── .Hoed │ │ │ ├── Events │ │ │ ├── Transcript │ │ │ ├── debugTree.dot │ │ │ └── wwwroot │ │ │ │ ├── faulty.png │ │ │ │ ├── hoed-logo.png │ │ │ │ ├── loading.gif │ │ │ │ ├── right.png │ │ │ │ ├── unassessed.png │ │ │ │ └── wrong.png │ │ ├── .gitignore │ │ ├── Ast.hs │ │ ├── IR.hs │ │ ├── Main.hs │ │ ├── MatchCheck.hs │ │ ├── Parser.hs │ │ ├── README.md │ │ ├── Replace.hs │ │ ├── Subtype.hs │ │ ├── TypeInfer.hs │ │ ├── TypeUtils.hs │ │ ├── TypedAst.hs │ │ ├── Types.hs │ │ ├── Unification.hs │ │ └── Utils.hs │ └── 3 │ │ ├── .Hoed │ │ ├── Events │ │ ├── Transcript │ │ ├── debugTree.dot │ │ └── wwwroot │ │ │ ├── faulty.png │ │ │ ├── hoed-logo.png │ │ │ ├── loading.gif │ │ │ ├── right.png │ │ │ ├── unassessed.png │ │ │ └── wrong.png │ │ ├── .gitignore │ │ ├── Ast.hs │ │ ├── IR.hs │ │ ├── Main.hs │ │ ├── MatchCheck.hs │ │ ├── Parser.hs │ │ ├── README.md │ │ ├── Replace.hs │ │ ├── Subtype.hs │ │ ├── TypeInfer.hs │ │ ├── TypeUtils.hs │ │ ├── TypedAst.hs │ │ ├── Types.hs │ │ ├── Unification.hs │ │ └── Utils.hs ├── afp02Exercises │ ├── Compiler │ │ ├── Behaviour.hs │ │ ├── CVS │ │ │ ├── Entries │ │ │ ├── Repository │ │ │ └── Root │ │ ├── Compiler.hs │ │ ├── Interpreter.hs │ │ ├── Machine.hs │ │ ├── Main.aux │ │ ├── Main.hs │ │ ├── Main.prof │ │ ├── Parser.hs │ │ ├── Properties.hs │ │ ├── StackMap.hs │ │ ├── Syntax.hs │ │ ├── Value.hs │ │ ├── build │ │ ├── compilerprac.tex │ │ ├── gcd.in │ │ ├── parassign │ │ │ ├── Behaviour.hs │ │ │ ├── CVS │ │ │ │ ├── Entries │ │ │ │ ├── Repository │ │ │ │ └── Root │ │ │ ├── Compiler.hs │ │ │ ├── Interpreter.hs │ │ │ ├── Machine.hs │ │ │ ├── Main.hs │ │ │ ├── Parser.hs │ │ │ ├── README │ │ │ ├── StackMap.hs │ │ │ ├── Syntax.hs │ │ │ ├── Value.hs │ │ │ ├── gcd.in │ │ │ └── power.in │ │ ├── power.in │ │ ├── properties │ │ │ ├── CVS │ │ │ │ ├── Entries │ │ │ │ ├── Repository │ │ │ │ └── Root │ │ │ ├── PropertiesSolution.hs │ │ │ └── README │ │ ├── run │ │ └── vanilla │ │ │ ├── Behaviour.hs │ │ │ ├── CVS │ │ │ ├── Entries │ │ │ ├── Repository │ │ │ └── Root │ │ │ ├── Compiler.hs │ │ │ ├── Interpreter.hs │ │ │ ├── Machine.hs │ │ │ ├── Main.hs │ │ │ ├── Parser.hs │ │ │ ├── StackMap.hs │ │ │ ├── Syntax.hs │ │ │ ├── Value.hs │ │ │ └── gcd.in │ └── Compiler__with_properties │ │ ├── Behaviour.hs │ │ ├── Compiler.hs │ │ ├── Interpreter.hs │ │ ├── Machine.hs │ │ ├── Main.hs │ │ ├── Parser.hs │ │ ├── Properties.hs │ │ ├── StackMap.hs │ │ ├── Syntax.hs │ │ └── Value.hs ├── filter__with_properties │ ├── Even.hs │ ├── Main.hs │ └── Properties.hs └── quicksort.hs ├── installDependencies ├── mktags ├── run ├── stack.yaml ├── test.Generic ├── test.Prop ├── test.Pure ├── test.Stk └── tests ├── Generic ├── r0.hs ├── r1.hs ├── r2.hs ├── r3.hs ├── t0.hs ├── t1.hs ├── t2.hs ├── t3.hs └── t64.hs ├── Prop ├── t0 │ ├── Main.hs │ └── MyModule.hs ├── t1 │ ├── CNF.hs │ └── Main.hs ├── t2 │ ├── Digraph.hs │ └── Main.hs ├── t3 │ ├── Main.hs │ ├── Properties.hs │ ├── README │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs ├── t4 │ ├── Main.hs │ ├── Properties.hs │ ├── README │ ├── Test │ │ ├── QuickCheck.hs │ │ └── QuickCheck │ │ │ ├── Batch.hs │ │ │ ├── Poly.hs │ │ │ └── Utils.hs │ └── XMonad │ │ ├── Config.hs │ │ ├── Core.hs │ │ ├── Layout.hs │ │ ├── Main.hsc │ │ ├── ManageHook.hs │ │ ├── Operations.hs │ │ └── StackSet.hs └── t5 │ ├── Even.hs │ ├── Main.hs │ └── Properties.hs ├── Pure ├── t1.hs ├── t2.hs ├── t3.hs ├── t4.hs ├── t5.hs ├── t6.hs └── t7.hs ├── Stk ├── DoublingServer.hs ├── Example1.hs ├── Example3.lhs ├── Example4.hs ├── IndirectRecursion.lhs └── Insort2.hs ├── TH └── quicksort.hs └── ref ├── hoed-tests-Prop-t0.graph ├── hoed-tests-Prop-t1.graph ├── hoed-tests-Prop-t2.graph ├── hoed-tests-Prop-t3.graph ├── hoed-tests-Prop-t4.graph ├── hoed-tests-Prop-t5.graph ├── hoed-tests-Pure-t1.graph ├── hoed-tests-Pure-t2.graph ├── hoed-tests-Pure-t3.graph ├── hoed-tests-Pure-t4.graph ├── hoed-tests-Pure-t5.graph ├── hoed-tests-Pure-t6.graph ├── hoed-tests-Pure-t7.graph ├── hoed-tests-Stk-DoublingServer.graph ├── hoed-tests-Stk-Example1.graph ├── hoed-tests-Stk-Example3.graph ├── hoed-tests-Stk-Example4.graph ├── hoed-tests-Stk-IndirectRecursion.graph ├── hoed-tests-Stk-Insort2.graph └── hoed-tests-th-quicksort.graph /Debug/Hoed/Compat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Debug.Hoed.Compat (addConstraint, sortOn, (<$), (<$>)) where 3 | 4 | import Control.Applicative 5 | import Data.List 6 | import Language.Haskell.TH 7 | 8 | #if __GLASGOW_HASKELL__ < 710 9 | sortOn :: Ord b => (a -> b) -> [a] -> [a] 10 | sortOn f = map snd . sortOn' fst . map (\x -> (f x, x)) 11 | 12 | sortOn' :: Ord b => (a -> b) -> [a] -> [a] 13 | sortOn' f = sortBy (\x y -> compare (f x) (f y)) 14 | #endif 15 | 16 | addConstraint :: Name -> [Type] -> Pred 17 | addConstraint name args = 18 | #if __GLASGOW_HASKELL__ < 710 19 | ClassP name args 20 | #else 21 | foldl' AppT (ConT name) args 22 | #endif 23 | -------------------------------------------------------------------------------- /Debug/Hoed/Fields.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE UndecidableInstances #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# LANGUAGE DataKinds #-} 6 | {-# LANGUAGE KindSignatures #-} 7 | module Debug.Hoed.Fields where 8 | 9 | import GHC.Generics 10 | import GHC.Exts 11 | 12 | #if __GLASGOW_HASKELL__ > 710 13 | import GHC.TypeLits (ErrorMessage(..), TypeError) 14 | #endif 15 | 16 | data Nat = Z | S Nat 17 | 18 | -- A constraint on the number of the constructors in a datatype 19 | type family FieldLimit (n :: Nat) a :: Constraint where 20 | FieldLimit n (M1 c meta f) = FieldLimit n f 21 | FieldLimit n (f :+: g) = (FieldLimit n f, FieldLimit n g) 22 | FieldLimit ('S n) (f :*: g) = FieldLimit n g 23 | FieldLimit n U1 = () 24 | FieldLimit n V1 = () 25 | FieldLimit n (K1 a b) = () 26 | #if __GLASGOW_HASKELL__ > 710 27 | FieldLimit n (URec a) = () 28 | FieldLimit 'Z f = TypeError ('Text "Hoed only handles constructors with 64 fields or less") 29 | #endif 30 | -------------------------------------------------------------------------------- /Debug/Hoed/ReadLine.hs: -------------------------------------------------------------------------------- 1 | module Debug.Hoed.ReadLine where 2 | import System.IO 3 | import Data.List 4 | 5 | noBuffering :: IO () 6 | noBuffering = do 7 | hSetBuffering stdin NoBuffering 8 | hSetBuffering stdout NoBuffering 9 | 10 | readLine :: String -> [String] -> IO String 11 | readLine ps completions = do 12 | putStr ps 13 | loop "" 14 | where 15 | loop curLine = do 16 | c <- getChar 17 | case c of 18 | '\n' -> return curLine 19 | '\DEL' -> do putStr "\b\b\b \b\b\b" 20 | loop (case curLine of [] -> []; _ -> init curLine) 21 | '\t' -> case filter (isPrefixOf curLine) completions of 22 | [cmd] -> do 23 | putStr $ drop (length curLine) cmd 24 | loop cmd 25 | completions' -> do 26 | putStr $ "\b\n" ++ unlines completions' ++ ps ++ curLine 27 | loop curLine 28 | _ -> loop $ curLine ++ [c] 29 | -------------------------------------------------------------------------------- /Debug/Hoed/TestParEq.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DefaultSignatures, TypeOperators, FlexibleContexts, FlexibleInstances, StandaloneDeriving, CPP, DeriveGeneric #-} 2 | 3 | import Debug.Hoed.Prop 4 | import GHC.Generics hiding (moduleName) 5 | 6 | data A = A deriving (Eq, Generic) 7 | instance ParEq A 8 | data B = C B | D | E A A A | F Int Int | G B B deriving (Eq, Generic) 9 | instance ParEq B 10 | data H = I B B B | J Int B deriving (Eq, Generic) 11 | instance ParEq H 12 | 13 | main = print $ all (==True) [t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11, 14 | s1,s2,s3,s4,s5,s6] 15 | 16 | t1 = pareq_equiv A A 17 | t2 = pareq_equiv D D 18 | t3 = pareq_equiv (C D) D 19 | t4 = pareq_equiv D (C D) 20 | t5 = pareq_equiv (C (C D)) D 21 | t6 = pareq_equiv (E A A A) D 22 | t7 = pareq_equiv e e where e = E A A A 23 | t8 = pareq_equiv (C (C D)) (C (C (E A A A))) 24 | t9 = pareq_equiv (C (C D)) (C (F 4 2)) 25 | t10 = pareq_equiv c c where c = (C (F 4 2)) 26 | t11 = pareq_equiv c c where c = (C (F 4 2)) 27 | 28 | s1 = ((G (error "oeps") D) === (G D (F 4 2))) == False 29 | s2 = ((G D (F 4 2) === (G (error "oeps") D))) == False 30 | s3 = ((G (error "oeps") D) `parEq` (G D D)) == Nothing 31 | s4 = (I D (E A A A) D) === (I (error "oeps") D D) == False 32 | s5 = (I D D (E A A A)) === (I D (error "oeps") D) == False 33 | s6 = (I (E A A A) D D) === (I D D (error "oeps")) == False 34 | 35 | -- pareq should be equivalent to normal equality when the 36 | -- latter is conclusive 37 | pareq_equiv x y = (x == y) == b 38 | where (Just b) = x `parEq` y 39 | -------------------------------------------------------------------------------- /Debug/Hoed/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | module Debug.Hoed.Util where 3 | 4 | import System.Clock 5 | import System.IO 6 | 7 | data Verbosity = Verbose | Silent 8 | 9 | -- | Conditional output to stderr 10 | condPutStr :: Verbosity -> String -> IO () 11 | condPutStr Silent _ = return () 12 | condPutStr Verbose msg = hPutStr stderr msg 13 | 14 | -- | Conditional output to stderr 15 | condPutStrLn :: Verbosity -> String -> IO () 16 | condPutStrLn Silent _ = return () 17 | condPutStrLn Verbose msg = hPutStrLn stderr msg 18 | 19 | -------------------------------------------- 20 | -- Measuring elapsed time 21 | 22 | newtype Seconds = Seconds Double deriving (Eq, Ord, Num) 23 | 24 | instance Show Seconds where 25 | show (Seconds s) = show s ++ " seconds" 26 | 27 | stopWatch :: IO (IO Seconds) 28 | stopWatch = do 29 | t <- getTime Monotonic 30 | return $ do 31 | t' <- getTime Monotonic 32 | return (toSecs(diffTimeSpec t t')) 33 | where 34 | toSecs :: TimeSpec -> Seconds 35 | toSecs spec = Seconds $ fromIntegral(sec spec) + fromIntegral(nsec spec) * 1e-9 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Maarten Faddegon 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Maarten Faddegon nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Hoed - A Lightweight Haskell Tracer and Debugger 2 | 3 | Hoed is a tracer and debugger for the programming language Haskell. To locate a defect with Hoed you annotate suspected functions and compile as usual. Then you run your program, information about the annotated functions is collected. Finally you connect to a debugging session. 4 | 5 | Submit feature requests or contribute code on the 6 | 7 | [**Github projectpage**](https://github.com/MaartenFaddegon/Hoed) [![Build Status](https://travis-ci.org/MaartenFaddegon/Hoed.svg?branch=master)](https://travis-ci.org/MaartenFaddegon/Hoed) 8 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /build: -------------------------------------------------------------------------------- 1 | # cabal install 2 | # cabal install -p --enable-profiling --enable-library-profiling 3 | cabal build 4 | -------------------------------------------------------------------------------- /configure.Demo: -------------------------------------------------------------------------------- 1 | 2 | # when not interested in the CC examples the following is enough 3 | # cabal configure --flags="buildExamples" 4 | # otherwise, the following enables profiling 5 | 6 | 7 | CABAL_VER=`cabal --numeric-version | sed 's/\./ /g'` 8 | MAJOR=`echo $CABAL_VER | awk '{print $1}'` 9 | MINOR=`echo $CABAL_VER | awk '{print $2}'` 10 | 11 | if [ "$MAJOR" -le "1" -a "$MINOR" -le "18" ]; then 12 | cabal configure --enable-executable-profiling --enable-library-profiling --disable-optimization --flags="buildExamples" 13 | else 14 | cabal configure --enable-profiling --disable-optimization --flags="buildExamples" 15 | fi 16 | -------------------------------------------------------------------------------- /configure.Generic: -------------------------------------------------------------------------------- 1 | cabal configure --flags="validateGeneric" 2 | -------------------------------------------------------------------------------- /configure.Profiling: -------------------------------------------------------------------------------- 1 | cabal configure --enable-library-profiling --enable-executable-profiling --flags="buildExamples" --ghc-options="-fprof-auto -fprof-cafs" 2 | -------------------------------------------------------------------------------- /configure.Prop: -------------------------------------------------------------------------------- 1 | cabal configure --flags="validateProp" --disable-optimization 2 | -------------------------------------------------------------------------------- /configure.Pure: -------------------------------------------------------------------------------- 1 | cabal configure --flags="validatePure" 2 | -------------------------------------------------------------------------------- /configure.Stk: -------------------------------------------------------------------------------- 1 | CABAL_VER=`cabal --numeric-version | sed 's/\./ /g'` 2 | MAJOR=`echo $CABAL_VER | awk '{print $1}'` 3 | MINOR=`echo $CABAL_VER | awk '{print $2}'` 4 | 5 | if [ "$MAJOR" -le "1" -a "$MINOR" -le "18" ]; then 6 | cabal configure --enable-executable-profiling --enable-library-profiling --disable-optimization --flags="validateStk" 7 | else 8 | cabal configure --enable-profiling --disable-optimization --flags="validateStk" 9 | fi 10 | -------------------------------------------------------------------------------- /examples/AskName-hood.hs: -------------------------------------------------------------------------------- 1 | -- This is a copy of AskName.hs, annotated with Hood instead of Hoed. It shows 2 | -- that with the trace produced by Hood it is not easy to see that an 3 | -- exception was thrown in getAge. The only way we can tell seems to be the 4 | -- absence of "" in the result of the getAge computation statement. 5 | -- 6 | -- $ ./AskName-hood 7 | -- aaa 8 | -- def 9 | -- [Escaping Exception in Code : user error (Prelude.readIO: no parse)] 10 | -- 11 | -- -- getAge 12 | -- { \ _ -> _ 13 | -- } 14 | -- -- getName 15 | -- { \ _ -> _ 16 | -- } 17 | -- -- main 18 | -- _ 19 | 20 | 21 | 22 | import Debug.Hood.Observe 23 | 24 | data Person = Person { name :: String, age :: Int, city :: String } deriving Show 25 | 26 | instance Observable Person where 27 | observer (Person n a c) = send "Person" (return Person << n << a << c) 28 | 29 | main = runO $ observe "main" (emptyPerson >>= getName >>= getAge >>= getCity >>= print) 30 | 31 | emptyPerson :: IO Person 32 | emptyPerson = return (Person "" 0 "") 33 | 34 | getName :: Person -> IO Person 35 | getName = observe "getName" (\p' -> getName' p') 36 | getName' p = getLine >>= \x -> return (p{ name = x }) 37 | 38 | getAge :: Person -> IO Person 39 | getAge = observe "getAge" (\p' -> getAge' p') 40 | getAge' p = readLn >>= \x -> return (p{ age = x }) 41 | 42 | getCity :: Person -> IO Person 43 | getCity = observe "getCity" (\p' -> getCity' p') 44 | getCity' p = getLine >>= \x -> return (p{ city = x }) 45 | -------------------------------------------------------------------------------- /examples/AskName.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE StandaloneDeriving, DeriveGeneric #-} 2 | 3 | import Debug.Hoed 4 | 5 | data Person = Person { name :: String, age :: Int, city :: String } 6 | deriving (Show,Generic) 7 | 8 | instance Observable Person 9 | 10 | main = runO $ observe "main" 11 | ({-# SCC "main" #-} emptyPerson *>>= getName >>== getAge >>=* getCity >>= print) 12 | 13 | emptyPerson :: IO Person 14 | emptyPerson = return (Person "" 0 "") 15 | 16 | getName :: Identifier -> (Person -> IO Person, Int) 17 | getName d = let (f,i) = observe' "getName" d (\p' -> {-# SCC "getName" #-} getName' p') 18 | in (f, i) 19 | getName' p = getLine >>= \x -> return (p{ name = x }) 20 | 21 | getAge :: Identifier -> (Person -> IO Person, Int) 22 | getAge d = let (f,i) = observe' "getAge" d (\p' -> {-# SCC "getAge" #-} getAge' p') 23 | in (f, i) 24 | getAge' p = readLn >>= \x -> return (p{ age = x }) 25 | 26 | getCity :: Identifier -> (Person -> IO Person, Int) 27 | getCity d = let (f,i) = observe' "getCity" d (\p' -> {-# SCC "getCity" #-} getCity' p') 28 | in (f, i) 29 | getCity' p = getLine >>= \x -> return (p{ city = x }) 30 | -------------------------------------------------------------------------------- /examples/BreadthFirst/BreadthFirst1Defective.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} 2 | import Debug.Hoed.Pure 3 | import Data.List(partition) 4 | 5 | ---------------------------------------------------------------------- 6 | -- The tree library 7 | 8 | data Tree a = Node a (Tree a) (Tree a) | Leaf 9 | deriving (Generic, Observable) 10 | 11 | breadthFirst :: Observable a => Tree a -> [a] 12 | breadthFirst = observe "breadthFirst" $ \tree -> fold [tree] 13 | 14 | fold = observe "fold" fold' 15 | fold' [] = [] 16 | fold' queue = map nodeVal queue ++ concatMap (fold . subTrees) queue 17 | -- ^ defective; goes in depth first! 18 | -- fold' queue = map nodeVal queue ++ fold (concatMap subTrees queue) 19 | 20 | nodeVal (Node x t1 t2) = x 21 | 22 | subTrees (Node x t1 t2) = [t1,t2] 23 | subTrees Leaf = [] 24 | 25 | depth :: Observable a => Tree a -> Int -> [a] 26 | depth d = take ((d+1)*2) (drop (2^d-1) (breadthFirst (mkTree []))) 27 | 28 | ---------------------------------------------------------------------- 29 | -- the Coin flip application 30 | 31 | data Coin = Head | Tail 32 | deriving (Eq, Generic, Observable) 33 | 34 | mkTree c = Node c (mkTree (Head : c)) (mkTree (Tail : c)) 35 | 36 | prop_depthSound d = length h == length t 37 | where 38 | c = concat (depth d) 39 | (h,t) = partition (==Head) c 40 | 41 | main = runO (print (prop_depthSound 3)) 42 | -------------------------------------------------------------------------------- /examples/BreadthFirst/BreadthFirst2Defective.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, Rank2Types #-} 2 | import Debug.Hoed.Pure 3 | 4 | ---------------------------------------------------------------------- 5 | -- The tree library 6 | 7 | data Tree a = Node a (Tree a) (Tree a) | Leaf 8 | 9 | $(observedTypes "breadthFirst" [ [t| forall a . Tree a|], [t| forall a . [a] |] ]) 10 | 11 | breadthFirst :: Tree a -> [a] 12 | breadthFirst = $(observeTempl "breadthFirst") (\tree -> fold [tree]) 13 | where 14 | fold [] = [] 15 | fold queue = map nodeVal queue ++ concatMap (fold . subTrees) queue 16 | -- ^ defective; goes in depth first! 17 | -- fold queue = map nodeVal queue ++ fold (concatMap subTrees queue) 18 | 19 | nodeVal (Node x t1 t2) = x 20 | 21 | subTrees (Node x t1 t2) = [t1,t2] 22 | subTrees Leaf = [] 23 | 24 | data Coin = Head | Tail 25 | deriving (Eq) 26 | 27 | mkTree c = Node c (mkTree (Head : c)) (mkTree (Tail : c)) 28 | 29 | afterFlip d = take ((d+1)*2) (drop (2^d-1) (breadthFirst (mkTree []))) 30 | 31 | prop_coinTreeLength d = all (\c -> length c == d) (afterFlip d) 32 | 33 | prop_afterFlipSound d = length h == length t 34 | where 35 | c = concat (afterFlip d) 36 | h = filter (==Head) c 37 | t = filter (==Tail) c 38 | 39 | main = runO (print (prop_afterFlipSound 3)) 40 | -------------------------------------------------------------------------------- /examples/BreadthFirst/BreadthFirst2Sound.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, Rank2Types #-} 2 | import Debug.Hoed.Pure 3 | 4 | data Tree a = Node a (Tree a) (Tree a) | Leaf a 5 | 6 | $(observedTypes "breadthFirst" [ [t| forall a . Tree a|], [t| forall a . [a] |] ]) 7 | 8 | breadthFirst :: Tree a -> [a] 9 | breadthFirst = $(observeTempl "breadthFirst") (\tree -> fold [tree]) 10 | where 11 | fold [] = [] 12 | fold queue = map nodeVal queue ++ fold (concatMap subTrees queue) 13 | 14 | nodeVal (Node x t1 t2) = x 15 | nodeVal (Leaf x) = x 16 | 17 | subTrees (Node x t1 t2) = [t1,t2] 18 | subTrees (Leaf x) = [] 19 | 20 | data Coin = Head | Tail 21 | deriving (Eq, Show) 22 | 23 | mkTree c = Node c (mkTree (Head : c)) (mkTree (Tail : c)) 24 | 25 | afterFlip d = take ((d+1)*2) (drop (2^d-1) (breadthFirst (mkTree []))) 26 | 27 | prop_coinTreeLength d = all (\c -> length c == d) (afterFlip d) 28 | 29 | prop_afterFlipSound d = length h == length t 30 | where 31 | c = concat (afterFlip d) 32 | h = filter (==Head) c 33 | t = filter (==Tail) c 34 | 35 | main = runO (print (prop_afterFlipSound 3)) 36 | -------------------------------------------------------------------------------- /examples/CNF_unsound_demorgan__with_properties/Main.hs: -------------------------------------------------------------------------------- 1 | -- A program with unexpected output. 2 | import CNF 3 | import Debug.Hoed.Pure 4 | 5 | main = runOwp properties $ print (prop_negin_correct negin eg) 6 | where 7 | properties = [Propositions 8 | [ mkProposition cnfModule "prop_negin_complete" 9 | `ofType` BoolProposition 10 | `withSignature` [SubjectFunction,Argument 0] 11 | , mkProposition cnfModule "prop_negin_sound" 12 | `ofType` BoolProposition 13 | `withSignature` [SubjectFunction,Argument 0] 14 | ] Specify "negin" [] 15 | ] 16 | cnfModule = Module "CNF" "../examples/CNF_unsound_demorgan__with_properties/" 17 | -------------------------------------------------------------------------------- /examples/Digraph_not_data_invariant__with_properties/Main.hs: -------------------------------------------------------------------------------- 1 | -- A program with unexpected output. 2 | import Digraph 3 | import Debug.Hoed.Pure 4 | 5 | main = runOwp properties $ print (prop_assoc1toNdigraph eg) 6 | where 7 | properties = [ Propositions [mkProposition digraphModule "prop_assoc1toNdigraph" `ofType` BoolProposition `withSignature` [Argument 0]] 8 | Specify "assoc1toNdigraph" [] 9 | , Propositions [mkProposition digraphModule "prop_mergeAndSortTargets" `ofType` BoolProposition `withSignature` [Argument 0]] 10 | Specify "mergeAndSortTargets" [] 11 | , Propositions [mkProposition digraphModule "prop_addMissingSources" `ofType` BoolProposition `withSignature` [Argument 0]] 12 | Specify "addMissingSources" [] 13 | ] 14 | digraphModule = Module "Digraph" "../examples/Digraph_not_data_invariant__with_properties/" 15 | -------------------------------------------------------------------------------- /examples/Example1.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | 3 | f :: Int -> Int 4 | f = observe "f" $ \x -> {-# SCC "f" #-} if x > 0 then g x else 0 5 | 6 | g :: Int -> Int 7 | g = observe "g" $ \x -> {-# SCC "g" #-} x `div` 2 8 | 9 | main = runO $ print ((f 2) + (f 0)) 10 | -------------------------------------------------------------------------------- /examples/Example3.lhs: -------------------------------------------------------------------------------- 1 | > {-# LANGUAGE TemplateHaskell, Rank2Types #-} 2 | > import Debug.Hoed 3 | 4 | > $(observedTypes "k" []) 5 | > $(observedTypes "l" []) 6 | > $(observedTypes "m" []) 7 | > $(observedTypes "n" []) 8 | 9 | 10 | > main = runO $ print (k 1) 11 | 12 | > k :: Int -> Int 13 | > k x = $(observeTempl "k") k' x 14 | > k' x = {-# SCC "k" #-} k'' x 15 | > k'' x = (l x) + (m $ x + 1) 16 | 17 | > l :: Int -> Int 18 | > l x = $(observeTempl "l") l' x 19 | > l' x = {-# SCC "l" #-} m x 20 | 21 | > m :: Int -> Int 22 | > m x = $(observeTempl "m") m' x 23 | > m' x = {-# SCC "m" #-} n x 24 | 25 | > n :: Int -> Int 26 | > n x = $(observeTempl "n") n' x 27 | > n' x = {-# SCC "n" #-} x 28 | -------------------------------------------------------------------------------- /examples/Example4.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | 3 | main = runO $ print (observe "main" $ 42 :: Int) 4 | -------------------------------------------------------------------------------- /examples/ExpressionSimplifier/Main1.hs: -------------------------------------------------------------------------------- 1 | -- A program with unexpected output. 2 | 3 | import MyModule 4 | import Debug.Hoed.Pure 5 | 6 | main = testO prop_idemSimplify (Mul (Const 1) (Const 2)) 7 | -------------------------------------------------------------------------------- /examples/ExpressionSimplifier/Main2.hs: -------------------------------------------------------------------------------- 1 | -- A program with unexpected output. 2 | 3 | import MyModule 4 | import Debug.Hoed.Pure 5 | 6 | -- main = quickcheck prop_idemSimplify 7 | main = testOwp properties prop_idemSimplify (Mul (Const 1) (Const 2)) 8 | where 9 | properties = [ Propositions [mkProposition myModule "prop_idemOne" `ofType` BoolProposition `withSignature` [Argument 0] 10 | ] PropertiesOf "one" [] 11 | , Propositions [ mkProposition myModule "prop_idemZero" `ofType` BoolProposition `withSignature` [Argument 0] 12 | ] PropertiesOf "zero" [] 13 | , Propositions [ mkProposition myModule "prop_idemSimplify" `ofType` BoolProposition `withSignature` [Argument 0] 14 | ] PropertiesOf "simplify" [] 15 | ] 16 | myModule = Module "MyModule" "../examples/ExpressionSimplifier" 17 | -------------------------------------------------------------------------------- /examples/ExpressionSimplifier/MyModule.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module MyModule where 3 | import Debug.Hoed.Pure 4 | 5 | -------------------------------------------------------------------------------- 6 | -- Data types 7 | 8 | data Expr = Mul Expr Expr | Div Expr Expr | Const Int 9 | deriving (Eq,Show,Generic) 10 | 11 | instance Observable Expr 12 | 13 | -------------------------------------------------------------------------------- 14 | -- The simplifier we want to test 15 | 16 | simplify :: Expr -> Expr 17 | simplify = observe "simplify" simplify' 18 | simplify' (Mul e1 e2) = (one . zero) $ Mul (simplify e1) (simplify e2) 19 | simplify' (Div e1 e2) = (one . zero) $ Div (simplify e1) (simplify e2) 20 | simplify' e = (one . zero) e 21 | 22 | one = observe "one" one' 23 | one' (Mul expr (Const 1)) = expr 24 | one' (Mul e1 e2) = Mul e2 e1 25 | one' (Div expr (Const 1)) = expr 26 | one' expr = expr 27 | 28 | zero = observe "zero" zero' 29 | zero' (Mul expr (Const 0)) = Const 0 30 | zero' (Div expr (Const 0)) = Const 0 31 | zero' expr = expr 32 | 33 | -------------------------------------------------------------------------------- 34 | -- The propositions 35 | 36 | idem :: Eq a => (a -> a) -> a -> Bool 37 | idem f x = f x == (f . f) x 38 | 39 | prop_idemSimplify :: Expr -> Bool 40 | prop_idemSimplify = idem simplify 41 | 42 | prop_idemOne :: Expr -> Bool 43 | prop_idemOne = idem one 44 | 45 | prop_idemZero :: Expr -> Bool 46 | prop_idemZero = idem zero 47 | -------------------------------------------------------------------------------- /examples/FPretty/Main.hs: -------------------------------------------------------------------------------- 1 | import FPretty 2 | import Debug.Hoed.Pure 3 | 4 | main = runO $ case pretty 5 d of 5 | "one\n two\nthree" -> putStrLn "Success!" 6 | res -> putStrLn $ "Unexpected result:\n" ++ res 7 | 8 | where 9 | d = group (nest 2 (text "one" <> softline <> text "two")) 10 | <> group (softline <> text "three") 11 | -------------------------------------------------------------------------------- /examples/FPretty__CC/Main.hs: -------------------------------------------------------------------------------- 1 | import FPretty 2 | import Debug.Hoed.Stk 3 | 4 | main = runO $ case pretty 5 d of 5 | "one\n two\nthree" -> putStrLn "Success!" 6 | res -> putStrLn $ "Unexpected result:\n" ++ res 7 | 8 | where 9 | d = group (nest 2 (text "one" <> softline <> text "two")) 10 | <> group (softline <> text "three") 11 | -------------------------------------------------------------------------------- /examples/Foldl.hs: -------------------------------------------------------------------------------- 1 | -- Foldl is an example of a higher order function with state (sometimes called 2 | -- the accumulator). 3 | -- 4 | -- In this example we demonstrate how a combination of wrapping 5 | -- the higher order function "foldl" and transforming the callee "g" 6 | -- gives us a notion of order between the callee-observations. 7 | 8 | import Prelude hiding (foldl) 9 | import qualified Prelude 10 | import Debug.Hoed(printO,observe,observe',Identifier(..),Observable) 11 | 12 | -- Prelude.foldl :: (b -> a -> b) -> b [a] -> b 13 | 14 | foldl :: (Observable a, Observable b) => ((b,Identifier) -> a -> (b,Int)) -> b -> [a] -> b 15 | foldl fn z = observe "foldl" 16 | (\xs -> fst $ {-# SCC "foldl" #-} Prelude.foldl fn' (z,UnknownId) xs) 17 | where fn' a x = let (r,i) = fn a x in (r,InSequenceAfter i) 18 | 19 | -- g :: Int -> Int -> Int 20 | -- g x y = x + y 21 | 22 | g :: (Int,Identifier) -> Int -> (Int,Int) 23 | g (a1,id) a2 = let (fn,i) = observe' "g" id (\a1' a2' -> {-# SCC "g" #-} g_orig a1' a2') 24 | in (fn a1 a2,i) 25 | 26 | where g_orig x y = x + y 27 | 28 | f :: [Int] -> Int 29 | f xs = foldl g 10 xs 30 | 31 | main :: IO () 32 | main = printO (f [1,2,3]) 33 | -------------------------------------------------------------------------------- /examples/HeadOnEmpty.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | 3 | main = printO x 4 | 5 | x :: Int 6 | x = observe "f" ({-# SCC "f" #-} h head xs) 7 | 8 | xs :: [Int] 9 | xs = observe "xs" ({-# SCC "xs" #-} []) 10 | 11 | h :: ([Int] -> Int) -> [Int] -> Int 12 | h = observe "h" (\a' is' -> {-# SCC "h" #-} a' is') 13 | -------------------------------------------------------------------------------- /examples/HeadOnEmpty2.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | import GHC.IO(failIO) 3 | import Control.Exception(catch,SomeException) 4 | 5 | main = runO $ do 6 | (print (h xs)) `catch` (handleExc "First one went wrong:") 7 | ((f xs) >>= print) `catch` (handleExc "Second one went wrong:") 8 | 9 | -- Functions like 'readLn' use failIO. These exception are NOT traced. 10 | f :: [Int] -> IO Int 11 | f = observe "f" (\ys -> failIO "Oops from f") 12 | 13 | -- Functions like 'head' use error. These exceptions are traced. 14 | h :: [Int] -> Int 15 | h = observe "h" (\ys -> error "Oops from h!") 16 | 17 | xs :: [Int] 18 | xs = observe "xs" ({-# SCC "xs" #-} []) 19 | 20 | handleExc :: String -> SomeException -> IO () 21 | handleExc s e = putStrLn (s ++ show e) 22 | -------------------------------------------------------------------------------- /examples/IOException.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | -- import Debug.Hood.Observe 3 | import GHC.IO(failIO) 4 | import Control.Exception(catch, SomeException(..)) 5 | 6 | main = runO $ 7 | do (x >>= print) `catchAll` \e -> print ("oops-x: " ++ show e) 8 | (y >>= print) `catchAll` \e -> print ("oops-y: " ++ show e) 9 | 10 | x :: IO Int 11 | x = gdmobserve "x" (error "Failed to get x!") 12 | 13 | y :: IO Int 14 | y = gdmobserve "y" (failIO "Failed to get e!") 15 | 16 | catchAll :: IO a -> (SomeException -> IO a) -> IO a 17 | catchAll = catch 18 | -------------------------------------------------------------------------------- /examples/IndirectRecursion.lhs: -------------------------------------------------------------------------------- 1 | This is an example of how information is lost as a result of trunction of the 2 | cost centre stack. The actual call graph is of this program is: 3 | 4 | main -> f 1 -> g 2 -> f 3 -> h 1 5 | 6 | But with pushing "f" a second time the "g" label is also lost. Additionally 7 | the h-statement is associated with the stack [f], which can either be from the 8 | untruncated f statement or the truncated f statement. We therefore infer the 9 | following call graph: 10 | 11 | main -> f 1 -> {f 3, g 2} -> h 1 12 | \_________________^ 13 | 14 | > {-# LANGUAGE TemplateHaskell, Rank2Types #-} 15 | > import Debug.Hoed 16 | 17 | > $(observedTypes "f" []) 18 | > $(observedTypes "g" []) 19 | > $(observedTypes "h" []) 20 | 21 | > f :: Int -> Int 22 | > f x = $(observeTempl "f") f' x 23 | > f' x = {-# SCC "f" #-} f'' x 24 | > f'' 1 = g 2 25 | > f'' x = h (x + 1) 26 | 27 | > g :: Int -> Int 28 | > g x = $(observeTempl "g") g' x 29 | > g' x = {-# SCC "g" #-} g'' x 30 | > g'' x = f (x + 1) 31 | 32 | > h :: Int -> Int 33 | > h x = $(observeTempl "h") h' x 34 | > h' x = {-# SCC "h" #-} h'' x 35 | > h'' x = (x+1) 36 | 37 | > main = runO $ print (f 1) 38 | -------------------------------------------------------------------------------- /examples/Insertion_Sort_elements_disappear.hs: -------------------------------------------------------------------------------- 1 | -- Haskell version of the buggy insertion sort as shown in Lee Naish 2 | -- A Declarative Debugging Scheme. 3 | -- 4 | -- As Insort1, but with observe rather than templated observers. 5 | 6 | import Debug.Hoed.Pure 7 | 8 | -- Insertion sort. 9 | isort :: [Char] -> [Char] 10 | isort = observe "isort" isort' 11 | isort' [] = [] 12 | isort' (n:ns) = insert n (isort ns) 13 | 14 | -- Insert number into sorted list. 15 | insert :: Char -> [Char] -> [Char] 16 | insert = observe "insert" insert' 17 | insert' :: Char -> [Char] -> [Char] 18 | insert' n [] = [n] 19 | insert' n (m:ms) 20 | | n <= m = n : ms -- bug: `m' is missing in this case 21 | | otherwise = m : (insert n ms) 22 | 23 | main = printO $ isort "bug" 24 | -------------------------------------------------------------------------------- /examples/Insort.lhs: -------------------------------------------------------------------------------- 1 | Haskell version of the buggy insertion sort as shown in Lee Naish 2 | A Declarative Debugging Scheme. 3 | 4 | > {-# LANGUAGE TemplateHaskell, Rank2Types #-} 5 | > import Debug.Hoed 6 | > $(observedTypes "isort" [[t|forall a . Observable a => [] a|]]) 7 | > $(observedTypes "insert" [[t|forall a . Observable a => [] a|]]) 8 | > $(observedTypes "result" [[t|forall a . Observable a => [] a|]]) 9 | 10 | Insertion sort. 11 | 12 | > isort :: [Int] -> [Int] 13 | > isort ns = $(observeTempl "isort") (\ns -> {-# SCC "isort" #-} isort' ns) ns 14 | > isort' [] = [] 15 | > isort' (n:ns) = insert n (isort ns) 16 | 17 | Insert number into sorted list. 18 | 19 | > insert :: Int -> [Int] -> [Int] 20 | > insert n ms = ($(observeTempl "insert") (\n ms -> {-# SCC "insert" #-} insert' n ms)) n ms 21 | > insert' :: Int -> [Int] -> [Int] 22 | > insert' n [] = [n] 23 | > insert' n (m:ms) 24 | > | n <= m = n : ms -- bug: `m' is missing in this case 25 | > | otherwise = m : (insert n ms) 26 | 27 | > main = printO $ 28 | > $(observeTempl "result") ({-# SCC "result" #-} isort [1,2]) 29 | -------------------------------------------------------------------------------- /examples/Parity.hs: -------------------------------------------------------------------------------- 1 | -- A defective parity check. 2 | import Debug.Hoed.Pure 3 | 4 | isOdd n = isEven (plusOne n) 5 | 6 | isEven = observe "isEven" isEven' 7 | isEven' n = mod2 n == 0 8 | 9 | plusOne = observe "plusOne" plusOne' 10 | plusOne' n = n + 1 11 | 12 | mod2 = observe "mod2" mod2' 13 | mod2' n = div n 2 14 | 15 | prop_isOdd :: Int -> Bool 16 | prop_isOdd x = isOdd (2*x+1) 17 | 18 | main :: IO () 19 | main = testO prop_isOdd 1 20 | -------------------------------------------------------------------------------- /examples/Queens__with_properties/Main.hs: -------------------------------------------------------------------------------- 1 | import Queens 2 | 3 | main = doit 4 | -------------------------------------------------------------------------------- /examples/Queens__with_properties/Main2.hs: -------------------------------------------------------------------------------- 1 | import Queens 2 | 3 | main = doit2 4 | -------------------------------------------------------------------------------- /examples/Queens__with_properties/Test1.hs: -------------------------------------------------------------------------------- 1 | import Queens 2 | 3 | main = test1 4 | -------------------------------------------------------------------------------- /examples/Queens__with_properties/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | 3 | module Types where 4 | import Test.QuickCheck hiding ((===)) 5 | import Debug.Hoed 6 | 7 | data Board = B [Int] deriving (Eq, Show, Generic) 8 | 9 | instance Observable Board 10 | instance ParEq Board 11 | 12 | instance Arbitrary Board where 13 | arbitrary = do b <- genBoard; return (B b) 14 | 15 | genBoard :: Gen [Int] 16 | genBoard = sized $ \n -> 17 | do m <- choose (0,n) 18 | k <- choose (0,n) 19 | vectorOf k (genPos m) 20 | 21 | genPos :: Int -> Gen Int 22 | genPos n | n < 1 = return 1 23 | genPos n = elements [1..n] 24 | 25 | data Configuration = Configuration Int Board 26 | deriving (Show,Eq, Generic) 27 | instance Observable Configuration 28 | instance ParEq Configuration 29 | -------------------------------------------------------------------------------- /examples/Responsibility.lhs: -------------------------------------------------------------------------------- 1 | > import Debug.Hoed 2 | 3 | sacc "outer" 1 + (sacc "inner" 2 * x) 4 | 5 | > ex1 :: Int -> Int 6 | > ex1 = (observe "outer") (\x -> {-# SCC "outer" #-} 7 | > 1 + (((observe "inner") (\x -> {-# SCC "inner" #-} 2 * x)) x) 8 | > ) 9 | 10 | (sacc "com" \f g x -> f (g x)) (sacc "add" (+1)) (sacc "mul" (*2)) 11 | 12 | > ex2 :: Int -> Int 13 | > ex2 = ((observe "com1") (\f g x -> {-# SCC "com1" #-} f (g x))) 14 | > ((observe "add1") ({-# SCC "add1" #-} (+1))) 15 | > ((observe "mul1") ({-# SCC "add1" #-} (*2))) 16 | 17 | > ex3 :: Int -> Int 18 | > ex3 = let f = ((observe "add2") ({-# SCC "add2" #-} (+1))) 19 | > g = ((observe "mul2") ({-# SCC "add2" #-} (*2))) 20 | > in ((observe "com2") (\x -> {-# SCC "com2" #-} f (g x))) 21 | 22 | 23 | > ex4 :: Int -> Int 24 | > ex4 = let f = ((observe "f") ({-# SCC "f" #-} (+1))) 25 | > g = ((observe "g") ({-# SCC "g" #-} (*2))) 26 | > in ((observe "h") ({-# SCC "h" #-} f . g)) 27 | 28 | 29 | > main = runO $ do print (ex1 4) 30 | > print (ex2 4) 31 | > print (ex3 4) 32 | > print (ex4 4) 33 | -------------------------------------------------------------------------------- /examples/Rot13.hs: -------------------------------------------------------------------------------- 1 | -- A defective ROT13 implemenation. 2 | import Data.Maybe 3 | import Data.Char 4 | import Debug.Hoed.Pure 5 | 6 | main = printO (prop_rot13length "Abc") 7 | 8 | ----------------------------------------------------------------------------- 9 | 10 | rot13 = observe "rot13" rot13' 11 | normalize = observe "normalize" normalize' 12 | rot13char = observe "rot13char" rot13char' 13 | 14 | rot13' = mapMaybe (\c -> rot13char (normalize c)) 15 | normalize' c = lookup c (zip ['a'..'z'] ['A' .. 'Z']) 16 | rot13char' Nothing = Nothing 17 | rot13char' (Just c) = lookup c table 18 | where table = zip ['A'..'Z'] (['N'..'Z'] ++ ['A'..'M']) 19 | 20 | prop_rot13length s = length t == length (rot13 t) 21 | where t = filter isAlpha s 22 | -------------------------------------------------------------------------------- /examples/Salary.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | import Debug.Hoed.Pure 3 | 4 | avgSalary :: [Employee] -> Float 5 | f :: [Employee] -> Float 6 | avg :: Float -> Float -> Employee -> Float 7 | 8 | ------------------------------------------------------------ 9 | -- defective computation of avarage salary (always 0.0) 10 | 11 | data Employee = Employee {getName :: String, getSalary :: Float} deriving Generic 12 | 13 | avgSalary es = foldl (avg 1.0) 0.0 es 14 | -- avgSalary es = foldl (avg (f es)) 0.0 es 15 | f es = toFloat (1 `div` (length es)) 16 | avg' x acc (Employee _ s) = acc + (x * s) 17 | 18 | instance Observable Employee 19 | -- avgSalary = observe "avgSalary" avgSalary' 20 | -- f = observe "f" f' 21 | avg = observe "avg" avg' 22 | 23 | ------------------------------------------------------------ 24 | -- properties 25 | 26 | newtype Positive a = Positive {getPositive :: a} deriving Show 27 | 28 | prop_avgSalaryPositive :: [Positive Float] -> Bool 29 | prop_avgSalaryPositive ss = avgSalary (map mkEmployee ss) > 0.0 30 | where mkEmployee (Positive s) = Employee "X" s 31 | 32 | ------------------------------------------------------------ 33 | 34 | main = testO prop_avgSalaryPositive ss 35 | where ss = [Positive 3000.0, Positive 1800.0] 36 | employees = [Employee "Aafje" 3000, Employee "Ben" 2000] 37 | 38 | toFloat :: Int -> Float 39 | toFloat = fromInteger . toInteger 40 | -------------------------------------------------------------------------------- /examples/SimpleHO.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed.Pure 2 | 3 | ap4 :: (Int -> Int) -> Int 4 | ap4 = observe "ap4" (\f -> f 4) 5 | 6 | mod2 :: Int -> Int 7 | mod2 = observe "mod2" (\n -> div n 2) 8 | 9 | main = printO (ap4 mod2) 10 | -------------------------------------------------------------------------------- /examples/SternBrocot1/SternBrocot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} 2 | import Prelude hiding (Rational, fromRational) 3 | import Debug.Hoed.Pure 4 | 5 | data Rational = Integer :% Integer deriving (Eq, Generic, Observable, Show) 6 | data Tree = Tree Rational Tree Tree deriving (Generic, Observable) 7 | 8 | mkTree :: Integer -> Integer -> Integer -> Integer -> Tree 9 | mkTree a b c d = Tree (x :% y) (mkTree a b x y) (mkTree x y c d) 10 | where x = a+c 11 | y = b+d 12 | 13 | aproxRational :: Tree -> Float -> Float -> Rational 14 | aproxRational (Tree x left right) maxDelta y 15 | | delta > 0 = aproxRational left maxDelta y 16 | | delta < 0 = aproxRational right maxDelta y 17 | | abs delta <= maxDelta = x -- DEFECT: should be first guard! 18 | where delta = (fromRational x) - y 19 | 20 | main = printO $ (observe "aproxRational" aproxRational) (mkTree 0 1 1 0) 0.05 0.3 21 | 22 | fromRational :: Rational -> Float 23 | fromRational (x :% y) = (fromInteger x) / (fromInteger y) 24 | -------------------------------------------------------------------------------- /examples/SternBrocot1/build: -------------------------------------------------------------------------------- 1 | ghc --make SternBrocot 2 | -------------------------------------------------------------------------------- /examples/SternBrocot2/SternBrocot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} 2 | import Prelude hiding (Rational, fromRational) 3 | import Debug.Hoed.Pure 4 | 5 | data Rational = Integer :% Integer 6 | deriving (Eq, Generic, Observable, Show) 7 | 8 | data Tree = Node Rational Tree Tree | Leaf 9 | deriving (Generic, Observable) 10 | 11 | mkTree :: Integer -> Integer -> Integer -> Integer -> Tree 12 | mkTree a b c d = Node (x :% y) (mkTree a b x y) (mkTree x y c d) 13 | where x = a+c 14 | y = b+d 15 | 16 | toFloat :: Tree -> Float -> Rational 17 | toFloat (Node x left right) y 18 | | delta <= 0 = x 19 | | delta > 0 = toFloat left y 20 | | otherwise = toFloat right y 21 | where delta = (fromRational x) - y 22 | 23 | main = printO $ toFloat' (mkTree 0 1 1 0) 0.75 24 | where toFloat' = observe "toFloat" toFloat 25 | 26 | fromRational :: Rational -> Float 27 | fromRational (x :% y) = (fromInteger x) / (fromInteger y) 28 | -------------------------------------------------------------------------------- /examples/SternBrocot2/build: -------------------------------------------------------------------------------- 1 | ghc --make SternBrocot 2 | -------------------------------------------------------------------------------- /examples/TightRope.hs: -------------------------------------------------------------------------------- 1 | -- This is an example from the "Learn You A Haskell" tuturial. 2 | -- The story is that there is a guy walking with a Pole where birds 3 | -- can land on the left and right. If the difference between birds 4 | -- on the left and right gets too big he falls off the rope. This 5 | -- is indicated by Nothing. 6 | 7 | import Debug.Hoed(runO,observe) 8 | 9 | type Birds = Int 10 | type Pole = (Birds,Birds) 11 | 12 | landLeft :: Birds -> Pole -> Maybe Pole 13 | landLeft n p = observe "landLeft" (\n' p' -> {-# SCC "landLeft" #-} landLeft' n' p') n p 14 | landLeft' n (left,right) 15 | | abs ((left + n) - right) < 4 = Just (left + n, right) 16 | | otherwise = Nothing 17 | 18 | landRight :: Birds -> Pole -> Maybe Pole 19 | landRight n p = observe "landRight" (\n' p' -> {-# SCC "landRight" #-} landRight' n' p') n p 20 | landRight' n (left,right) 21 | | abs (left - (right + n)) < 4 = Just (left, right + n) 22 | | otherwise = Nothing 23 | where x + y = x Prelude.+ (abs y) 24 | 25 | walk :: Maybe Pole 26 | walk = observe "walk" $ {-# SCC "walk" #-} 27 | return (0,0) >>= landRight 1 >>= landLeft 1 28 | >>= landRight 2 >>= landRight (-1) >>= landRight 1 29 | 30 | main = runO $ print walk 31 | -------------------------------------------------------------------------------- /examples/TightRope3.hs: -------------------------------------------------------------------------------- 1 | -- This is an example from the "Learn You A Haskell" tuturial. 2 | -- The story is that there is a guy walking with a Pole where birds 3 | -- can land on the left and right. If the difference between birds 4 | -- on the left and right gets too big he falls off the rope. This 5 | -- is indicated by Nothing. 6 | 7 | import Debug.Hoed(runO,observe,observe',Identifier(..),(*>>=),(>>==),(>>=*)) 8 | 9 | type Birds = Int 10 | type Pole = (Birds,Birds) 11 | 12 | landLeft :: Birds -> Identifier -> (Pole -> Maybe Pole, Int) 13 | landLeft n d 14 | = let (f,i) = observe' "landLeft" d (\n' p' -> {-# SCC "landLeft" #-} landLeft' n' p') 15 | in (f n, i) 16 | landLeft' n (left,right) 17 | | abs ((left + n) - right) < 4 = Just (left + n, right) 18 | | otherwise = Nothing 19 | 20 | landRight :: Birds -> Identifier -> (Pole -> Maybe Pole, Int) 21 | landRight n d 22 | = let (f,i) = observe' "landRight" d (\n' p' -> {-# SCC "landRight" #-} landRight' n' p') 23 | in (f n, i) 24 | landRight' n (left,right) 25 | | abs (left - (right + n)) < 4 = Just (left, right + n) 26 | | otherwise = Nothing 27 | where x + y = x Prelude.+ (abs y) 28 | 29 | walk :: Maybe Pole 30 | walk = observe "walk" $ {-# SCC "walk" #-} 31 | return (0,0) *>>= landRight 1 >>== landLeft 1 32 | >>== landRight 2 >>== landRight (-1) >>=* landRight 1 33 | 34 | main = runO $ print walk 35 | -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/debugTree.dot: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v3 [label=<
greedyView (NonNegative 0) (StackSet (Screen (Workspace (...
>shape=none fontcolor=blue] 3 | v2 [label=<
greedyView (NonNegative 0) (StackSet (Screen (Workspace (...
>shape=none] 4 | v1 [label=<
greedyView (NonNegative 0) (StackSet (Screen (Workspace (...
>shape=none] 5 | v0 [label="."shape=none] 6 | v0 -> v2 [label=""] 7 | v0 -> v1 [label=""] 8 | v0 -> v3 [label=""] 9 | } 10 | -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/exe/Main: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/exe/Main -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/exe/Main.compilerMessages: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/exe/Main.compilerMessages -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/exe/Main.out: -------------------------------------------------------------------------------- 1 | False 2 | -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedCompTree.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedCompTree.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedCompTree.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedCompTree.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedCompTree.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedCompTree.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedTrace.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedTrace.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedTrace.prop_greedyView_local: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedTrace.prop_greedyView_local -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedTrace.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedTrace.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedTrace.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedTrace.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/savedTrace.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/savedTrace.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/wwwroot/debugTree.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/wwwroot/debugTree.png -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/wwwroot/faulty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/wwwroot/faulty.png -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/wwwroot/hoed-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/wwwroot/hoed-logo.png -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/wwwroot/loading.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/wwwroot/loading.gif -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/wwwroot/right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/wwwroot/right.png -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/wwwroot/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/wwwroot/test.png -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/wwwroot/unassessed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/wwwroot/unassessed.png -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/.Hoed/wwwroot/wrong.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad2__using_properties/.Hoed/wwwroot/wrong.png -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/README: -------------------------------------------------------------------------------- 1 | Sources from the test-suite of XMonad 0.11.1 and QuickCheck-1.2.0.1. 2 | -------------------------------------------------------------------------------- /examples/XMonad2__using_properties/Test/QuickCheck/Utils.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Test.QuickCheck.Utils 4 | -- Copyright : (c) Andy Gill 2001 5 | -- License : BSD-style (see the file libraries/base/LICENSE) 6 | -- 7 | -- Maintainer : libraries@haskell.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- These are some general purpose utilities for use with QuickCheck. 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Test.QuickCheck.Utils 16 | ( isAssociativeBy 17 | , isAssociative 18 | , isCommutableBy 19 | , isCommutable 20 | , isTotalOrder 21 | ) where 22 | 23 | import Prelude 24 | 25 | import Test.QuickCheck 26 | 27 | isAssociativeBy :: (Show a,Testable prop) 28 | => (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property 29 | isAssociativeBy (===) src (**) = 30 | forAll src $ \ a -> 31 | forAll src $ \ b -> 32 | forAll src $ \ c -> 33 | ((a ** b) ** c) === (a ** (b ** c)) 34 | 35 | isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property 36 | isAssociative = isAssociativeBy (==) arbitrary 37 | 38 | isCommutableBy :: (Show a,Testable prop) 39 | => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property 40 | isCommutableBy (===) src (**) = 41 | forAll src $ \ a -> 42 | forAll src $ \ b -> 43 | (a ** b) === (b ** a) 44 | 45 | isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property 46 | isCommutable = isCommutableBy (==) arbitrary 47 | 48 | isTotalOrder :: (Arbitrary a,Show a,Ord a) => a -> a -> Property 49 | isTotalOrder x y = 50 | classify (x > y) "less than" $ 51 | classify (x == y) "equals" $ 52 | classify (x < y) "greater than" $ 53 | x < y || x == y || x > y 54 | -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/exe/Main.compilerMessages: -------------------------------------------------------------------------------- 1 | [7 of 7] Compiling Main ( .Hoed/exe/Main.hs, .Hoed/exe/Main.o ) 2 | 3 | .Hoed/exe/Main.hs:12:144: Not in scope: ‘x’ 4 | -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/exe/Main.hs: -------------------------------------------------------------------------------- 1 | -- This file is generated by the Haskell debugger Hoed 2 | import Properties 3 | import qualified Debug.Hoed.Pure as Hoed 4 | import System.Random 5 | import Data.Maybe 6 | import Test.QuickCheck 7 | import XMonad.StackSet 8 | import Test.QuickCheck 9 | import qualified Data.Map as M 10 | import System.Random 11 | import Data.Maybe 12 | main = Hoed.runOstore "prop_swap_right_I" $ do g <- newStdGen; print . fromJust . ok . (generate 1 g) . evaluate $ prop_swap_right_I swapDown x (NonNegative 1) {- generateArgs -} (StackSet (Screen (Workspace (NonNegative ((0)) ) ((-2)) (Just (Stack (('o')) ((:) (('a')) (([])) ) ((:) (('b')) (([])) ) ) ) ) ((0)) ((0)) ) (([])) (([])) (( (M.fromList []) )) ) {- more: [Just 14: Enter (P 13 1),Just 15: Cons 4 "StackSet" (P 13 1)] -} 13 | -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/exe/Main.out: -------------------------------------------------------------------------------- 1 | 0123Falsifiable, after 3 tests: 2 | NonNegative 1 3 | -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_all_l: -------------------------------------------------------------------------------- 1 |  -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_all_r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_all_r -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_master_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_master_I -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_master_idempotent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_master_idempotent -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_right_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_swap_right_I -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedCompTree.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedTrace.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_greedyView_local: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedTrace.prop_greedyView_local -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedTrace.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedTrace.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_swap_all_l: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_swap_all_r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedTrace.prop_swap_all_r -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_swap_master_idempotent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedTrace.prop_swap_master_idempotent -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_swap_right_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedTrace.prop_swap_right_I -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/savedTrace.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/savedTrace.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/wwwroot/debugTree.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/wwwroot/debugTree.png -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/wwwroot/faulty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/wwwroot/faulty.png -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/wwwroot/hoed-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/wwwroot/hoed-logo.png -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/wwwroot/loading.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/wwwroot/loading.gif -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/wwwroot/right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/wwwroot/right.png -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/wwwroot/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/wwwroot/test.png -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/wwwroot/unassessed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/wwwroot/unassessed.png -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/.Hoed/wwwroot/wrong.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad3__using_properties/.Hoed/wwwroot/wrong.png -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/README: -------------------------------------------------------------------------------- 1 | Sources from the test-suite of XMonad 0.11.1 and QuickCheck-1.2.0.1. 2 | 3 | --- 4 | 5 | Defect in reverseStack. 6 | 12 computation statements 7 | 8 | | swapDown (StackSet (Screen (Workspace (NonNegative 0) -2 (Just (Stack 'o' "a" "b"))) 9 | | 0 0) [] [] (M.fromList []) ) 10 | | 11 | | = StackSet (Screen (Workspace (NonNegative 0) -2 (Just (Stack 'o' "baa" "a"))) 12 | | 0 0) [] [] 13 | | (M.fromList []) 14 | 15 | Judged as wrong by property. 16 | 17 | | reverseStack (Stack 'o' "a" "ba") 18 | | 19 | | = Stack 'o' "baa" "a" 20 | 21 | Judge as wrong by human oracle. 22 | 23 | Detect located. 24 | -------------------------------------------------------------------------------- /examples/XMonad3__using_properties/Test/QuickCheck/Utils.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Test.QuickCheck.Utils 4 | -- Copyright : (c) Andy Gill 2001 5 | -- License : BSD-style (see the file libraries/base/LICENSE) 6 | -- 7 | -- Maintainer : libraries@haskell.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- These are some general purpose utilities for use with QuickCheck. 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Test.QuickCheck.Utils 16 | ( isAssociativeBy 17 | , isAssociative 18 | , isCommutableBy 19 | , isCommutable 20 | , isTotalOrder 21 | ) where 22 | 23 | import Prelude 24 | 25 | import Test.QuickCheck 26 | 27 | isAssociativeBy :: (Show a,Testable prop) 28 | => (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property 29 | isAssociativeBy (===) src (**) = 30 | forAll src $ \ a -> 31 | forAll src $ \ b -> 32 | forAll src $ \ c -> 33 | ((a ** b) ** c) === (a ** (b ** c)) 34 | 35 | isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property 36 | isAssociative = isAssociativeBy (==) arbitrary 37 | 38 | isCommutableBy :: (Show a,Testable prop) 39 | => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property 40 | isCommutableBy (===) src (**) = 41 | forAll src $ \ a -> 42 | forAll src $ \ b -> 43 | (a ** b) === (b ** a) 44 | 45 | isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property 46 | isCommutable = isCommutableBy (==) arbitrary 47 | 48 | isTotalOrder :: (Arbitrary a,Show a,Ord a) => a -> a -> Property 49 | isTotalOrder x y = 50 | classify (x > y) "less than" $ 51 | classify (x == y) "equals" $ 52 | classify (x < y) "greater than" $ 53 | x < y || x == y || x > y 54 | -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/debugTree.dot: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v1 [label=<
findTag 'w' (StackSet (Screen (Workspace (NonNegative 4) ...
>shape=none fontcolor=blue] 3 | v0 [label=<
member 'w' (StackSet (Screen (Workspace (NonNegative 4) _...
>shape=none] 4 | v0 -> v1 [label=""] 5 | } 6 | -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/exe/Main: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/exe/Main -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/exe/Main.compilerMessages: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/exe/Main.compilerMessages -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/exe/Main.out: -------------------------------------------------------------------------------- 1 | False 2 | -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_allWindowsMember: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_allWindowsMember -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_findIndex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_findIndex -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_all_l: -------------------------------------------------------------------------------- 1 |  -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_all_r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_all_r -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_master_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_master_I -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_master_idempotent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_master_idempotent -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_right_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_swap_right_I -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedCompTree.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_allWindowsMember: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_allWindowsMember -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_greedyView_local: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_greedyView_local -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_swap_all_l: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_swap_all_r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_swap_all_r -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_swap_master_idempotent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_swap_master_idempotent -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_swap_right_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_swap_right_I -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/savedTrace.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/savedTrace.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/wwwroot/debugTree.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/wwwroot/debugTree.png -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/wwwroot/faulty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/wwwroot/faulty.png -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/wwwroot/hoed-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/wwwroot/hoed-logo.png -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/wwwroot/loading.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/wwwroot/loading.gif -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/wwwroot/right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/wwwroot/right.png -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/wwwroot/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/wwwroot/test.png -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/wwwroot/unassessed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/wwwroot/unassessed.png -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/.Hoed/wwwroot/wrong.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad4__using_properties/.Hoed/wwwroot/wrong.png -------------------------------------------------------------------------------- /examples/XMonad4__using_properties/Test/QuickCheck/Utils.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Test.QuickCheck.Utils 4 | -- Copyright : (c) Andy Gill 2001 5 | -- License : BSD-style (see the file libraries/base/LICENSE) 6 | -- 7 | -- Maintainer : libraries@haskell.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- These are some general purpose utilities for use with QuickCheck. 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Test.QuickCheck.Utils 16 | ( isAssociativeBy 17 | , isAssociative 18 | , isCommutableBy 19 | , isCommutable 20 | , isTotalOrder 21 | ) where 22 | 23 | import Prelude 24 | 25 | import Test.QuickCheck 26 | 27 | isAssociativeBy :: (Show a,Testable prop) 28 | => (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property 29 | isAssociativeBy (===) src (**) = 30 | forAll src $ \ a -> 31 | forAll src $ \ b -> 32 | forAll src $ \ c -> 33 | ((a ** b) ** c) === (a ** (b ** c)) 34 | 35 | isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property 36 | isAssociative = isAssociativeBy (==) arbitrary 37 | 38 | isCommutableBy :: (Show a,Testable prop) 39 | => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property 40 | isCommutableBy (===) src (**) = 41 | forAll src $ \ a -> 42 | forAll src $ \ b -> 43 | (a ** b) === (b ** a) 44 | 45 | isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property 46 | isCommutable = isCommutableBy (==) arbitrary 47 | 48 | isTotalOrder :: (Arbitrary a,Show a,Ord a) => a -> a -> Property 49 | isTotalOrder x y = 50 | classify (x > y) "less than" $ 51 | classify (x == y) "equals" $ 52 | classify (x < y) "greater than" $ 53 | x < y || x == y || x > y 54 | -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/exe/Main.compilerMessages: -------------------------------------------------------------------------------- 1 | [7 of 7] Compiling Main ( .Hoed/exe/Main.hs, .Hoed/exe/Main.o ) 2 | 3 | .Hoed/exe/Main.hs:13:212: Not in scope: ‘x’ 4 | 5 | .Hoed/exe/Main.hs:13:337: Not in scope: ‘x’ 6 | 7 | .Hoed/exe/Main.hs:13:429: Not in scope: ‘x’ 8 | 9 | .Hoed/exe/Main.hs:13:492: Not in scope: ‘x’ 10 | 11 | .Hoed/exe/Main.hs:13:555: Not in scope: ‘x’ 12 | 13 | .Hoed/exe/Main.hs:13:612: Not in scope: ‘x’ 14 | 15 | .Hoed/exe/Main.hs:13:629: Not in scope: ‘x’ 16 | 17 | .Hoed/exe/Main.hs:13:844: Not in scope: ‘x’ 18 | 19 | .Hoed/exe/Main.hs:13:881: Not in scope: ‘%’ 20 | 21 | .Hoed/exe/Main.hs:13:892: Not in scope: ‘%’ 22 | 23 | .Hoed/exe/Main.hs:13:900: Not in scope: ‘%’ 24 | 25 | .Hoed/exe/Main.hs:13:911: Not in scope: ‘%’ 26 | 27 | .Hoed/exe/Main.hs:13:938: Not in scope: ‘%’ 28 | 29 | .Hoed/exe/Main.hs:13:946: Not in scope: ‘%’ 30 | 31 | .Hoed/exe/Main.hs:13:954: Not in scope: ‘%’ 32 | 33 | .Hoed/exe/Main.hs:13:962: Not in scope: ‘%’ 34 | -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/exe/Main.hs: -------------------------------------------------------------------------------- 1 | -- This file is generated by the Haskell debugger Hoed 2 | import Properties hiding (fromList) 3 | import qualified Debug.Hoed.Pure as Hoed 4 | import System.Random 5 | import Data.Maybe 6 | import Test.QuickCheck 7 | import XMonad.StackSet 8 | import Test.QuickCheck 9 | import qualified Data.Map as M 10 | import Data.Map(fromList) 11 | import System.Random 12 | import Data.Maybe 13 | main = Hoed.runOstore "prop_findIndex" $ do g <- newStdGen; print . fromJust . ok . (generate 1 g) . evaluate $ prop_findIndex findTag {- generateArgs -} (StackSet (Screen (Workspace (NonNegative ((4)) ) x (0) (Just (Stack (('e')) (([])) (([])) ) ) ) ((1)) ((1)) ) ((:) (Screen (Workspace (NonNegative ((2)) ) x (0) (Nothing) ) ((0)) ((1)) ) (([])) ) ((:) (Workspace (NonNegative ((0)) ) x (1) (Nothing) ) ((:) (Workspace (NonNegative ((1)) ) x (2) (Nothing) ) ((:) (Workspace (NonNegative ((3)) ) x (2) (Just (Stack (('a')) (([])) ((:) (('w')) x ("s") ) ) ) ) x ([Workspace {tag = NonNegative 1, layout = -1, stack = Just (Stack {focus = 'y', up = "", down = "e"})},Workspace {tag = NonNegative 1, layout = 2, stack = Just (Stack {focus = 'p', up = "", down = ""})}]) ) ) ) x (fromList [('p',RationalRect ((-1) % 1) ((-2) % 1) (0 % 1) ((-2) % 1)),('x',RationalRect (1 % 1) (2 % 1) (1 % 1) (1 % 1))]) ) {- more: [Just 12: Enter (P 11 1),Just 181: Cons 1 "Just" (P 11 1)] -} 14 | -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/exe/Main.out: -------------------------------------------------------------------------------- 1 | 0123456Falsifiable, after 6 tests: 2 | fromList [('p',RationalRect ((-1) % 1) ((-2) % 1) (0 % 1) ((-2) % 1)),('x',RationalRect (1 % 1) (2 % 1) (1 % 1) (1 % 1))] 3 | [Workspace {tag = NonNegative 1, layout = -1, stack = Just (Stack {focus = 'y', up = "", down = "e"})},Workspace {tag = NonNegative 1, layout = 2, stack = Just (Stack {focus = 'p', up = "", down = ""})}] 4 | "s" 5 | 2 6 | 2 7 | 1 8 | 0 9 | 0 10 | -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_findIndex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_findIndex -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_all_l: -------------------------------------------------------------------------------- 1 |  -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_all_r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_all_r -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_master_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_master_I -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_master_idempotent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_master_idempotent -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_right_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_swap_right_I -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedCompTree.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_allWindowsMember: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_allWindowsMember -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_findIndex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_findIndex -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_greedyView_local: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_greedyView_local -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_swap_all_l: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_swap_all_r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_swap_all_r -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_swap_master_idempotent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_swap_master_idempotent -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_swap_right_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_swap_right_I -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/savedTrace.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/savedTrace.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/wwwroot/debugTree.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/wwwroot/debugTree.png -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/wwwroot/faulty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/wwwroot/faulty.png -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/wwwroot/hoed-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/wwwroot/hoed-logo.png -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/wwwroot/loading.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/wwwroot/loading.gif -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/wwwroot/right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/wwwroot/right.png -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/wwwroot/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/wwwroot/test.png -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/wwwroot/unassessed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/wwwroot/unassessed.png -------------------------------------------------------------------------------- /examples/XMonad5__using_properties/.Hoed/wwwroot/wrong.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad5__using_properties/.Hoed/wwwroot/wrong.png -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/debugTree.dot: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v2 [label=<
member 'w' (StackSet (Screen (Workspace (NonNegative 3) _...
>shape=none] 3 | v1 [label=<
insertUp 'w' (StackSet (Screen (Workspace (NonNegative 3)...
>shape=none fontcolor=blue] 4 | v0 [label="."shape=none] 5 | v1 -> v2 [label=""] 6 | v0 -> v1 [label=""] 7 | } 8 | -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/exe/Main: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/exe/Main -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/exe/Main.compilerMessages: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/exe/Main.compilerMessages -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/exe/Main.hs: -------------------------------------------------------------------------------- 1 | -- This file is generated by the Haskell debugger Hoed 2 | import Properties hiding (fromList) 3 | import qualified Debug.Hoed.Pure as Hoed 4 | import System.Random 5 | import Data.Maybe 6 | import Test.QuickCheck 7 | import XMonad.StackSet 8 | import Test.QuickCheck 9 | import qualified Data.Map as M 10 | import Data.Map(fromList) 11 | import System.Random 12 | import Data.Maybe 13 | main = Hoed.runOstore "prop_findIndex" $ do g <- newStdGen; print . fromJust . ok . (generate 1 g) . evaluate $ prop_findIndex ((\r x1 x2 -> Hoed.constrain (findTag x1 x2) r) {- generateRes -} (Nothing) ) {- generateArgs -} (StackSet (Screen (Workspace (NonNegative ((3)) ) (error "Request of value that was unevaluated in original program (underscore 1 in computation statement).") (Nothing) ) ((3)) ((0)) ) ((:) (Screen (Workspace (NonNegative ((2)) ) (error "Request of value that was unevaluated in original program (underscore 2 in computation statement).") (Just (Stack (('s')) ((:) (('z')) (([])) ) (([])) ) ) ) ((2)) ((-1)) ) (([])) ) ((:) (Workspace (NonNegative ((1)) ) (error "Request of value that was unevaluated in original program (underscore 3 in computation statement).") (Just (Stack (('s')) (([])) ((:) (('w')) (([])) ) ) ) ) (([])) ) (error "Request of value that was unevaluated in original program (underscore 4 in computation statement).")) {- more: [Just 19: Enter (P 18 1),Just 236: Cons 0 "Nothing" (P 18 1)] -} 14 | -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/exe/Main.out: -------------------------------------------------------------------------------- 1 | False 2 | -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_allWindowsMember: -------------------------------------------------------------------------------- 1 |  -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_findIndex: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_findIndex -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_insertUp_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_insertUp_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_insert_duplicate_weak: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_insert_duplicate_weak -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_all_l: -------------------------------------------------------------------------------- 1 |  -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_all_r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_all_r -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_master_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_master_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_master_idempotent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_master_idempotent -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_right_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_swap_right_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedCompTree.spec_member: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedCompTree.spec_member -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_allWindowsMember: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_greedyView_idem: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_greedyView_idem -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_greedyView_local: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_greedyView_local -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_greedyView_reversible: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_greedyView_reversible -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_insertUp_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_insertUp_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_insert_duplicate_weak: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_insert_duplicate_weak -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_shift_win_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_shift_win_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_swap_all_l: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_swap_all_r: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_swap_all_r -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_swap_master_idempotent: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_swap_master_idempotent -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_swap_right_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_swap_right_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.prop_view_I: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.prop_view_I -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/savedTrace.spec_member: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/savedTrace.spec_member -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/wwwroot/debugTree.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/wwwroot/debugTree.png -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/wwwroot/faulty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/wwwroot/faulty.png -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/wwwroot/hoed-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/wwwroot/hoed-logo.png -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/wwwroot/loading.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/wwwroot/loading.gif -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/wwwroot/right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/wwwroot/right.png -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/wwwroot/test.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/wwwroot/test.png -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/wwwroot/unassessed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/wwwroot/unassessed.png -------------------------------------------------------------------------------- /examples/XMonad6__using_properties/.Hoed/wwwroot/wrong.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/XMonad6__using_properties/.Hoed/wwwroot/wrong.png -------------------------------------------------------------------------------- /examples/XMonad_changing_focus_duplicates_windows/README: -------------------------------------------------------------------------------- 1 | Sources from the test-suite of XMonad 0.11.1 and QuickCheck-1.2.0.1. 2 | -------------------------------------------------------------------------------- /examples/XMonad_changing_focus_duplicates_windows__CC/README: -------------------------------------------------------------------------------- 1 | Sources from the test-suite of XMonad 0.11.1 and QuickCheck-1.2.0.1. 2 | -------------------------------------------------------------------------------- /examples/XMonad_changing_focus_duplicates_windows__test_only/README: -------------------------------------------------------------------------------- 1 | Sources from the test-suite of XMonad 0.11.1 and QuickCheck-1.2.0.1. 2 | -------------------------------------------------------------------------------- /examples/XMonad_changing_focus_duplicates_windows__using_properties/README: -------------------------------------------------------------------------------- 1 | Sources from the test-suite of XMonad 0.11.1 and QuickCheck-1.2.0.1. 2 | -------------------------------------------------------------------------------- /examples/ZLang/1/.Hoed/Transcript: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/1/.Hoed/Transcript -------------------------------------------------------------------------------- /examples/ZLang/1/.Hoed/debugTree.dot: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v2 [label=<
instanceOf _ _ (BottomPattern _) = False
>shape=none] 3 | v1 [label=<
instanceOf _ (RecordPattern (("a", TopPattern _) : ('b' :...
>shape=none fontcolor=blue] 4 | v0 [label=<
covering _ (RecordPattern (("a", BottomPattern _) : ('b' ...
>shape=none] 5 | v0 -> v1 [label=""] 6 | v1 -> v2 [label=""] 7 | } 8 | -------------------------------------------------------------------------------- /examples/ZLang/1/.Hoed/wwwroot/faulty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/1/.Hoed/wwwroot/faulty.png -------------------------------------------------------------------------------- /examples/ZLang/1/.Hoed/wwwroot/hoed-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/1/.Hoed/wwwroot/hoed-logo.png -------------------------------------------------------------------------------- /examples/ZLang/1/.Hoed/wwwroot/loading.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/1/.Hoed/wwwroot/loading.gif -------------------------------------------------------------------------------- /examples/ZLang/1/.Hoed/wwwroot/right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/1/.Hoed/wwwroot/right.png -------------------------------------------------------------------------------- /examples/ZLang/1/.Hoed/wwwroot/unassessed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/1/.Hoed/wwwroot/unassessed.png -------------------------------------------------------------------------------- /examples/ZLang/1/.Hoed/wwwroot/wrong.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/1/.Hoed/wwwroot/wrong.png -------------------------------------------------------------------------------- /examples/ZLang/1/.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .virtualenv 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | -------------------------------------------------------------------------------- /examples/ZLang/1/IR.hs: -------------------------------------------------------------------------------- 1 | module IR where 2 | import Types 3 | 4 | data Expr 5 | = BinOp BOp TExpr TExpr 6 | | Mem TExpr 7 | | Temp Int 8 | | Eseq Stmt TExpr 9 | | Name String 10 | | IntConst Int 11 | | RealConst Double 12 | | Call TExpr [TExpr] 13 | 14 | newtype TExpr = TExpr Expr Type 15 | 16 | data BOp 17 | = Plus | Minus | Mult | Div | 18 | Beq | Bneq | Blt | Bgt | Ble | Bge 19 | 20 | data ROp 21 | = Req | Rneq | Rlt | Rgt | Rle | Rge 22 | 23 | data Stmt 24 | = Label String 25 | | CJump ROp TExpr TExpr String String 26 | | Move TExpr TExpr -------------------------------------------------------------------------------- /examples/ZLang/1/Main.hs: -------------------------------------------------------------------------------- 1 | import Parser as P 2 | import TypeInfer as T 3 | import MatchCheck as MC 4 | import Control.Monad.Trans.Writer.Lazy 5 | import qualified Data.List as List 6 | 7 | -- TEST RELATED BEGIN 8 | import Types 9 | import TypedAst 10 | import qualified Data.Map as Map 11 | import Debug.Hoed.Pure 12 | 13 | failType = Record False [("a",IntType),("b",StringType)] 14 | 15 | m1 = (TRecordMatchExpr [("a",(TIntMatchExpr 42,IntType)),("b",(TStringMatchExpr "abc",StringType))],Record False [("a",IntType),("b",StringType)]) 16 | m2 = (TRecordMatchExpr [("a",(TVarMatch "n",IntType)),("b",(TStringMatchExpr "def",StringType))],Record False [("a",IntType),("b",StringType)]) 17 | m3 = (TRecordMatchExpr [("a",(TVarMatch "n",IntType)),("b",(TVarMatch "s",StringType))],Record False [("a",IntType),("b",StringType)]) 18 | 19 | testCovering ty matches = covering Map.empty (ideal Map.empty ty) matches == [Covered] 20 | -- TEST RELATED END 21 | 22 | concreteTest = testCovering failType [m1, m2, m3] 23 | 24 | main = printO $ concreteTest 25 | 26 | {- 27 | main :: IO () 28 | main = let path = "../test.z" 29 | in do content <- readFile path 30 | case P.parse content of 31 | Left err -> print err 32 | Right ast -> do 33 | (typed, env, subst) <- T.infer ast 34 | let (b, badMatches) = runWriter (MC.matchCheck env typed) 35 | mapM putStrLn (List.map MC.formatMatchWarning badMatches) 36 | case b of 37 | True -> return () --Continue compilation 38 | False -> return () --Abort compilation 39 | -} 40 | -------------------------------------------------------------------------------- /examples/ZLang/1/README.md: -------------------------------------------------------------------------------- 1 | # Z 2 | Implementation of the Z programming language: A functional/imperative language with strong updates, type inference, structural subtyping, universal types, pattern matching on open sum types, first order functions and much more! -------------------------------------------------------------------------------- /examples/ZLang/1/Utils.hs: -------------------------------------------------------------------------------- 1 | module Utils where 2 | 3 | import qualified Data.Map as Map 4 | import Data.Map(Map) 5 | 6 | foldlWithKeyM :: Monad m => (a -> k -> b -> m a) -> a -> Map k b -> m a 7 | foldlWithKeyM f acc = Map.foldlWithKey f' (return acc) 8 | where 9 | f' ma k b = ma >>= \a -> f a k b -------------------------------------------------------------------------------- /examples/ZLang/2/.Hoed/Transcript: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/2/.Hoed/Transcript -------------------------------------------------------------------------------- /examples/ZLang/2/.Hoed/debugTree.dot: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v2 [label=<
instanceOf _ _ (BottomPattern _) = False
>shape=none] 3 | v1 [label=<
instanceOf _ (RecordPattern (("a", TopPattern _) : ('b' :...
>shape=none fontcolor=blue] 4 | v0 [label=<
covering _ (RecordPattern (("a", BottomPattern _) : ('b' ...
>shape=none] 5 | v0 -> v1 [label=""] 6 | v1 -> v2 [label=""] 7 | } 8 | -------------------------------------------------------------------------------- /examples/ZLang/2/.Hoed/wwwroot/faulty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/2/.Hoed/wwwroot/faulty.png -------------------------------------------------------------------------------- /examples/ZLang/2/.Hoed/wwwroot/hoed-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/2/.Hoed/wwwroot/hoed-logo.png -------------------------------------------------------------------------------- /examples/ZLang/2/.Hoed/wwwroot/loading.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/2/.Hoed/wwwroot/loading.gif -------------------------------------------------------------------------------- /examples/ZLang/2/.Hoed/wwwroot/right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/2/.Hoed/wwwroot/right.png -------------------------------------------------------------------------------- /examples/ZLang/2/.Hoed/wwwroot/unassessed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/2/.Hoed/wwwroot/unassessed.png -------------------------------------------------------------------------------- /examples/ZLang/2/.Hoed/wwwroot/wrong.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/2/.Hoed/wwwroot/wrong.png -------------------------------------------------------------------------------- /examples/ZLang/2/.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .virtualenv 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | -------------------------------------------------------------------------------- /examples/ZLang/2/IR.hs: -------------------------------------------------------------------------------- 1 | module IR where 2 | import Types 3 | 4 | data Expr 5 | = BinOp BOp TExpr TExpr 6 | | Mem TExpr 7 | | Temp Int 8 | | Eseq Stmt TExpr 9 | | Name String 10 | | IntConst Int 11 | | RealConst Double 12 | | Call TExpr [TExpr] 13 | 14 | newtype TExpr = TExpr Expr Type 15 | 16 | data BOp 17 | = Plus | Minus | Mult | Div | 18 | Beq | Bneq | Blt | Bgt | Ble | Bge 19 | 20 | data ROp 21 | = Req | Rneq | Rlt | Rgt | Rle | Rge 22 | 23 | data Stmt 24 | = Label String 25 | | CJump ROp TExpr TExpr String String 26 | | Move TExpr TExpr -------------------------------------------------------------------------------- /examples/ZLang/2/Main.hs: -------------------------------------------------------------------------------- 1 | import Parser as P 2 | import TypeInfer as T 3 | import MatchCheck as MC 4 | import Control.Monad.Trans.Writer.Lazy 5 | import qualified Data.List as List 6 | 7 | -- TEST RELATED BEGIN 8 | import Types 9 | import TypedAst 10 | import qualified Data.Map as Map 11 | import Debug.Hoed.Pure 12 | 13 | failType = Record False [("a",IntType),("b",StringType)] 14 | 15 | m1 = (TRecordMatchExpr [("a",(TIntMatchExpr 42,IntType)),("b",(TStringMatchExpr "abc",StringType))],Record False [("a",IntType),("b",StringType)]) 16 | m2 = (TRecordMatchExpr [("a",(TVarMatch "n",IntType)),("b",(TStringMatchExpr "def",StringType))],Record False [("a",IntType),("b",StringType)]) 17 | m3 = (TRecordMatchExpr [("a",(TVarMatch "n",IntType)),("b",(TVarMatch "s",StringType))],Record False [("a",IntType),("b",StringType)]) 18 | 19 | testCovering ty matches = covering Map.empty (ideal Map.empty ty) matches == [Covered] 20 | -- TEST RELATED END 21 | 22 | concreteTest = testCovering failType [m1, m2, m3] 23 | 24 | main = printO $ concreteTest 25 | 26 | {- 27 | main :: IO () 28 | main = let path = "../test.z" 29 | in do content <- readFile path 30 | case P.parse content of 31 | Left err -> print err 32 | Right ast -> do 33 | (typed, env, subst) <- T.infer ast 34 | let (b, badMatches) = runWriter (MC.matchCheck env typed) 35 | mapM putStrLn (List.map MC.formatMatchWarning badMatches) 36 | case b of 37 | True -> return () --Continue compilation 38 | False -> return () --Abort compilation 39 | -} 40 | -------------------------------------------------------------------------------- /examples/ZLang/2/README.md: -------------------------------------------------------------------------------- 1 | # Z 2 | Implementation of the Z programming language: A functional/imperative language with strong updates, type inference, structural subtyping, universal types, pattern matching on open sum types, first order functions and much more! -------------------------------------------------------------------------------- /examples/ZLang/2/Utils.hs: -------------------------------------------------------------------------------- 1 | module Utils where 2 | 3 | import qualified Data.Map as Map 4 | import Data.Map(Map) 5 | 6 | foldlWithKeyM :: Monad m => (a -> k -> b -> m a) -> a -> Map k b -> m a 7 | foldlWithKeyM f acc = Map.foldlWithKey f' (return acc) 8 | where 9 | f' ma k b = ma >>= \a -> f a k b -------------------------------------------------------------------------------- /examples/ZLang/3/.Hoed/Transcript: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/3/.Hoed/Transcript -------------------------------------------------------------------------------- /examples/ZLang/3/.Hoed/debugTree.dot: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v2 [label=<
instanceOf _ _ (BottomPattern _) = False
>shape=none] 3 | v1 [label=<
instanceOf _ (RecordPattern (("a", TopPattern _) : ('b' :...
>shape=none fontcolor=blue] 4 | v0 [label=<
covering _ (RecordPattern (("a", BottomPattern _) : ('b' ...
>shape=none] 5 | v0 -> v1 [label=""] 6 | v1 -> v2 [label=""] 7 | } 8 | -------------------------------------------------------------------------------- /examples/ZLang/3/.Hoed/wwwroot/faulty.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/3/.Hoed/wwwroot/faulty.png -------------------------------------------------------------------------------- /examples/ZLang/3/.Hoed/wwwroot/hoed-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/3/.Hoed/wwwroot/hoed-logo.png -------------------------------------------------------------------------------- /examples/ZLang/3/.Hoed/wwwroot/loading.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/3/.Hoed/wwwroot/loading.gif -------------------------------------------------------------------------------- /examples/ZLang/3/.Hoed/wwwroot/right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/3/.Hoed/wwwroot/right.png -------------------------------------------------------------------------------- /examples/ZLang/3/.Hoed/wwwroot/unassessed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/3/.Hoed/wwwroot/unassessed.png -------------------------------------------------------------------------------- /examples/ZLang/3/.Hoed/wwwroot/wrong.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/ZLang/3/.Hoed/wwwroot/wrong.png -------------------------------------------------------------------------------- /examples/ZLang/3/.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .virtualenv 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | -------------------------------------------------------------------------------- /examples/ZLang/3/IR.hs: -------------------------------------------------------------------------------- 1 | module IR where 2 | import Types 3 | 4 | data Expr 5 | = BinOp BOp TExpr TExpr 6 | | Mem TExpr 7 | | Temp Int 8 | | Eseq Stmt TExpr 9 | | Name String 10 | | IntConst Int 11 | | RealConst Double 12 | | Call TExpr [TExpr] 13 | 14 | newtype TExpr = TExpr Expr Type 15 | 16 | data BOp 17 | = Plus | Minus | Mult | Div | 18 | Beq | Bneq | Blt | Bgt | Ble | Bge 19 | 20 | data ROp 21 | = Req | Rneq | Rlt | Rgt | Rle | Rge 22 | 23 | data Stmt 24 | = Label String 25 | | CJump ROp TExpr TExpr String String 26 | | Move TExpr TExpr -------------------------------------------------------------------------------- /examples/ZLang/3/Main.hs: -------------------------------------------------------------------------------- 1 | import Parser as P 2 | import TypeInfer as T 3 | import MatchCheck as MC 4 | import Control.Monad.Trans.Writer.Lazy 5 | import qualified Data.List as List 6 | 7 | -- TEST RELATED BEGIN 8 | import Types 9 | import TypedAst 10 | import qualified Data.Map as Map 11 | import Debug.Hoed.Pure 12 | 13 | failType = Record False [("a",IntType),("b",StringType)] 14 | 15 | m1 = (TRecordMatchExpr [("a",(TIntMatchExpr 42,IntType)),("b",(TStringMatchExpr "abc",StringType))],Record False [("a",IntType),("b",StringType)]) 16 | m2 = (TRecordMatchExpr [("a",(TVarMatch "n",IntType)),("b",(TStringMatchExpr "def",StringType))],Record False [("a",IntType),("b",StringType)]) 17 | m3 = (TRecordMatchExpr [("a",(TVarMatch "n",IntType)),("b",(TVarMatch "s",StringType))],Record False [("a",IntType),("b",StringType)]) 18 | 19 | testCovering ty matches = covering Map.empty (ideal Map.empty ty) matches == [Covered] 20 | -- TEST RELATED END 21 | 22 | concreteTest = testCovering failType [m1, m2, m3] 23 | 24 | main = printO $ concreteTest 25 | 26 | {- 27 | main :: IO () 28 | main = let path = "../test.z" 29 | in do content <- readFile path 30 | case P.parse content of 31 | Left err -> print err 32 | Right ast -> do 33 | (typed, env, subst) <- T.infer ast 34 | let (b, badMatches) = runWriter (MC.matchCheck env typed) 35 | mapM putStrLn (List.map MC.formatMatchWarning badMatches) 36 | case b of 37 | True -> return () --Continue compilation 38 | False -> return () --Abort compilation 39 | -} 40 | -------------------------------------------------------------------------------- /examples/ZLang/3/README.md: -------------------------------------------------------------------------------- 1 | # Z 2 | Implementation of the Z programming language: A functional/imperative language with strong updates, type inference, structural subtyping, universal types, pattern matching on open sum types, first order functions and much more! -------------------------------------------------------------------------------- /examples/ZLang/3/Utils.hs: -------------------------------------------------------------------------------- 1 | module Utils where 2 | 3 | import qualified Data.Map as Map 4 | import Data.Map(Map) 5 | 6 | foldlWithKeyM :: Monad m => (a -> k -> b -> m a) -> a -> Map k b -> m a 7 | foldlWithKeyM f acc = Map.foldlWithKey f' (return acc) 8 | where 9 | f' ma k b = ma >>= \a -> f a k b -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Behaviour.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module Behaviour(Trace(..),(+++),approx,prop_traceLessThan100Deep) where 3 | import Debug.Hoed.Pure 4 | 5 | data Trace a 6 | = Step (Trace a) 7 | | a :> Trace a 8 | | End 9 | | Crash 10 | deriving (Eq, Show,Generic) 11 | 12 | instance Observable a => Observable (Trace a) 13 | 14 | (+++) :: Trace a -> Trace a -> Trace a 15 | Step s +++ t = Step (s +++ t) 16 | (x :> s) +++ t = x :> (s +++ t) 17 | End +++ t = t 18 | Crash +++ t = Crash 19 | 20 | approx :: Eq a => Int -> Trace a -> Trace a -> Bool 21 | approx 0 _ _ = True 22 | approx n (a :> s) (b :> t) = a == b && approx (n-1) s t 23 | approx n (Step s) (Step t) = approx (n-1) s t 24 | approx n End End = True 25 | approx n Crash Crash = True 26 | approx n _ _ = False 27 | 28 | prop_traceLessThan100Deep :: (Trace a) -> Bool 29 | prop_traceLessThan100Deep = lessThanXDeep 100 30 | where lessThanXDeep 0 _ = False 31 | lessThanXDeep x (Step trc) = lessThanXDeep (x-1) trc 32 | lessThanXDeep x (_ :> trc) = lessThanXDeep (x-1) trc 33 | lessThanXDeep _ End = True 34 | lessThanXDeep _ Crash = True 35 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/CVS/Entries: -------------------------------------------------------------------------------- 1 | D/vanilla//// 2 | D/parassign//// 3 | /Behaviour.hs/1.1/Thu Jul 18 15:07:59 2002// 4 | /Interpreter.hs/1.1/Thu Jul 18 15:21:34 2002// 5 | /Main.hs/1.1/Thu Jul 18 15:07:59 2002// 6 | /Parser.hs/1.1/Thu Jul 18 15:07:59 2002// 7 | /StackMap.hs/1.1/Thu Jul 18 15:07:59 2002// 8 | /Syntax.hs/1.1/Thu Jul 18 15:07:59 2002// 9 | /Value.hs/1.1/Thu Jul 18 15:07:59 2002// 10 | /gcd.in/1.1/Thu Jul 18 15:08:11 2002// 11 | /power.in/1.1/Wed Jul 24 09:03:21 2002// 12 | D/properties//// 13 | /Compiler.hs/1.2/Fri Jan 17 13:54:25 2003// 14 | /Machine.hs/1.2/Fri Jan 17 13:54:25 2003// 15 | /Properties.hs/1.2/Fri Jan 17 13:54:25 2003// 16 | /compilerprac.tex/1.14/Mon Feb 10 14:31:14 2003// 17 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/CVS/Repository: -------------------------------------------------------------------------------- 1 | projects/afp-oxford/Exercises/Compiler 2 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/CVS/Root: -------------------------------------------------------------------------------- 1 | :ext:colin@hotlips.cs.chalmers.se:/.../chalmers.se/fs/cab/cs/work/proj/multi/home/cvs 2 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Compiler.hs: -------------------------------------------------------------------------------- 1 | module Compiler(compile) where 2 | 3 | import Machine 4 | import Syntax 5 | import StackMap 6 | import Value 7 | 8 | compile :: Command -> [Instruction] 9 | compile c = 10 | replicate (depth sm) (Push Wrong) ++ 11 | compObey sm c ++ 12 | [Halt] 13 | where 14 | sm = stackMap c 15 | 16 | compObey :: StackMap -> Command -> [Instruction] 17 | compObey sm Skip = 18 | [] 19 | compObey sm (v := e) = 20 | compEval sm e ++ 21 | [Store (location sm v + 1)] 22 | compObey sm (c1 :-> c2) = 23 | compObey sm c1 ++ 24 | compObey sm c2 25 | compObey sm (If e c1 c2) = 26 | compEval sm e ++ 27 | [JumpUnless (length isc1 + 1)] ++ 28 | isc1 ++ 29 | [Jump (length isc2)] ++ 30 | isc2 31 | where 32 | isc1 = compObey sm c1 33 | isc2 = compObey sm c2 34 | compObey sm (While e c) = 35 | ise ++ 36 | [JumpUnless (length isc + 1)] ++ 37 | isc ++ 38 | [Jump (negate (length isc + 1 + length ise + 1))] 39 | where 40 | ise = compEval sm e 41 | isc = compObey sm c 42 | compObey sm (Print e) = 43 | compEval sm e ++ 44 | [Display] 45 | 46 | compEval :: StackMap -> Expr -> [Instruction] 47 | compEval sm (Val v) = 48 | [Push v] 49 | compEval sm (Var v) = 50 | [Fetch (location sm v)] 51 | compEval sm (Uno op1 e) = 52 | [Instr1 op1] ++ 53 | compEval sm e 54 | compEval sm (Duo op2 e1 e2) = 55 | [Instr2 op2] ++ 56 | compEval sm e1 ++ 57 | compEval (push sm) e2 58 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Interpreter.hs: -------------------------------------------------------------------------------- 1 | module Interpreter(obey) where 2 | 3 | import Syntax 4 | import Behaviour 5 | import Value 6 | import Debug.Hoed.Pure 7 | 8 | type Env = [(Name,Value)] 9 | 10 | obey :: Command -> Trace Value 11 | obey = observe "obey" obey_ 12 | obey_ p = if prop_traceLessThan100Deep trc then trc else error "Error: Stuck" 13 | where trc = fst (run p []) 14 | 15 | look :: Name -> Env -> Value 16 | look = observe "look" look' 17 | look' x s = maybe Wrong id (lookup x s) 18 | 19 | update :: Name -> Value -> Env -> Env 20 | update = observe "update" update' 21 | update' x a s = (x,a) : filter (\(y,_) -> y/=x) s 22 | 23 | run :: Command -> Env -> (Trace Value, Env) 24 | run = observe "run" run' 25 | run' Skip s = (End, s) 26 | run' (x := e) s = (End, update x (eval e s) s) 27 | run' (p :-> q) s = let (outp, sp) = run p s 28 | (outq, sq) = run q sp 29 | in (outp +++ outq, sq) 30 | run' (If e p q) s = case eval e s of 31 | Log True -> run q s 32 | Log False -> run p s 33 | _ -> (Crash, s) 34 | run' (While e p) s = case eval e s of 35 | Log True -> let (outp,sp) = run p s 36 | (outw,sw) = run (While e p) sp 37 | in (outp +++ Step outw, sw) 38 | Log False -> (End, s) 39 | _ -> (Crash, s) 40 | run' (Print e) s = (eval e s :> End, s) 41 | 42 | eval :: Expr -> Env -> Value 43 | eval = observe "eval" eval' 44 | eval' (Var x) s = look x s 45 | eval' (Val v) s = v 46 | eval' (Uno op a) s = uno op (eval a s) 47 | eval' (Duo op a b) s = duo op (eval a s) (eval b s) 48 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Machine.hs: -------------------------------------------------------------------------------- 1 | module Machine(Instruction(..), exec) where 2 | 3 | import Data.Array 4 | import Behaviour 5 | import Value 6 | 7 | data Instruction 8 | = Push Value 9 | | Pop 10 | | Fetch Int 11 | | Store Int 12 | | Instr1 Op1 13 | | Instr2 Op2 14 | | Display 15 | | Jump Int 16 | | JumpUnless Int 17 | | Halt 18 | deriving (Eq, Show) 19 | 20 | exec :: [Instruction] -> Trace Value 21 | exec instrs = run 1 [] 22 | where 23 | size = length instrs 24 | memory = array (1,size) ([1..] `zip` instrs) 25 | run pc stack = 26 | if pc < 1 || size < pc then Crash 27 | else 28 | case (memory ! pc, stack) of 29 | (Push x , stack) -> run pc' (x : stack) 30 | (Pop , _ : stack) -> run pc' stack 31 | (Fetch n , stack) 32 | | length stack > n -> run pc' (stack !! n : stack) 33 | (Store n , x : stack) 34 | | length stack >= n -> run pc' (take (n-1) stack ++ 35 | x : drop n stack) 36 | (Instr1 op1 , i : stack) -> run pc' (uno op1 i : stack) 37 | (Instr2 op2 , i : j : stack) -> run pc' (duo op2 j i : stack) 38 | (Display , i : stack) -> i :> run pc' stack 39 | (Jump n , stack) -> step n (run (pc' + n) stack) 40 | (JumpUnless n , Log b : stack) 41 | | b -> run pc' stack 42 | | otherwise -> step n (run (pc' + n) stack) 43 | (Halt , stack) -> End 44 | _ -> Crash 45 | where 46 | pc' = pc + 1 47 | 48 | step :: Int -> Trace Value -> Trace Value 49 | step n t | n < 0 = Step t 50 | | otherwise = t 51 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Main.aux: -------------------------------------------------------------------------------- 1 | X_RANGE 1.74 2 | Y_RANGE 270539728.00 3 | ORDER (561)run/obey_/obey/main/M... 1 4 | ORDER (555)Main.CAF 2 5 | ORDER (284)SYSTEM 3 6 | ORDER (559)obey/main/Main.CAF 4 7 | ORDER (556)main/Main.CAF 5 8 | SHADE (561)run/obey_/obey/main/M... 0.00 9 | SHADE (555)Main.CAF 0.20 10 | SHADE (284)SYSTEM 0.60 11 | SHADE (559)obey/main/Main.CAF 0.30 12 | SHADE (556)main/Main.CAF 0.90 13 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Debug.Hoed.Pure 4 | import Syntax 5 | import Parser 6 | import Interpreter 7 | import Machine 8 | import Compiler 9 | 10 | main = runO $ do 11 | let prog = parse gcdSource 12 | putStrLn "interpreted:" 13 | print (obey prog) 14 | putStrLn "compiled:" 15 | print (exec (compile prog)) 16 | 17 | gcdSource :: String 18 | gcdSource = "x := 148; y := 58;\nwhile ~(x=y) do\n if x < y then y := y - x\n else x := x - y\n fi\nod;\nprint x\n" 19 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Main.prof: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MaartenFaddegon/Hoed/8769d69e309928aab439b22bc3f3dbf5452acc77/examples/afp02Exercises/Compiler/Main.prof -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/StackMap.hs: -------------------------------------------------------------------------------- 1 | module StackMap where 2 | 3 | import Syntax 4 | import Data.List( union ) 5 | 6 | type StackMap = (Int,[Name]) 7 | 8 | stackMap :: Command -> StackMap 9 | stackMap c = (0, comVars c) 10 | 11 | push :: StackMap -> StackMap 12 | push (n, vars) = (n+1, vars) 13 | 14 | pop :: StackMap -> StackMap 15 | pop (n, vars) = (n-1, vars) 16 | 17 | location :: StackMap -> Name -> Int 18 | location (n, vars) v = n + length (takeWhile (/=v) vars) 19 | 20 | depth :: StackMap -> Int 21 | depth (n, vars) = n + length vars 22 | 23 | expVars :: Expr -> [Name] 24 | expVars (Var v) = [v] 25 | expVars (Val _) = [] 26 | expVars (Uno _ a) = expVars a 27 | expVars (Duo _ a b) = expVars a `union` expVars b 28 | 29 | comVars :: Command -> [Name] 30 | comVars Skip = [] 31 | comVars (x := e) = [x] `union` expVars e 32 | comVars (c1 :-> c2) = comVars c1 `union` comVars c2 33 | comVars (If e c1 c2) = expVars e `union` comVars c1 `union` comVars c2 34 | comVars (While e c) = expVars e `union` comVars c 35 | comVars (Print e) = expVars e 36 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Syntax.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module Syntax(Name, Expr(..), Command(..)) where 3 | 4 | import Value 5 | import Debug.Hoed.Pure 6 | 7 | type Name = String 8 | 9 | data Expr 10 | = Var Name 11 | | Val Value 12 | | Uno Op1 Expr 13 | | Duo Op2 Expr Expr 14 | deriving (Eq, Show, Generic) 15 | 16 | instance Observable Expr 17 | 18 | data Command 19 | = Skip 20 | | Name := Expr 21 | | Command :-> Command 22 | | If Expr Command Command 23 | | While Expr Command 24 | | Print Expr 25 | deriving (Eq, Show, Generic) 26 | 27 | instance Observable Command 28 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/Value.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module Value(Value(..), Op1(..), Op2(..), uno, duo) where 3 | import Debug.Hoed.Pure 4 | 5 | data Value 6 | = Num Int 7 | | Log Bool 8 | | Wrong 9 | deriving (Eq, Show,Generic) 10 | 11 | instance Observable Value 12 | 13 | data Op1 14 | = Not 15 | | Minus 16 | deriving (Eq, Show, Generic) 17 | 18 | instance Observable Op1 19 | 20 | data Op2 21 | = And 22 | | Or 23 | | Mul 24 | | Add 25 | | Sub 26 | | Div 27 | | Mod 28 | | Less 29 | | LessEq 30 | | Eq 31 | deriving (Eq, Show, Generic) 32 | 33 | instance Observable Op2 34 | 35 | uno :: Op1 -> Value -> Value 36 | uno Not (Log b) = Log (not b) 37 | uno Minus (Num n) = Num (negate n) 38 | uno _ _ = Wrong 39 | 40 | duo :: Op2 -> Value -> Value -> Value 41 | duo And (Log a) (Log b) = Log (a && b) 42 | duo Or (Log a) (Log b) = Log (a || b) 43 | duo Eq (Log a) (Log b) = Log (a == b) 44 | duo Mul (Num m) (Num n) = Num (m * n) 45 | duo Add (Num m) (Num n) = Num (m + n) 46 | duo Sub (Num m) (Num n) = Num (m - n) 47 | duo Div (Num m) (Num n) | n /= 0 = Num (m `div` n) 48 | duo Mod (Num m) (Num n) | n /= 0 = Num (m `mod` n) 49 | duo Less (Num m) (Num n) = Log (m < n) 50 | duo LessEq (Num m) (Num n) = Log (m <= n) 51 | duo Eq (Num m) (Num n) = Log (m == n) 52 | duo _ _ _ = Wrong 53 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/build: -------------------------------------------------------------------------------- 1 | rm *.o *.hi Main 2 | ghc -prof -fprof-auto --make Main 3 | # ghc --make Main 4 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/gcd.in: -------------------------------------------------------------------------------- 1 | x := 148; y := 58; 2 | while ~(x=y) do 3 | if x < y then y := y - x 4 | else x := x - y 5 | fi 6 | od; 7 | print x 8 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/Behaviour.hs: -------------------------------------------------------------------------------- 1 | module Behaviour(Trace(..),(+++),approx) where 2 | 3 | data Trace a 4 | = Step (Trace a) 5 | | a :> Trace a 6 | | End 7 | | Crash 8 | deriving (Eq, Show) 9 | 10 | (+++) :: Trace a -> Trace a -> Trace a 11 | Step s +++ t = Step (s +++ t) 12 | (x :> s) +++ t = x :> (s +++ t) 13 | End +++ t = t 14 | Crash +++ t = Crash 15 | 16 | approx :: Eq a => Int -> Trace a -> Trace a -> Bool 17 | approx 0 _ _ = True 18 | approx n (a :> s) (b :> t) = a == b && approx (n-1) s t 19 | approx n (Step s) (Step t) = approx (n-1) s t 20 | approx n End End = True 21 | approx n Crash Crash = True 22 | approx n _ _ = False 23 | 24 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/CVS/Entries: -------------------------------------------------------------------------------- 1 | /Behaviour.hs/1.1/Thu Jul 18 08:38:04 2002// 2 | /Compiler.hs/1.1/Thu Jul 18 08:45:59 2002// 3 | /Interpreter.hs/1.1/Thu Jul 18 08:47:47 2002// 4 | /Machine.hs/1.1/Thu Jul 18 09:49:27 2002// 5 | /Main.hs/1.1/Mon Jun 17 14:02:14 2002// 6 | /README/1.1/Thu Jul 18 09:57:13 2002// 7 | /StackMap.hs/1.1/Thu Jul 18 09:48:40 2002// 8 | /Syntax.hs/1.1/Thu Jul 18 08:36:17 2002// 9 | /Value.hs/1.1/Thu Jul 18 08:34:12 2002// 10 | /gcd.in/1.1/Mon Jun 17 13:00:50 2002// 11 | /power.in/1.1/Thu Jul 18 10:13:17 2002// 12 | /Parser.hs/1.2/Fri Jul 19 10:17:46 2002// 13 | D 14 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/CVS/Repository: -------------------------------------------------------------------------------- 1 | projects/afp-oxford/Exercises/Compiler/parassign 2 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/CVS/Root: -------------------------------------------------------------------------------- 1 | :ext:colin@hotlips.cs.chalmers.se:/.../chalmers.se/fs/cab/cs/work/proj/multi/home/cvs 2 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/Compiler.hs: -------------------------------------------------------------------------------- 1 | module Compiler(compile) where 2 | 3 | import Machine 4 | import Syntax 5 | import StackMap 6 | import Value 7 | 8 | compile :: Command -> [Instruction] 9 | compile c = 10 | replicate (depth sm) (Push Wrong) ++ 11 | compObey sm c ++ 12 | [Halt] 13 | where 14 | sm = stackMap c 15 | 16 | compObey :: StackMap -> Command -> [Instruction] 17 | compObey sm Skip = 18 | [] 19 | compObey sm (xs := es) = 20 | let sms = iterate push sm in 21 | concat (zipWith compEval sms (reverse es)) ++ 22 | concat (zipWith compStore (iterate pop (sms !! length es)) xs) 23 | compObey sm (c1 :-> c2) = 24 | compObey sm c1 ++ 25 | compObey sm c2 26 | compObey sm (If e c1 c2) = 27 | compEval sm e ++ 28 | [JumpUnless (length isc1 + 1)] ++ 29 | isc1 ++ 30 | [Jump (length isc2)] ++ 31 | isc2 32 | where 33 | isc1 = compObey sm c1 34 | isc2 = compObey sm c2 35 | compObey sm (While e c) = 36 | ise ++ 37 | [JumpUnless (length isc + 1)] ++ 38 | isc ++ 39 | [Jump (negate (length isc + 1 + length ise + 1))] 40 | where 41 | ise = compEval sm e 42 | isc = compObey sm c 43 | compObey sm (Print e) = 44 | compEval sm e ++ 45 | [Display] 46 | 47 | compStore :: StackMap -> Name -> [Instruction] 48 | compStore sm x = [Store (location sm x)] 49 | 50 | compEval :: StackMap -> Expr -> [Instruction] 51 | compEval sm (Val v) = 52 | [Push v] 53 | compEval sm (Var v) = 54 | [Fetch (location sm v)] 55 | compEval sm (Uno op1 e) = 56 | compEval sm e ++ 57 | [Instr1 op1] 58 | compEval sm (Duo op2 e1 e2) = 59 | compEval sm e1 ++ 60 | compEval (push sm) e2 ++ 61 | [Instr2 op2] 62 | 63 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/Interpreter.hs: -------------------------------------------------------------------------------- 1 | module Interpreter(obey) where 2 | 3 | import Syntax 4 | import Behaviour 5 | import Value 6 | 7 | type Env = [(Name,Value)] 8 | 9 | obey :: Command -> Trace Value 10 | obey p = fst (run p []) 11 | 12 | look :: Name -> Env -> Value 13 | look x s = maybe Wrong id (lookup x s) 14 | 15 | update :: [Name] -> [Value] -> Env -> Env 16 | update xs vs s = zip xs vs ++ filter (\(y,_)->y `notElem` xs) s 17 | 18 | run :: Command -> Env -> (Trace Value, Env) 19 | run Skip s = (End, s) 20 | run (xs := es) s = (End, update xs (map (`eval` s) es) s) 21 | run (p :-> q) s = let (outp, sp) = run p s 22 | (outq, sq) = run q sp 23 | in (outp +++ outq, sq) 24 | run (If e p q) s = case eval e s of 25 | Log True -> run p s 26 | Log False -> run q s 27 | _ -> (Crash, s) 28 | run (While e p) s = case eval e s of 29 | Log True -> let (outp,sp) = run p s 30 | (outw,sw) = run (While e p) sp 31 | in (outp +++ Step outw, sw) 32 | Log False -> (End, s) 33 | _ -> (Crash, s) 34 | run (Print e) s = (eval e s :> End, s) 35 | 36 | eval :: Expr -> Env -> Value 37 | eval (Var x) s = look x s 38 | eval (Val v) s = v 39 | eval (Uno op a) s = uno op (eval a s) 40 | eval (Duo op a b) s = duo op (eval a s) (eval b s) 41 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/Machine.hs: -------------------------------------------------------------------------------- 1 | module Machine(Instruction(..), exec) where 2 | 3 | import Array 4 | import Behaviour 5 | import Value 6 | 7 | data Instruction 8 | = Push Value 9 | | Pop 10 | | Fetch Int 11 | | Store Int 12 | | Instr1 Op1 13 | | Instr2 Op2 14 | | Display 15 | | Jump Int 16 | | JumpUnless Int 17 | | Halt 18 | deriving (Eq, Show) 19 | 20 | exec :: [Instruction] -> Trace Value 21 | exec instrs = run 1 [] 22 | where 23 | size = length instrs 24 | memory = array (1,size) ([1..] `zip` instrs) 25 | run pc stack = 26 | if pc < 1 || size < pc then Crash 27 | else 28 | case (memory ! pc, stack) of 29 | (Push x , stack) -> run pc' (x : stack) 30 | (Pop , _ : stack) -> run pc' stack 31 | (Fetch n , stack) 32 | | length stack >= n -> run pc' (stack !! n : stack) 33 | (Store n , x : stack) 34 | | length stack >= n -> run pc' (take (n-1) stack ++ 35 | x : drop n stack) 36 | (Instr1 op1 , i : stack) -> run pc' (uno op1 i : stack) 37 | (Instr2 op2 , i : j : stack) -> run pc' (duo op2 j i : stack) 38 | (Display , i : stack) -> i :> run pc' stack 39 | (Jump n , stack) -> step n (run (pc' + n) stack) 40 | (JumpUnless n , Log b : stack) 41 | | b -> run pc' stack 42 | | otherwise -> step n (run (pc' + n) stack) 43 | (Halt , stack) -> End 44 | _ -> Crash 45 | where 46 | pc' = pc + 1 47 | 48 | step :: Int -> Trace Value -> Trace Value 49 | step n t | n < 0 = Step t 50 | | otherwise = t 51 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Syntax 4 | import Parser 5 | import Interpreter 6 | import Machine 7 | import Compiler 8 | 9 | main = do 10 | source <- getContents 11 | let prog = parse source 12 | putStrLn "interpreted:" 13 | print (obey prog) 14 | putStrLn "compiled:" 15 | print (exec (compile prog)) 16 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/README: -------------------------------------------------------------------------------- 1 | NB the sources in this directory form a *solution* to the 2 | parallel assignment exercise; students should only be given a 3 | copy of the vanilla compiler and its congruence property 4 | as their starting point. 5 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/StackMap.hs: -------------------------------------------------------------------------------- 1 | module StackMap where 2 | 3 | import Syntax 4 | import List( union, nub ) 5 | 6 | type StackMap = (Int,[Name]) 7 | 8 | stackMap :: Command -> StackMap 9 | stackMap c = (0, comVars c) 10 | 11 | push :: StackMap -> StackMap 12 | push (n, vars) = (n+1, vars) 13 | 14 | pop :: StackMap -> StackMap 15 | pop (n, vars) = (n-1, vars) 16 | 17 | location :: StackMap -> Name -> Int 18 | location (n, vars) v = n + length (takeWhile (/=v) vars) 19 | 20 | depth :: StackMap -> Int 21 | depth (n, vars) = n + length vars 22 | 23 | expVars :: Expr -> [Name] 24 | expVars (Var v) = [v] 25 | expVars (Val _) = [] 26 | expVars (Uno _ a) = expVars a 27 | expVars (Duo _ a b) = expVars a `union` expVars b 28 | 29 | comVars :: Command -> [Name] 30 | comVars Skip = [] 31 | comVars (xs := es) = foldr union (nub xs) (map expVars es) 32 | comVars (c1 :-> c2) = comVars c1 `union` comVars c2 33 | comVars (If e c1 c2) = expVars e `union` comVars c1 `union` comVars c2 34 | comVars (While e c) = expVars e `union` comVars c 35 | comVars (Print e) = expVars e 36 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/Syntax.hs: -------------------------------------------------------------------------------- 1 | module Syntax(Name, Expr(..), Command(..)) where 2 | 3 | import Value 4 | 5 | type Name = String 6 | 7 | data Expr 8 | = Var Name 9 | | Val Value 10 | | Uno Op1 Expr 11 | | Duo Op2 Expr Expr 12 | deriving (Eq, Show) 13 | 14 | data Command 15 | = Skip 16 | | [Name] := [Expr] 17 | | Command :-> Command 18 | | If Expr Command Command 19 | | While Expr Command 20 | | Print Expr 21 | deriving (Eq, Show) 22 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/Value.hs: -------------------------------------------------------------------------------- 1 | module Value(Value(..), Op1(..), Op2(..), uno, duo) where 2 | 3 | data Value 4 | = Num Int 5 | | Log Bool 6 | | Wrong 7 | deriving (Eq, Show) 8 | 9 | data Op1 10 | = Not 11 | | Minus 12 | deriving (Eq, Show) 13 | 14 | data Op2 15 | = And 16 | | Or 17 | | Mul 18 | | Add 19 | | Sub 20 | | Div 21 | | Mod 22 | | Less 23 | | LessEq 24 | | Eq 25 | deriving (Eq, Show) 26 | 27 | uno :: Op1 -> Value -> Value 28 | uno Not (Log b) = Log (not b) 29 | uno Minus (Num n) = Num (negate n) 30 | uno _ _ = Wrong 31 | 32 | duo :: Op2 -> Value -> Value -> Value 33 | duo And (Log a) (Log b) = Log (a && b) 34 | duo Or (Log a) (Log b) = Log (a || b) 35 | duo Eq (Log a) (Log b) = Log (a == b) 36 | duo Mul (Num m) (Num n) = Num (m * n) 37 | duo Add (Num m) (Num n) = Num (m + n) 38 | duo Sub (Num m) (Num n) = Num (m - n) 39 | duo Div (Num m) (Num n) | n /= 0 = Num (m `div` n) 40 | duo Mod (Num m) (Num n) | n /= 0 = Num (m `mod` n) 41 | duo Less (Num m) (Num n) = Log (m < n) 42 | duo LessEq (Num m) (Num n) = Log (m <= n) 43 | duo Eq (Num m) (Num n) = Log (m == n) 44 | duo _ _ _ = Wrong 45 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/gcd.in: -------------------------------------------------------------------------------- 1 | x := 148; y := 58; 2 | while ~(x=y) do 3 | if x < y then y := y - x 4 | else x := x - y 5 | fi 6 | od; 7 | print x 8 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/parassign/power.in: -------------------------------------------------------------------------------- 1 | a, n, x := 3, 6, 1; 2 | while 0 < n do 3 | if (n\2) = 1 then n, x := n-1, x*a else skip fi; 4 | a, n := a*a, n/2 5 | od; 6 | print x 7 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/power.in: -------------------------------------------------------------------------------- 1 | a, n, x := 3, 6, 1; 2 | while 0 < n do 3 | if (n\2) = 1 then n, x := n-1, x*a else skip fi; 4 | a, n := a*a, n/2 5 | od; 6 | print x 7 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/properties/CVS/Entries: -------------------------------------------------------------------------------- 1 | /PropertiesSolution.hs/1.1/Wed Jul 24 08:56:16 2002// 2 | /README/1.1/Wed Jul 24 08:56:16 2002// 3 | D 4 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/properties/CVS/Repository: -------------------------------------------------------------------------------- 1 | projects/afp-oxford/Exercises/Compiler/properties 2 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/properties/CVS/Root: -------------------------------------------------------------------------------- 1 | :ext:colin@hotlips.cs.chalmers.se:/.../chalmers.se/fs/cab/cs/work/proj/multi/home/cvs 2 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/properties/README: -------------------------------------------------------------------------------- 1 | This property file can be used with any of the versions of the compiler. 2 | 3 | Give the right include path to your compiler, for example: 4 | 5 | $ hugs -P../broken: -P../../../QuickCheck2: Properties 6 | 7 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/run: -------------------------------------------------------------------------------- 1 | ulimit -v 1000000 # limit memory usage to 10 GB 2 | ./Main +RTS -p -h -xt & 3 | # ./Main & 4 | sleep 1s 5 | kill -2 $! # send a "ctrl-C" signal to stop the hanging compiler... 6 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/Behaviour.hs: -------------------------------------------------------------------------------- 1 | module Behaviour(Trace(..),(+++),approx) where 2 | 3 | data Trace a 4 | = Step (Trace a) 5 | | a :> Trace a 6 | | End 7 | | Crash 8 | deriving (Eq, Show) 9 | 10 | (+++) :: Trace a -> Trace a -> Trace a 11 | Step s +++ t = Step (s +++ t) 12 | (x :> s) +++ t = x :> (s +++ t) 13 | End +++ t = t 14 | Crash +++ t = Crash 15 | 16 | approx :: Eq a => Int -> Trace a -> Trace a -> Bool 17 | approx 0 _ _ = True 18 | approx n (a :> s) (b :> t) = a == b && approx (n-1) s t 19 | approx n (Step s) (Step t) = approx (n-1) s t 20 | approx n End End = True 21 | approx n Crash Crash = True 22 | approx n _ _ = False 23 | 24 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/CVS/Entries: -------------------------------------------------------------------------------- 1 | /Behaviour.hs/1.1/Thu Jul 18 09:07:44 2002// 2 | /Compiler.hs/1.1/Thu Jul 18 09:07:44 2002// 3 | /Interpreter.hs/1.1/Thu Jul 18 09:07:44 2002// 4 | /Machine.hs/1.1/Thu Jul 18 09:07:44 2002// 5 | /Main.hs/1.1/Thu Jul 18 09:07:44 2002// 6 | /StackMap.hs/1.1/Thu Jul 18 09:07:44 2002// 7 | /Syntax.hs/1.1/Thu Jul 18 09:07:44 2002// 8 | /Value.hs/1.1/Thu Jul 18 09:07:44 2002// 9 | /gcd.in/1.1/Thu Jul 18 09:07:44 2002// 10 | /Parser.hs/1.2/Fri Jul 19 10:14:21 2002// 11 | D 12 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/CVS/Repository: -------------------------------------------------------------------------------- 1 | projects/afp-oxford/Exercises/Compiler/vanilla 2 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/CVS/Root: -------------------------------------------------------------------------------- 1 | :ext:colin@hotlips.cs.chalmers.se:/.../chalmers.se/fs/cab/cs/work/proj/multi/home/cvs 2 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/Compiler.hs: -------------------------------------------------------------------------------- 1 | module Compiler(compile) where 2 | 3 | import Machine 4 | import Syntax 5 | import StackMap 6 | import Value 7 | 8 | compile :: Command -> [Instruction] 9 | compile c = 10 | replicate (depth sm) (Push Wrong) ++ 11 | compObey sm c ++ 12 | [Halt] 13 | where 14 | sm = stackMap c 15 | 16 | compObey :: StackMap -> Command -> [Instruction] 17 | compObey sm Skip = 18 | [] 19 | compObey sm (v := e) = 20 | compEval sm e ++ 21 | [Store (location sm v + 1)] 22 | compObey sm (c1 :-> c2) = 23 | compObey sm c1 ++ 24 | compObey sm c2 25 | compObey sm (If e c1 c2) = 26 | compEval sm e ++ 27 | [JumpUnless (length isc1 + 1)] ++ 28 | isc1 ++ 29 | [Jump (length isc2)] ++ 30 | isc2 31 | where 32 | isc1 = compObey sm c1 33 | isc2 = compObey sm c2 34 | compObey sm (While e c) = 35 | ise ++ 36 | [JumpUnless (length isc + 1)] ++ 37 | isc ++ 38 | [Jump (negate (length isc + 1 + length ise + 1))] 39 | where 40 | ise = compEval sm e 41 | isc = compObey sm c 42 | compObey sm (Print e) = 43 | compEval sm e ++ 44 | [Display] 45 | 46 | compEval :: StackMap -> Expr -> [Instruction] 47 | compEval sm (Val v) = 48 | [Push v] 49 | compEval sm (Var v) = 50 | [Fetch (location sm v)] 51 | compEval sm (Uno op1 e) = 52 | compEval sm e ++ 53 | [Instr1 op1] 54 | compEval sm (Duo op2 e1 e2) = 55 | compEval sm e1 ++ 56 | compEval (push sm) e2 ++ 57 | [Instr2 op2] 58 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/Interpreter.hs: -------------------------------------------------------------------------------- 1 | module Interpreter(obey) where 2 | 3 | import Syntax 4 | import Behaviour 5 | import Value 6 | 7 | type Env = [(Name,Value)] 8 | 9 | obey :: Command -> Trace Value 10 | obey p = fst (run p []) 11 | 12 | look :: Name -> Env -> Value 13 | look x s = maybe Wrong id (lookup x s) 14 | 15 | update :: Name -> Value -> Env -> Env 16 | update x a s = (x,a) : filter (\(y,_) -> y/=x) s 17 | 18 | run :: Command -> Env -> (Trace Value, Env) 19 | run Skip s = (End, s) 20 | run (x := e) s = (End, update x (eval e s) s) 21 | run (p :-> q) s = let (outp, sp) = run p s 22 | (outq, sq) = run q sp 23 | in (outp +++ outq, sq) 24 | run (If e p q) s = case eval e s of 25 | Log True -> run p s 26 | Log False -> run q s 27 | _ -> (Crash, s) 28 | run (While e p) s = case eval e s of 29 | Log True -> let (outp,sp) = run p s 30 | (outw,sw) = run (While e p) sp 31 | in (outp +++ Step outw, sw) 32 | Log False -> (End, s) 33 | _ -> (Crash, s) 34 | run (Print e) s = (eval e s :> End, s) 35 | 36 | eval :: Expr -> Env -> Value 37 | eval (Var x) s = look x s 38 | eval (Val v) s = v 39 | eval (Uno op a) s = uno op (eval a s) 40 | eval (Duo op a b) s = duo op (eval a s) (eval b s) 41 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/Machine.hs: -------------------------------------------------------------------------------- 1 | module Machine(Instruction(..), exec) where 2 | 3 | import Array 4 | import Behaviour 5 | import Value 6 | 7 | data Instruction 8 | = Push Value 9 | | Pop 10 | | Fetch Int 11 | | Store Int 12 | | Instr1 Op1 13 | | Instr2 Op2 14 | | Display 15 | | Jump Int 16 | | JumpUnless Int 17 | | Halt 18 | deriving (Eq, Show) 19 | 20 | exec :: [Instruction] -> Trace Value 21 | exec instrs = run 1 [] 22 | where 23 | size = length instrs 24 | memory = array (1,size) ([1..] `zip` instrs) 25 | run pc stack = 26 | if pc < 1 || size < pc then Crash 27 | else 28 | case (memory ! pc, stack) of 29 | (Push x , stack) -> run pc' (x : stack) 30 | (Pop , _ : stack) -> run pc' stack 31 | (Fetch n , stack) 32 | | length stack >= n -> run pc' (stack !! n : stack) 33 | (Store n , x : stack) 34 | | length stack >= n -> run pc' (take (n-1) stack ++ 35 | x : drop n stack) 36 | (Instr1 op1 , i : stack) -> run pc' (uno op1 i : stack) 37 | (Instr2 op2 , i : j : stack) -> run pc' (duo op2 j i : stack) 38 | (Display , i : stack) -> i :> run pc' stack 39 | (Jump n , stack) -> step n (run (pc' + n) stack) 40 | (JumpUnless n , Log b : stack) 41 | | b -> run pc' stack 42 | | otherwise -> step n (run (pc' + n) stack) 43 | (Halt , stack) -> End 44 | _ -> Crash 45 | where 46 | pc' = pc + 1 47 | 48 | step :: Int -> Trace Value -> Trace Value 49 | step n t | n < 0 = Step t 50 | | otherwise = t 51 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Syntax 4 | import Parser 5 | import Interpreter 6 | import Machine 7 | import Compiler 8 | 9 | main = do 10 | source <- getContents 11 | let prog = parse source 12 | putStrLn "interpreted:" 13 | print (obey prog) 14 | putStrLn "compiled:" 15 | print (exec (compile prog)) 16 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/StackMap.hs: -------------------------------------------------------------------------------- 1 | module StackMap where 2 | 3 | import Syntax 4 | import List( union ) 5 | 6 | type StackMap = (Int,[Name]) 7 | 8 | stackMap :: Command -> StackMap 9 | stackMap c = (0, comVars c) 10 | 11 | push :: StackMap -> StackMap 12 | push (n, vars) = (n+1, vars) 13 | 14 | pop :: StackMap -> StackMap 15 | pop (n, vars) = (n-1, vars) 16 | 17 | location :: StackMap -> Name -> Int 18 | location (n, vars) v = n + length (takeWhile (/=v) vars) 19 | 20 | depth :: StackMap -> Int 21 | depth (n, vars) = n + length vars 22 | 23 | expVars :: Expr -> [Name] 24 | expVars (Var v) = [v] 25 | expVars (Val _) = [] 26 | expVars (Uno _ a) = expVars a 27 | expVars (Duo _ a b) = expVars a `union` expVars b 28 | 29 | comVars :: Command -> [Name] 30 | comVars Skip = [] 31 | comVars (x := e) = [x] `union` expVars e 32 | comVars (c1 :-> c2) = comVars c1 `union` comVars c2 33 | comVars (If e c1 c2) = expVars e `union` comVars c1 `union` comVars c2 34 | comVars (While e c) = expVars e `union` comVars c 35 | comVars (Print e) = expVars e 36 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/Syntax.hs: -------------------------------------------------------------------------------- 1 | module Syntax(Name, Expr(..), Command(..)) where 2 | 3 | import Value 4 | 5 | type Name = String 6 | 7 | data Expr 8 | = Var Name 9 | | Val Value 10 | | Uno Op1 Expr 11 | | Duo Op2 Expr Expr 12 | deriving (Eq, Show) 13 | 14 | data Command 15 | = Skip 16 | | Name := Expr 17 | | Command :-> Command 18 | | If Expr Command Command 19 | | While Expr Command 20 | | Print Expr 21 | deriving (Eq, Show) 22 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/Value.hs: -------------------------------------------------------------------------------- 1 | module Value(Value(..), Op1(..), Op2(..), uno, duo) where 2 | 3 | data Value 4 | = Num Int 5 | | Log Bool 6 | | Wrong 7 | deriving (Eq, Show) 8 | 9 | data Op1 10 | = Not 11 | | Minus 12 | deriving (Eq, Show) 13 | 14 | data Op2 15 | = And 16 | | Or 17 | | Mul 18 | | Add 19 | | Sub 20 | | Div 21 | | Mod 22 | | Less 23 | | LessEq 24 | | Eq 25 | deriving (Eq, Show) 26 | 27 | uno :: Op1 -> Value -> Value 28 | uno Not (Log b) = Log (not b) 29 | uno Minus (Num n) = Num (negate n) 30 | uno _ _ = Wrong 31 | 32 | duo :: Op2 -> Value -> Value -> Value 33 | duo And (Log a) (Log b) = Log (a && b) 34 | duo Or (Log a) (Log b) = Log (a || b) 35 | duo Eq (Log a) (Log b) = Log (a == b) 36 | duo Mul (Num m) (Num n) = Num (m * n) 37 | duo Add (Num m) (Num n) = Num (m + n) 38 | duo Sub (Num m) (Num n) = Num (m - n) 39 | duo Div (Num m) (Num n) | n /= 0 = Num (m `div` n) 40 | duo Mod (Num m) (Num n) | n /= 0 = Num (m `mod` n) 41 | duo Less (Num m) (Num n) = Log (m < n) 42 | duo LessEq (Num m) (Num n) = Log (m <= n) 43 | duo Eq (Num m) (Num n) = Log (m == n) 44 | duo _ _ _ = Wrong 45 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler/vanilla/gcd.in: -------------------------------------------------------------------------------- 1 | x := 148; y := 58; 2 | while ~(x=y) do 3 | if x < y then y := y - x 4 | else x := x - y 5 | fi 6 | od; 7 | print x 8 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler__with_properties/Behaviour.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module Behaviour(Trace(..),(+++),approx,prop_traceLessThan100Deep) where 3 | import Debug.Hoed.Pure 4 | 5 | data Trace a 6 | = Step (Trace a) 7 | | a :> Trace a 8 | | End 9 | | Crash 10 | deriving (Eq, Show,Generic) 11 | 12 | instance Observable a => Observable (Trace a) 13 | 14 | (+++) :: Trace a -> Trace a -> Trace a 15 | Step s +++ t = Step (s +++ t) 16 | (x :> s) +++ t = x :> (s +++ t) 17 | End +++ t = t 18 | Crash +++ t = Crash 19 | 20 | approx :: Eq a => Int -> Trace a -> Trace a -> Bool 21 | approx 0 _ _ = True 22 | approx n (a :> s) (b :> t) = a == b && approx (n-1) s t 23 | approx n (Step s) (Step t) = approx (n-1) s t 24 | approx n End End = True 25 | approx n Crash Crash = True 26 | approx n _ _ = False 27 | 28 | prop_traceLessThan100Deep :: (Trace a) -> Bool 29 | prop_traceLessThan100Deep = lessThanXDeep 100 30 | where lessThanXDeep 0 _ = False 31 | lessThanXDeep x (Step trc) = lessThanXDeep (x-1) trc 32 | lessThanXDeep x (_ :> trc) = lessThanXDeep (x-1) trc 33 | lessThanXDeep _ End = True 34 | lessThanXDeep _ Crash = True 35 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler__with_properties/Compiler.hs: -------------------------------------------------------------------------------- 1 | module Compiler(compile) where 2 | 3 | import Machine 4 | import Syntax 5 | import StackMap 6 | import Value 7 | 8 | compile :: Command -> [Instruction] 9 | compile c = 10 | replicate (depth sm) (Push Wrong) ++ 11 | compObey sm c ++ 12 | [Halt] 13 | where 14 | sm = stackMap c 15 | 16 | compObey :: StackMap -> Command -> [Instruction] 17 | compObey sm Skip = 18 | [] 19 | compObey sm (v := e) = 20 | compEval sm e ++ 21 | [Store (location sm v + 1)] 22 | compObey sm (c1 :-> c2) = 23 | compObey sm c1 ++ 24 | compObey sm c2 25 | compObey sm (If e c1 c2) = 26 | compEval sm e ++ 27 | [JumpUnless (length isc1 + 1)] ++ 28 | isc1 ++ 29 | [Jump (length isc2)] ++ 30 | isc2 31 | where 32 | isc1 = compObey sm c1 33 | isc2 = compObey sm c2 34 | compObey sm (While e c) = 35 | ise ++ 36 | [JumpUnless (length isc + 1)] ++ 37 | isc ++ 38 | [Jump (negate (length isc + 1 + length ise + 1))] 39 | where 40 | ise = compEval sm e 41 | isc = compObey sm c 42 | compObey sm (Print e) = 43 | compEval sm e ++ 44 | [Display] 45 | 46 | compEval :: StackMap -> Expr -> [Instruction] 47 | compEval sm (Val v) = 48 | [Push v] 49 | compEval sm (Var v) = 50 | [Fetch (location sm v)] 51 | compEval sm (Uno op1 e) = 52 | [Instr1 op1] ++ 53 | compEval sm e 54 | compEval sm (Duo op2 e1 e2) = 55 | [Instr2 op2] ++ 56 | compEval sm e1 ++ 57 | compEval (push sm) e2 58 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler__with_properties/Machine.hs: -------------------------------------------------------------------------------- 1 | module Machine(Instruction(..), exec) where 2 | 3 | import Data.Array 4 | import Behaviour 5 | import Value 6 | 7 | data Instruction 8 | = Push Value 9 | | Pop 10 | | Fetch Int 11 | | Store Int 12 | | Instr1 Op1 13 | | Instr2 Op2 14 | | Display 15 | | Jump Int 16 | | JumpUnless Int 17 | | Halt 18 | deriving (Eq, Show) 19 | 20 | exec :: [Instruction] -> Trace Value 21 | exec instrs = run 1 [] 22 | where 23 | size = length instrs 24 | memory = array (1,size) ([1..] `zip` instrs) 25 | run pc stack = 26 | if pc < 1 || size < pc then Crash 27 | else 28 | case (memory ! pc, stack) of 29 | (Push x , stack) -> run pc' (x : stack) 30 | (Pop , _ : stack) -> run pc' stack 31 | (Fetch n , stack) 32 | | length stack > n -> run pc' (stack !! n : stack) 33 | (Store n , x : stack) 34 | | length stack >= n -> run pc' (take (n-1) stack ++ 35 | x : drop n stack) 36 | (Instr1 op1 , i : stack) -> run pc' (uno op1 i : stack) 37 | (Instr2 op2 , i : j : stack) -> run pc' (duo op2 j i : stack) 38 | (Display , i : stack) -> i :> run pc' stack 39 | (Jump n , stack) -> step n (run (pc' + n) stack) 40 | (JumpUnless n , Log b : stack) 41 | | b -> run pc' stack 42 | | otherwise -> step n (run (pc' + n) stack) 43 | (Halt , stack) -> End 44 | _ -> Crash 45 | where 46 | pc' = pc + 1 47 | 48 | step :: Int -> Trace Value -> Trace Value 49 | step n t | n < 0 = Step t 50 | | otherwise = t 51 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler__with_properties/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Debug.Hoed.Pure 4 | import Syntax 5 | import Parser 6 | import Interpreter 7 | import Machine 8 | import Compiler 9 | 10 | main = runOwp properties $ do 11 | let prog = parse gcdSource 12 | putStrLn "interpreted:" 13 | print (obey prog) 14 | putStrLn "compiled:" 15 | print (exec (compile prog)) 16 | where 17 | properties = [Propositions [mkProposition modInterpreter "prop_ifT" 18 | `ofType` BoolProposition 19 | `withSignature`[Argument 1, Argument 0] 20 | ]PropertiesOf "run" [modSyntax,modValue,modQuickCheck] 21 | ] 22 | modInterpreter = Module "Interpreter" "../examples/afp02Exercises/Compiler__with_properties/" 23 | modValue = Module "Value" "../examples/afp02Exercises/Compiler__with_properties/" 24 | modSyntax = Module "Syntax" "../examples/afp02Exercises/Compiler__with_properties/" 25 | modQuickCheck = Module "Test.QuickCheck" "" 26 | 27 | gcdSource :: String 28 | gcdSource = "x := 148; y := 58;\nwhile ~(x=y) do\n if x < y then y := y - x\n else x := x - y\n fi\nod;\nprint x\n" 29 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler__with_properties/StackMap.hs: -------------------------------------------------------------------------------- 1 | module StackMap where 2 | 3 | import Syntax 4 | import Data.List( union ) 5 | 6 | type StackMap = (Int,[Name]) 7 | 8 | stackMap :: Command -> StackMap 9 | stackMap c = (0, comVars c) 10 | 11 | push :: StackMap -> StackMap 12 | push (n, vars) = (n+1, vars) 13 | 14 | pop :: StackMap -> StackMap 15 | pop (n, vars) = (n-1, vars) 16 | 17 | location :: StackMap -> Name -> Int 18 | location (n, vars) v = n + length (takeWhile (/=v) vars) 19 | 20 | depth :: StackMap -> Int 21 | depth (n, vars) = n + length vars 22 | 23 | expVars :: Expr -> [Name] 24 | expVars (Var v) = [v] 25 | expVars (Val _) = [] 26 | expVars (Uno _ a) = expVars a 27 | expVars (Duo _ a b) = expVars a `union` expVars b 28 | 29 | comVars :: Command -> [Name] 30 | comVars Skip = [] 31 | comVars (x := e) = [x] `union` expVars e 32 | comVars (c1 :-> c2) = comVars c1 `union` comVars c2 33 | comVars (If e c1 c2) = expVars e `union` comVars c1 `union` comVars c2 34 | comVars (While e c) = expVars e `union` comVars c 35 | comVars (Print e) = expVars e 36 | -------------------------------------------------------------------------------- /examples/afp02Exercises/Compiler__with_properties/Syntax.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module Syntax(Name, Expr(..), Command(..)) where 3 | 4 | import Value 5 | import Debug.Hoed.Pure 6 | import Test.QuickCheck 7 | import Control.Monad(liftM,liftM2,liftM3) 8 | 9 | type Name = String 10 | 11 | name :: Gen Name 12 | name = elements ["x","y","z"] 13 | 14 | data Expr 15 | = Var Name 16 | | Val Value 17 | | Uno Op1 Expr 18 | | Duo Op2 Expr Expr 19 | deriving (Eq, Show, Generic) 20 | 21 | instance Observable Expr 22 | 23 | instance Arbitrary Expr where 24 | arbitrary = sized expr 25 | where expr 0 = oneof [liftM Var name, liftM Val arbitrary] 26 | expr n = oneof [liftM Var name, liftM Val arbitrary 27 | ,liftM2 Uno arbitrary (expr (n-1)) 28 | ,liftM3 Duo arbitrary (expr (n `div` 2)) (expr (n `div` 2))] 29 | 30 | data Command 31 | = Skip 32 | | Name := Expr 33 | | Command :-> Command 34 | | If Expr Command Command 35 | | While Expr Command 36 | | Print Expr 37 | deriving (Eq, Show, Generic) 38 | 39 | instance Observable Command 40 | 41 | instance Arbitrary Command where 42 | arbitrary = sized command 43 | where command 0 = oneof [liftM2 (:=) name arbitrary, return Skip] 44 | command n = oneof [liftM2 (:=) name arbitrary, return Skip 45 | ,liftM2 (:->) (command (n `div` 2)) (command (n `div` 2)) 46 | ,liftM3 If arbitrary (command (n `div` 2)) (command (n `div` 2)) 47 | ,liftM2 While arbitrary (command (n-1)) 48 | ,liftM Print arbitrary] 49 | 50 | -------------------------------------------------------------------------------- /examples/filter__with_properties/Even.hs: -------------------------------------------------------------------------------- 1 | module Even where 2 | 3 | import Prelude hiding (filter) 4 | import Debug.Hoed.Pure 5 | import Data.Bits 6 | import Properties 7 | import Test.QuickCheck hiding ((.&.)) 8 | import Test.QuickCheck.Property hiding ((.&.)) 9 | import Test.QuickCheck.Gen 10 | import Test.QuickCheck.Random 11 | import Data.Maybe 12 | 13 | filter :: Observable a => (a -> Bool) -> [a] -> [a] 14 | filter = observe "filter" filter' 15 | filter' pred [] = [] 16 | filter' pred (x:xs) 17 | | pred x = filter pred xs 18 | | otherwise = x : filter pred xs 19 | 20 | odds :: [Int] -> [Int] 21 | odds = observe "odds" odds' 22 | odds' xs = filter (not . isEven) xs 23 | 24 | isEven :: Int -> Bool 25 | isEven = observe "isEven" isEven' 26 | isEven' x = (x .&. 1) == 0 27 | 28 | doit :: IO () 29 | doit = runOwp properties ((\q -> do MkRose res ts <- reduceRose . unProp . (\p->unGen p (mkQCGen 1) 1) . unProperty $ q; print . fromJust . ok $ res) $ spec_odds odds [3,4] 3) 30 | -------------------------------------------------------------------------------- /examples/filter__with_properties/Main.hs: -------------------------------------------------------------------------------- 1 | import Even 2 | 3 | main = doit 4 | -------------------------------------------------------------------------------- /examples/quicksort.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ViewPatterns #-} 3 | import Debug.Hoed 4 | import qualified Data.List 5 | 6 | quicksort :: Observable a => (a -> a -> Bool) -> [a] -> [a] 7 | quicksort = observe "quicksort" quicksort' 8 | quicksort' op [] = [] 9 | quicksort' op (x:xs) = id_quicksort $ quicksort op lt ++ [x] ++ quicksort op gt 10 | where (observe "lt" . id_lt -> lt, observe "gt" -> gt) = partition (`op` x) xs 11 | 12 | partition :: Observable a => (a -> Bool) -> [a] -> ([a],[a]) 13 | partition = observe "partition" partition' 14 | {-# INLINE partition #-} 15 | partition' p xs = foldr (select p) ([],[]) (id_partition xs) 16 | 17 | select :: Observable a => (a -> Bool) -> a -> ([a], [a]) -> ([a], [a]) 18 | -- select = observe "select" select' 19 | select p x ~(ts,fs) | p x = (x:ts,fs) 20 | | otherwise = (ts, x:fs) 21 | 22 | main = printO $ quicksort (<=) "haskell" 23 | 24 | id_quicksort, id_partition,id_lt :: Observable a => a -> a 25 | id_quicksort = observe "id_quicksort" $ \x -> x 26 | id_partition = observe "id_partition" $ \x -> x 27 | id_lt = observe "id_lt" $ \x -> x 28 | -------------------------------------------------------------------------------- /installDependencies: -------------------------------------------------------------------------------- 1 | CABAL_VER=`cabal --numeric-version | sed 's/\./ /g'` 2 | MAJOR=`echo $CABAL_VER | awk '{print $1}'` 3 | MINOR=`echo $CABAL_VER | awk '{print $2}'` 4 | FLAGS="validateStk validatePure validateProp buildExamples" 5 | 6 | 7 | if [ "$MAJOR" -le "1" -a "$MINOR" -le "18" ]; then 8 | cabal install --only-dependencies --enable-library-profiling --flags="$FLAGS" 9 | else 10 | cabal install --only-dependencies --enable-profiling --flags="$FLAGS" 11 | fi 12 | 13 | cabal clean 14 | -------------------------------------------------------------------------------- /mktags: -------------------------------------------------------------------------------- 1 | (hasktags --ignore-close-implementation --ctags .; sort tags) &> /dev/null 2 | -------------------------------------------------------------------------------- /run: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | EXAMPLES=`ls dist/build | grep hoed-examples` 3 | ulimit -v 1000000 # limit memory usage to 10 GB 4 | 5 | echo "Available examples:" 6 | i=0 7 | for e in $EXAMPLES; do 8 | echo -n "$i) " 9 | echo $e | sed 's/^hoed-examples-//' | sed 's/__.*/ (&)/' |sed 's/__//' | sed 's/_/ /g' 10 | ((i++)) 11 | done 12 | 13 | echo -n "Select program or -1 to cancel: " 14 | read 15 | 16 | # Find the appropriate example from the given input 17 | j=0 18 | for e in $EXAMPLES; do 19 | if ((j==$REPLY)); then 20 | EXE=$e 21 | break 22 | fi 23 | ((j++)) 24 | done 25 | 26 | # Or exit if the input was invalid (or -1) 27 | if ((j>=i)); then 28 | echo "Bye" 29 | exit 1 30 | fi 31 | 32 | echo "Now executing $EXE." 33 | 34 | rm -f tmp/wwwroot/debugTree.png tmp/debugTree.dot 35 | cd tmp 36 | # if echo $EXE | grep -q does_not_terminate; then 37 | # echo "You selected a non terminating program. Will kill after 1 second." 38 | # ../dist/build/$EXE/$EXE +RTS -p -h -L80 & 39 | # sleep 1s 40 | # kill -2 $! # send a "ctrl-C" signal to stop the hanging compiler... 41 | # wait 42 | # else 43 | # ../dist/build/$EXE/$EXE +RTS -p -h -L80 44 | # fi 45 | 46 | eval ../dist/build/$EXE/$EXE 47 | 48 | # profile .... 49 | #../dist/build/$EXE/$EXE +RTS -hd -L80 50 | 51 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | extra-deps: [] 5 | resolver: lts-15.9 6 | -------------------------------------------------------------------------------- /test.Generic: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | TESTS="0 1 2 3" 4 | FAIL=0 5 | 6 | echo 7 | echo "Testing parallel equality for Generic types" 8 | echo 9 | 10 | x=`./dist/build/hoed-tests-ParEq/hoed-tests-ParEq` 11 | if [ $x = "True" ]; then 12 | echo -n "[OK" 13 | else 14 | FAIL=1 15 | echo -n "[" 16 | echo -en '\E[37;31m'"\033[1m!!\033[0m" # red "!!" on white background 17 | tput sgr0 # reset colour 18 | fi 19 | echo "] Generic.ParEq" 20 | 21 | echo 22 | echo "Testing events produced for Observable derived for Generic types" 23 | echo 24 | 25 | # Ensure there is a directory to execute in. 26 | if [ ! -d tests/exe ]; then 27 | mkdir tests/exe 28 | fi 29 | 30 | rm -f tests/exe/* 31 | cd tests/exe 32 | for n in $TESTS; do 33 | for x in r t; do 34 | t=${x}${n} 35 | eval ../../dist/build/hoed-tests-Generic-${t}/hoed-tests-Generic-${t} &> $t.out 36 | mv .Hoed/Events ${t}.Events 37 | done 38 | diff r${n}.Events t${n}.Events &> ${t}.diff 39 | if [ $? -eq 0 ]; then 40 | echo -n "[OK" 41 | else 42 | FAIL=1 43 | echo -n "[" 44 | echo -en '\E[37;31m'"\033[1m!!\033[0m" # red "!!" on white background 45 | tput sgr0 # reset colour 46 | fi 47 | echo "] Generic.t$n" 48 | done 49 | 50 | exit $FAIL 51 | -------------------------------------------------------------------------------- /test.Prop: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | TESTS=`ls dist/build | grep hoed-tests-Prop` 4 | FAIL=0 5 | VERBOSE=0 6 | 7 | echo "Testing property-based judging" 8 | echo 9 | 10 | # Ensure there is a directory to execute in. 11 | if [ ! -d tests/exe ]; then 12 | mkdir tests/exe 13 | fi 14 | 15 | rm -f tests/exe/* 16 | cd tests/exe 17 | for t in $TESTS; do 18 | eval ../../dist/build/$t/$t &> $t.out 19 | mv .Hoed/Events ${t}.Events 20 | diff $t.graph ../ref/$t.graph &> $t.diff 21 | if [ $? -eq 0 ]; then 22 | echo "[OK] $t" 23 | else 24 | FAIL=1 25 | echo -n "[" 26 | echo -en '\E[37;31m'"\033[1m!!\033[0m" # red "!!" on white background 27 | tput sgr0 # reset colour 28 | echo "] $t" 29 | if [ $VERBOSE -eq 1 ]; then 30 | echo "== Output was ==" 31 | cat $t.out 32 | echo "== Difference with reference computation tree is ==" 33 | cat $t.diff 34 | fi 35 | fi 36 | done 37 | 38 | exit $FAIL 39 | -------------------------------------------------------------------------------- /test.Pure: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | ulimit -v 1000000 # limit memory usage to 10 GB 3 | 4 | TESTS=`ls dist/build | grep hoed-tests-Pure` 5 | FAIL=0 6 | 7 | echo "Testing Hoed-pure" 8 | echo 9 | 10 | # Ensure there is a directory to execute in. 11 | if [ ! -d tests/exe ]; then 12 | mkdir tests/exe 13 | fi 14 | 15 | rm -f tests/exe/* 16 | cd tests/exe 17 | for t in $TESTS; do 18 | eval ../../dist/build/$t/$t &> $t.out 19 | mv .Hoed/Events ${t}.Events 20 | diff $t.graph ../ref/$t.graph &> $t.diff 21 | if [ $? -eq 0 ]; then 22 | echo "[OK] $t" 23 | else 24 | FAIL=1 25 | echo -n "[" 26 | echo -en '\E[37;31m'"\033[1m!!\033[0m" # red "!!" on white background 27 | tput sgr0 # reset colour 28 | echo "] $t" 29 | diff -y $t.graph ../ref/$t.graph # a side-by-side comparison 30 | fi 31 | done 32 | 33 | exit $FAIL 34 | -------------------------------------------------------------------------------- /test.Stk: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | TESTS=`ls dist/build | grep hoed-tests-Stk` 4 | FAIL=0 5 | 6 | echo "Testing Hoed-stk" 7 | echo 8 | 9 | # Ensure there is a directory to execute in. 10 | if [ ! -d tests/exe ]; then 11 | mkdir tests/exe 12 | fi 13 | 14 | rm -f tests/exe/* 15 | cd tests/exe 16 | for t in $TESTS; do 17 | eval ../../dist/build/$t/$t &> $t.out 18 | diff $t.graph ../ref/$t.graph &> $t.diff 19 | if [ $? -eq 0 ]; then 20 | echo "[OK] $t" 21 | else 22 | FAIL=1 23 | echo -n "[" 24 | echo -en '\E[37;31m'"\033[1m!!\033[0m" # red "!!" on white background 25 | tput sgr0 # reset colour 26 | echo "] $t" 27 | diff -y $t.graph ../ref/$t.graph # a side-by-side comparison 28 | fi 29 | done 30 | 31 | exit $FAIL 32 | -------------------------------------------------------------------------------- /tests/Generic/r0.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | 3 | data D = D Int 4 | deriving Show 5 | 6 | instance Observable D where 7 | observer (D x) = send "D" $ return D << x 8 | constrain = undefined 9 | 10 | f = observe "f" f' 11 | f' x = D x 12 | 13 | main = logO "r0" $ print (f 3) 14 | -------------------------------------------------------------------------------- /tests/Generic/r1.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | 3 | data D = D D | C Int 4 | deriving Show 5 | 6 | instance Observable D where 7 | observer (D x) = send "D" $ return D << x 8 | observer (C i) = send "C" $ return C << i 9 | constrain = undefined 10 | 11 | f :: D -> Int 12 | f = observe "f" f' 13 | f' (C x) = x 14 | f' (D d) = f d 15 | 16 | main = logO "r0" $ print (f (D (C 3))) 17 | -------------------------------------------------------------------------------- /tests/Generic/r2.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | 3 | data D = D D | T 4 | deriving (Show) 5 | 6 | instance Observable D where 7 | observer (D x) = send "D" $ return D << x 8 | observer T = send "T" $ return T 9 | constrain = undefined 10 | 11 | f :: D -> Int 12 | f = observe "f" f' 13 | f' T = 1 14 | f' (D _) = 0 15 | 16 | main = logO "r0" $ print (f (D (D (D T)))) 17 | -------------------------------------------------------------------------------- /tests/Generic/r3.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed 2 | 3 | data Expr = Mul Expr Expr | Const Int | Exc 4 | deriving Show 5 | 6 | instance Observable Expr where 7 | observer (Mul e1 e2) = send "Mul" $ return Mul << e1 << e2 8 | observer (Const v) = send "Const" $ return Const << v 9 | observer Exc = send "Exc" $ return Exc 10 | constrain = undefined 11 | 12 | one = observe "one" one' 13 | one' (Mul expr (Const 1)) = expr 14 | one' expr = expr 15 | 16 | main = logO "g" $ print $ one (Mul (Const 1) (Const 1)) 17 | -------------------------------------------------------------------------------- /tests/Generic/t0.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | import Debug.Hoed 3 | 4 | data D = D Int 5 | deriving (Show,Generic) 6 | 7 | instance Observable D 8 | 9 | f = observe "f" f' 10 | f' x = D x 11 | 12 | main = logO "t0" $ print (f 3) 13 | -------------------------------------------------------------------------------- /tests/Generic/t1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | import Debug.Hoed 3 | 4 | data D = D D | C Int 5 | deriving (Show,Generic) 6 | 7 | instance Observable D 8 | 9 | f :: D -> Int 10 | f = observe "f" f' 11 | f' (C x) = x 12 | f' (D d) = f d 13 | 14 | main = logO "r0" $ print (f (D (C 3))) 15 | -------------------------------------------------------------------------------- /tests/Generic/t2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | import Debug.Hoed 3 | 4 | data D = D D | T 5 | deriving (Show,Generic) 6 | 7 | instance Observable D 8 | 9 | f :: D -> Int 10 | f = observe "f" f' 11 | f' T = 1 12 | f' (D _) = 0 13 | 14 | main = logO "r0" $ print (f (D (D (D T)))) 15 | -------------------------------------------------------------------------------- /tests/Generic/t3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | import Debug.Hoed 3 | 4 | data Expr = Mul Expr Expr | Const Int | Exc 5 | deriving (Show,Generic) 6 | 7 | instance Observable Expr 8 | 9 | one = observe "one" one' 10 | one' (Mul expr (Const 1)) = expr 11 | one' expr = expr 12 | 13 | main = logO "g" $ print $ one (Mul (Const 1) (Const 1)) 14 | -------------------------------------------------------------------------------- /tests/Generic/t64.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# OPTIONS -fdefer-type-errors #-} 3 | import Debug.Hoed 4 | 5 | -- Should build 6 | data T64 = T64 { t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15,t16,t17,t18,t19,t20,t21,t22,t23,t24,t25,t26,t27,t28,t29,t30 7 | , t31,t32,t33,t34,t35,t36,t37,t38,t39,t40,t41,t42,t43,t44,t45,t46,t47,t48,t49,t50,t51,t52,t53,t54,t55,t56,t57,t58 8 | , t59,t60,t61,t62,t63,t64 :: ()} 9 | deriving Generic 10 | 11 | instance Observable T64 12 | 13 | data F65 = F65 { f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12,f13,f14,f15,f16,f17,f18,f19,f20,f21,f22,f23,f24,f25,f26,f27,f28,f29,f30 14 | , f31,f32,f33,f34,f35,f36,f37,f38,f39,f40,f41,f42,f43,f44,f45,f46,f47,f48,f49,f50,f51,f52,f53,f54,f55,f56,f57,f58 15 | , f59,f60,f61,f62,f63,f64,f65 :: ()} 16 | deriving (Generic, Show) 17 | 18 | -- Should type erro with "Hoed handles constructors with 64 fields or less" 19 | instance Observable F65 20 | -------------------------------------------------------------------------------- /tests/Prop/t0/Main.hs: -------------------------------------------------------------------------------- 1 | -- A program with unexpected output. 2 | 3 | import MyModule 4 | import Debug.Hoed.Pure 5 | 6 | -- main = quickcheck prop_idemSimplify 7 | main = logOwp Bottom "hoed-tests-Prop-t0.graph" properties $ print $ prop_idemSimplify (Mul (Const 1) (Const 2)) 8 | where 9 | properties = [ Propositions [mkProposition myModule "prop_idemOne" 10 | `ofType` BoolProposition 11 | `withSignature` [Argument 0]] PropertiesOf "one" [] 12 | , Propositions [mkProposition myModule "prop_idemZero" 13 | `ofType` BoolProposition 14 | `withSignature` [Argument 0]] PropertiesOf "zero" [] 15 | , Propositions [mkProposition myModule "prop_idemSimplify" 16 | `ofType` BoolProposition 17 | `withSignature` [Argument 0]] PropertiesOf "simplify" [] 18 | ] 19 | myModule = Module "MyModule" "../Prop/t0/" 20 | -------------------------------------------------------------------------------- /tests/Prop/t0/MyModule.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | module MyModule where 3 | import Debug.Hoed.Pure 4 | 5 | -------------------------------------------------------------------------------- 6 | -- Data types 7 | 8 | data Expr = Mul Expr Expr | Div Expr Expr | Const Int 9 | deriving (Eq,Show,Generic) 10 | 11 | instance Observable Expr 12 | 13 | -------------------------------------------------------------------------------- 14 | -- The simplifier we want to test 15 | 16 | simplify :: Expr -> Expr 17 | simplify = observe "simplify" simplify' 18 | simplify' (Mul e1 e2) = (one . zero) $ Mul (simplify e1) (simplify e2) 19 | simplify' (Div e1 e2) = (one . zero) $ Div (simplify e1) (simplify e2) 20 | simplify' e = (one . zero) e 21 | 22 | one = observe "one" one' 23 | one' (Mul expr (Const 1)) = expr 24 | one' (Mul e1 e2) = Mul e2 e1 25 | one' (Div expr (Const 1)) = expr 26 | one' expr = expr 27 | 28 | zero = observe "zero" zero' 29 | zero' (Mul expr (Const 0)) = Const 0 30 | zero' (Div expr (Const 0)) = Const 0 31 | zero' expr = expr 32 | 33 | -------------------------------------------------------------------------------- 34 | -- The propositions 35 | 36 | idem :: Eq a => (a -> a) -> a -> Bool 37 | idem f x = f x == (f . f) x 38 | 39 | prop_idemSimplify :: Expr -> Bool 40 | prop_idemSimplify = idem simplify 41 | 42 | prop_idemOne :: Expr -> Bool 43 | prop_idemOne = idem one 44 | 45 | prop_idemZero :: Expr -> Bool 46 | prop_idemZero = idem zero 47 | -------------------------------------------------------------------------------- /tests/Prop/t1/Main.hs: -------------------------------------------------------------------------------- 1 | -- A program with unexpected output. 2 | import CNF 3 | import Debug.Hoed.Pure 4 | 5 | -- main = quickcheck prop_idem_negin_sound 6 | main = logOwp Bottom "hoed-tests-Prop-t1.graph" properties $ print (prop_negin_correct eg) 7 | -- main = logOwp "hoed-tests-Prop-t1.graph" properties $ print (negin eg, prop_negin_correct eg) 8 | where 9 | properties = [Propositions 10 | [ mkProposition cnfModule "prop_negin_complete" 11 | `ofType` BoolProposition `withSignature` [Argument 0] 12 | , mkProposition cnfModule "prop_negin_sound" 13 | `ofType` BoolProposition `withSignature` [Argument 0] 14 | ] Specify "negin" [] 15 | ] 16 | cnfModule = Module "CNF" "../Prop/t1/" 17 | -------------------------------------------------------------------------------- /tests/Prop/t2/Main.hs: -------------------------------------------------------------------------------- 1 | -- A program with unexpected output. 2 | import Digraph 3 | import Debug.Hoed.Pure 4 | 5 | -- main = quickcheck prop_idem_negin_sound 6 | main = logOwp Bottom "hoed-tests-Prop-t2.graph" properties $ print (prop_assoc1toNdigraph eg) 7 | where 8 | properties = [ Propositions [mkProposition digraphModule "prop_assoc1toNdigraph" 9 | `ofType` BoolProposition `withSignature` [Argument 0]] Specify "assoc1toNdigraph" [] 10 | , Propositions [mkProposition digraphModule "prop_mergeAndSortTargets" 11 | `ofType` BoolProposition `withSignature` [Argument 0]] Specify "mergeAndSortTargets" [] 12 | , Propositions [mkProposition digraphModule "prop_addMissingSources" 13 | `ofType` BoolProposition `withSignature` [Argument 0]] Specify "addMissingSources" [] 14 | ] 15 | digraphModule = Module "Digraph" "../Prop/t2/" 16 | -------------------------------------------------------------------------------- /tests/Prop/t3/README: -------------------------------------------------------------------------------- 1 | Sources from the test-suite of XMonad 0.11.1 and QuickCheck-1.2.0.1. 2 | -------------------------------------------------------------------------------- /tests/Prop/t3/Test/QuickCheck/Utils.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Test.QuickCheck.Utils 4 | -- Copyright : (c) Andy Gill 2001 5 | -- License : BSD-style (see the file libraries/base/LICENSE) 6 | -- 7 | -- Maintainer : libraries@haskell.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- These are some general purpose utilities for use with QuickCheck. 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Test.QuickCheck.Utils 16 | ( isAssociativeBy 17 | , isAssociative 18 | , isCommutableBy 19 | , isCommutable 20 | , isTotalOrder 21 | ) where 22 | 23 | import Prelude 24 | 25 | import Test.QuickCheck 26 | 27 | isAssociativeBy :: (Show a,Testable prop) 28 | => (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property 29 | isAssociativeBy (===) src (**) = 30 | forAll src $ \ a -> 31 | forAll src $ \ b -> 32 | forAll src $ \ c -> 33 | ((a ** b) ** c) === (a ** (b ** c)) 34 | 35 | isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property 36 | isAssociative = isAssociativeBy (==) arbitrary 37 | 38 | isCommutableBy :: (Show a,Testable prop) 39 | => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property 40 | isCommutableBy (===) src (**) = 41 | forAll src $ \ a -> 42 | forAll src $ \ b -> 43 | (a ** b) === (b ** a) 44 | 45 | isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property 46 | isCommutable = isCommutableBy (==) arbitrary 47 | 48 | isTotalOrder :: (Arbitrary a,Show a,Ord a) => a -> a -> Property 49 | isTotalOrder x y = 50 | classify (x > y) "less than" $ 51 | classify (x == y) "equals" $ 52 | classify (x < y) "greater than" $ 53 | x < y || x == y || x > y 54 | -------------------------------------------------------------------------------- /tests/Prop/t4/README: -------------------------------------------------------------------------------- 1 | Sources from the test-suite of XMonad 0.11.1 and QuickCheck-1.2.0.1. 2 | -------------------------------------------------------------------------------- /tests/Prop/t4/Test/QuickCheck/Utils.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Test.QuickCheck.Utils 4 | -- Copyright : (c) Andy Gill 2001 5 | -- License : BSD-style (see the file libraries/base/LICENSE) 6 | -- 7 | -- Maintainer : libraries@haskell.org 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- These are some general purpose utilities for use with QuickCheck. 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Test.QuickCheck.Utils 16 | ( isAssociativeBy 17 | , isAssociative 18 | , isCommutableBy 19 | , isCommutable 20 | , isTotalOrder 21 | ) where 22 | 23 | import Prelude 24 | 25 | import Test.QuickCheck 26 | 27 | isAssociativeBy :: (Show a,Testable prop) 28 | => (a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property 29 | isAssociativeBy (===) src (**) = 30 | forAll src $ \ a -> 31 | forAll src $ \ b -> 32 | forAll src $ \ c -> 33 | ((a ** b) ** c) === (a ** (b ** c)) 34 | 35 | isAssociative :: (Arbitrary a,Show a,Eq a) => (a -> a -> a) -> Property 36 | isAssociative = isAssociativeBy (==) arbitrary 37 | 38 | isCommutableBy :: (Show a,Testable prop) 39 | => (b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property 40 | isCommutableBy (===) src (**) = 41 | forAll src $ \ a -> 42 | forAll src $ \ b -> 43 | (a ** b) === (b ** a) 44 | 45 | isCommutable :: (Arbitrary a,Show a,Eq b) => (a -> a -> b) -> Property 46 | isCommutable = isCommutableBy (==) arbitrary 47 | 48 | isTotalOrder :: (Arbitrary a,Show a,Ord a) => a -> a -> Property 49 | isTotalOrder x y = 50 | classify (x > y) "less than" $ 51 | classify (x == y) "equals" $ 52 | classify (x < y) "greater than" $ 53 | x < y || x == y || x > y 54 | -------------------------------------------------------------------------------- /tests/Prop/t5/Even.hs: -------------------------------------------------------------------------------- 1 | module Even where 2 | 3 | import Prelude hiding (filter) 4 | import Debug.Hoed.Pure 5 | import Data.Bits 6 | import Properties 7 | import Test.QuickCheck hiding ((.&.)) 8 | import Test.QuickCheck.Property hiding ((.&.)) 9 | import Test.QuickCheck.Gen 10 | import Test.QuickCheck.Random 11 | import Data.Maybe 12 | 13 | filter :: Observable a => (a -> Bool) -> [a] -> [a] 14 | filter = observe "filter" filter' 15 | filter' pred [] = [] 16 | filter' pred (x:xs) 17 | | pred x = filter pred xs 18 | | otherwise = x : filter pred xs 19 | 20 | evens :: [Int] -> [Int] 21 | evens = observe "evens" evens' 22 | evens' xs = filter isEven xs 23 | 24 | isEven :: Int -> Bool 25 | isEven = observe "isEven" isEven' 26 | isEven' x = (x .&. 1) == 0 27 | 28 | doit :: IO () 29 | doit = logOwp Bottom "hoed-tests-Prop-t5.graph" properties ((\q -> do MkRose res ts <- reduceRose . unProp . (\p->unGen p (mkQCGen 1) 1) . unProperty $ q; print . fromJust . ok $ res) $ spec_evens evens [2,3] 2) 30 | -------------------------------------------------------------------------------- /tests/Prop/t5/Main.hs: -------------------------------------------------------------------------------- 1 | import Even 2 | 3 | main = doit 4 | -------------------------------------------------------------------------------- /tests/Pure/t1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Debug.Hoed 3 | import System.Process(system) 4 | import System.Exit(exitWith) 5 | 6 | f :: Int -> Int 7 | f = observe "f" f' 8 | f' x = if x > 0 then g x else 0 9 | 10 | g :: Int -> Int 11 | g = observe "g" g' 12 | g' x = x `div` 2 13 | 14 | main = do 15 | logO "hoed-tests-Pure-t1.graph" $ print ((f 2) + (f 0)) 16 | i <- system "diff hoed-tests-Pure-t1.graph tests/ref/hoed-tests-Pure-t1.graph" 17 | exitWith i 18 | 19 | 20 | -------------------------------------------------------------------------------- /tests/Pure/t2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Debug.Hoed 3 | import System.Process(system) 4 | import System.Exit(exitWith) 5 | 6 | k :: Int -> Int 7 | k = observe "k" k' 8 | k' x = (l x) + (m $ x + 1) 9 | 10 | l :: Int -> Int 11 | l = observe "l" l' 12 | l' x = m x 13 | 14 | m :: Int -> Int 15 | m = observe "m" m' 16 | m' x = n x 17 | 18 | n :: Int -> Int 19 | n = observe "n" n' 20 | n' x = x 21 | 22 | main = do 23 | logO "hoed-tests-Pure-t2.graph" $ print (k 1) 24 | i <- system "diff hoed-tests-Pure-t2.graph tests/ref/hoed-tests-Pure-t2.graph" 25 | exitWith i 26 | -------------------------------------------------------------------------------- /tests/Pure/t3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- Haskell version of the buggy insertion sort as shown in Lee Naish 3 | -- A Declarative Debugging Scheme. 4 | 5 | {-# LANGUAGE StandaloneDeriving #-} 6 | import Debug.Hoed 7 | import System.Process(system) 8 | import System.Exit(exitWith) 9 | 10 | -- Insertion sort. 11 | isort :: [Int] -> [Int] 12 | isort = observe "isort" isort' 13 | isort' [] = [] 14 | isort' (n:ns) = insert n (isort ns) 15 | 16 | -- Insert number into sorted list. 17 | insert :: Int -> [Int] -> [Int] 18 | insert = observe "insert" insert' 19 | insert' :: Int -> [Int] -> [Int] 20 | insert' n [] = [n] 21 | insert' n (m:ms) 22 | | n <= m = n : ms -- bug: `m' is missing in this case 23 | | otherwise = m : (insert n ms) 24 | 25 | main = do 26 | logO "hoed-tests-Pure-t3.graph" $ print (isort [1,2]) 27 | i <- system "diff hoed-tests-Pure-t3.graph tests/ref/hoed-tests-Pure-t3.graph" 28 | exitWith i 29 | -------------------------------------------------------------------------------- /tests/Pure/t4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- A defective implementation of a parity function with a test property. 3 | 4 | import Debug.Hoed 5 | import System.Process(system) 6 | import System.Exit(exitWith) 7 | 8 | isOdd :: Int -> Bool 9 | isOdd = observe "isOdd" isOdd' 10 | isOdd' n = isEven (plusOne n) 11 | 12 | isEven :: Int -> Bool 13 | isEven = observe "isEven" isEven' 14 | isEven' n = mod2 n == 0 15 | 16 | plusOne :: Int -> Int 17 | plusOne = observe "plusOne" plusOne' 18 | plusOne' n = n + 1 19 | 20 | mod2 :: Int -> Int 21 | mod2 = observe "mod2" mod2' 22 | mod2' n = div n 2 23 | 24 | prop_isOdd :: Int -> Bool 25 | prop_isOdd x = isOdd (2*x+1) 26 | 27 | main :: IO () 28 | main = do 29 | logO "hoed-tests-Pure-t4.graph" $ print (prop_isOdd 1) 30 | i <- system "diff hoed-tests-Pure-t3.graph tests/ref/hoed-tests-Pure-t3.graph" 31 | exitWith i 32 | -------------------------------------------------------------------------------- /tests/Pure/t5.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Debug.Hoed 3 | import System.Process(system) 4 | import System.Exit(exitWith) 5 | 6 | f :: Maybe Int -> Int 7 | f = observe "f" f' 8 | f' (Just i) = g i 9 | f' Nothing = 0 10 | 11 | g :: Int -> Int 12 | g = observe "g" g' 13 | g' x = x + x 14 | 15 | main :: IO () 16 | main = do 17 | logO "hoed-tests-Pure-t5.graph" $ print (f $ Just 3) 18 | i <- system "diff hoed-tests-Pure-t5.graph tests/ref/hoed-tests-Pure-t5.graph" 19 | exitWith i 20 | -------------------------------------------------------------------------------- /tests/Pure/t6.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | module Main where 4 | import Debug.Hoed 5 | import System.Process(system) 6 | import System.Exit(exitWith) 7 | 8 | -- This test demonstrates that using the FPretty library we pretty print 9 | -- much bigger computation statements than with the previous implementation 10 | -- based on Wadler's "prettier printer". 11 | 12 | data T = Step T | End deriving Generic 13 | instance Observable T 14 | 15 | v :: T 16 | v = foldr (\_ -> Step) End [1..1000] 17 | 18 | ends :: T -> Bool 19 | ends = observe "ends" ends' 20 | ends' (Step t) = ends' t 21 | ends' End = True 22 | 23 | main = do 24 | logO "hoed-tests-Pure-t6.graph" $ print $ ends v 25 | i <- system "diff hoed-tests-Pure-t6.graph tests/ref/hoed-tests-Pure-t6.graph" 26 | exitWith i 27 | -------------------------------------------------------------------------------- /tests/Pure/t7.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Debug.Hoed 3 | import System.Process(system) 4 | import System.Exit(exitWith) 5 | 6 | plus :: Int -> Int -> Int 7 | plus = {- observe "plus"-} (+) 8 | 9 | apx :: (Int -> Int) -> Int -> Int 10 | apx = {- observe "apx" -} apx' 11 | apx' f x = f x 12 | 13 | apxy :: (Int -> Int -> Int) -> Int -> Int -> Int 14 | apxy = observe "apxy" apxy' 15 | apxy' f x y = f x y 16 | 17 | ap45' :: (Int->Int->Int) -> Int 18 | ap45 = observe "ap45" ap45' 19 | ap45' f = apx (apxy f 4) 5 20 | 21 | main = do 22 | logO "hoed-tests-Pure-t7.graph" $ print (ap45 plus) 23 | i <- system "diff hoed-tests-Pure-t7.graph tests/ref/hoed-tests-Pure-t7.graph" 24 | exitWith i 25 | -------------------------------------------------------------------------------- /tests/Stk/Example1.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed.Stk 2 | 3 | f :: Int -> Int 4 | f = observe "f" $ \x -> {-# SCC "f" #-} if x > 0 then g x else 0 5 | 6 | g :: Int -> Int 7 | g = observe "g" $ \x -> {-# SCC "g" #-} x `div` 2 8 | 9 | main = logO "hoed-tests-Stk-Example1.graph" $ print ((f 2) + (f 0)) 10 | -------------------------------------------------------------------------------- /tests/Stk/Example3.lhs: -------------------------------------------------------------------------------- 1 | > {-# LANGUAGE TemplateHaskell, Rank2Types #-} 2 | > import Debug.Hoed.Stk 3 | 4 | > $(observedTypes "k" []) 5 | > $(observedTypes "l" []) 6 | > $(observedTypes "m" []) 7 | > $(observedTypes "n" []) 8 | 9 | 10 | > main = logO "hoed-tests-Stk-Example3.graph" $ print (k 1) 11 | 12 | > k :: Int -> Int 13 | > k x = $(observeTempl "k") k' x 14 | > k' x = {-# SCC "k" #-} k'' x 15 | > k'' x = (l x) + (m $ x + 1) 16 | 17 | > l :: Int -> Int 18 | > l x = $(observeTempl "l") l' x 19 | > l' x = {-# SCC "l" #-} m x 20 | 21 | > m :: Int -> Int 22 | > m x = $(observeTempl "m") m' x 23 | > m' x = {-# SCC "m" #-} n x 24 | 25 | > n :: Int -> Int 26 | > n x = $(observeTempl "n") n' x 27 | > n' x = {-# SCC "n" #-} x 28 | -------------------------------------------------------------------------------- /tests/Stk/Example4.hs: -------------------------------------------------------------------------------- 1 | import Debug.Hoed.Stk 2 | 3 | main = logO "hoed-tests-Stk-Example4.graph" $ print (observe "main" $ 42 :: Int) 4 | -------------------------------------------------------------------------------- /tests/Stk/IndirectRecursion.lhs: -------------------------------------------------------------------------------- 1 | This is an example of how information is lost as a result of trunction of the 2 | cost centre stack. The actual call graph is of this program is: 3 | 4 | main -> f 1 -> g 2 -> f 3 -> h 1 5 | 6 | But with pushing "f" a second time the "g" label is also lost. Additionally 7 | the h-statement is associated with the stack [f], which can either be from the 8 | untruncated f statement or the truncated f statement. We therefore infer the 9 | following call graph: 10 | 11 | main -> f 1 -> {f 3, g 2} -> h 1 12 | \_________________^ 13 | 14 | > {-# LANGUAGE TemplateHaskell, Rank2Types #-} 15 | > import Debug.Hoed.Stk 16 | 17 | > $(observedTypes "f" []) 18 | > $(observedTypes "g" []) 19 | > $(observedTypes "h" []) 20 | 21 | > f :: Int -> Int 22 | > f x = $(observeTempl "f") f' x 23 | > f' x = {-# SCC "f" #-} f'' x 24 | > f'' 1 = g 2 25 | > f'' x = h (x + 1) 26 | 27 | > g :: Int -> Int 28 | > g x = $(observeTempl "g") g' x 29 | > g' x = {-# SCC "g" #-} g'' x 30 | > g'' x = f (x + 1) 31 | 32 | > h :: Int -> Int 33 | > h x = $(observeTempl "h") h' x 34 | > h' x = {-# SCC "h" #-} h'' x 35 | > h'' x = (x+1) 36 | 37 | > main = logO "hoed-tests-Stk-IndirectRecursion.graph" $ print (f 1) 38 | -------------------------------------------------------------------------------- /tests/Stk/Insort2.hs: -------------------------------------------------------------------------------- 1 | -- Haskell version of the buggy insertion sort as shown in Lee Naish 2 | -- A Declarative Debugging Scheme. 3 | -- 4 | -- As Insort1, but with observe rather than templated observers. 5 | 6 | {-# LANGUAGE StandaloneDeriving #-} 7 | import Debug.Hoed.Stk 8 | 9 | -- Insertion sort. 10 | 11 | isort :: [Int] -> [Int] 12 | isort ns = observe "isort" (\ns -> {-# SCC "isort" #-} isort' ns) ns 13 | isort' [] = [] 14 | isort' (n:ns) = insert n (isort ns) 15 | 16 | -- Insert number into sorted list. 17 | 18 | insert :: Int -> [Int] -> [Int] 19 | insert n ms = (observe "insert" (\n ms -> {-# SCC "insert" #-} insert' n ms)) n ms 20 | insert' :: Int -> [Int] -> [Int] 21 | insert' n [] = [n] 22 | insert' n (m:ms) 23 | | n <= m = n : ms -- bug: `m' is missing in this case 24 | | otherwise = m : (insert n ms) 25 | 26 | main = logO "hoed-tests-Stk-Insort2.graph" . print $ 27 | (observe "result") ({-# SCC "result" #-} isort [1,2]) 28 | 29 | -- Slices, these should be generated automatically from the original code. 30 | 31 | slices 32 | = [ ("result", "isort [1,2]") 33 | , ("isort" , "isort [] = []\n" 34 | ++ "isort (n:ns) = insert n (isort ns)") 35 | , ("insert", " insert n [] = [n]\n" 36 | ++ " insert n (m:ms)\n" 37 | ++ " | n <= m = n : ms\n" 38 | ++ " | otherwise = m : (insert n ms)\n") 39 | ] 40 | -------------------------------------------------------------------------------- /tests/TH/quicksort.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ViewPatterns #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | import Data.List (partition) 4 | import Debug.Hoed 5 | import Debug.Hoed.TH 6 | import System.Process 7 | import System.Exit 8 | 9 | obs [d| 10 | quicksort :: (a -> a -> Bool) -> [a] -> [a] 11 | quicksort op [] = [] 12 | quicksort op (x:xs) = quicksort op lt ++ [x] ++ quicksort op gt 13 | where (lt, gt) = partition (`op` x) xs 14 | |] 15 | 16 | debug [d| 17 | quicksort' :: (a -> a -> Bool) -> [a] -> [a] 18 | quicksort' op [] = [] 19 | quicksort' op (x:xs) = quicksort' op lt ++ [x] ++ quicksort' op gt 20 | where (lt, gt) = partition (`op` x) xs 21 | |] 22 | 23 | main = logO "hoed-tests-th-quicksort.graph" $ do 24 | print $ quicksort (<) "haskell" 25 | print $ quicksort' (<) "haskell" 26 | exitWith =<< system "diff hoed-tests-th-quicksort.graph tests/ref/hoed-tests-th-quicksort.graph" 27 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Prop-t1.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v6 [label="Right: negin (N (V 'r')) = N (V 'r')"] 3 | v5 [label="Assisted [PassingProperty \"prop_negin_complete\",InconclusiveProperty \"\\n---\\n\\nApplying property prop_negin_sound gives inconclusive result:\\n\\n[Escaping Exception in Code : Request of value that was unevaluated in original program.]\\n\"]: negin (V _) = V _"] 4 | v4 [label="Assisted [PassingProperty \"prop_negin_complete\",InconclusiveProperty \"\\n---\\n\\nApplying property prop_negin_sound gives inconclusive result:\\n\\n[Escaping Exception in Code : Request of value that was unevaluated in original program.]\\n\"]: negin (N (N (V _))) = V _"] 5 | v3 [label="Right: negin (N (V 'p')) = N (V 'p')"] 6 | v2 [label="Assisted [InconclusiveProperty \"Simpler tree suggested with complexity 20(current tree has complexity of 30)\"]: negin (N (A (V 'p') (N (V _)))) = A (N (V 'p')) (V _)"] 7 | v1 [label="Assisted [PassingProperty \"prop_negin_complete\",InconclusiveProperty \"\\n---\\n\\nApplying property prop_negin_sound gives inconclusive result:\\n\\n[Escaping Exception in Code : Request of value that was unevaluated in original program.]\\n\"]: negin (N (O (A (V 'p') (N (V _))) (V 'r'))) = O (A (N (V 'p')) (V _)) (N (V 'r'))"] 8 | v0 [label=root] 9 | v2 -> v4 [label=""] 10 | v4 -> v5 [label=""] 11 | v1 -> v2 [label=""] 12 | v2 -> v3 [label=""] 13 | v0 -> v1 [label=""] 14 | v1 -> v6 [label=""] 15 | } 16 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Prop-t2.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v5 [label="Right: mergeAndSortTargets (('v', \"v\") : []) = ('v', \"v\") : []"] 3 | v4 [label="Assisted [InconclusiveProperty \"Simpler tree suggested with complexity 38(current tree has complexity of 90)\"]: mergeAndSortTargets (('s', \"tvtv\") : ('v', \"v\") : []) = ('s', \"ttvv\") : ('v', \"v\") : []"] 4 | v3 [label="Assisted [InconclusiveProperty \"Simpler tree suggested with complexity 57(current tree has complexity of 90)\"]: mergeAndSortTargets (('s', \"t\") : ('s', \"vtv\") : ('v', \"v\") : []) = ('s', \"ttvv\") : ('v', \"v\") : []"] 5 | v2 [label="Right: addMissingSources (('s', \"ttvv\") : ('v', \"v\") : []) = ('s', 't' : 't' : _) : ('t', _) : ('t', _) : ('v', _) : []"] 6 | v1 [label="Assisted [InconclusiveProperty \"We found values for the unevaluated expressions in the current statement that falsify\\na property, however the resulting tree is not simpler.\"]: assoc1toNdigraph (('v', \"v\") : ('s', \"t\") : ('s', \"vtv\") : []) = ('s', 't' : 't' : _) : ('t', _) : ('t', _) : ('v', _) : []"] 7 | v0 [label=root] 8 | v1 -> v3 [label=""] 9 | v3 -> v4 [label=""] 10 | v4 -> v5 [label=""] 11 | v0 -> v1 [label=""] 12 | v1 -> v2 [label=""] 13 | } 14 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Prop-t3.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v5 [label="Unassessed: focusUp' (Stack 'a' \"y\" []) = Stack 'y' [] []"] 3 | v4 [label="Unassessed: focusUp' (Stack 'r' \"ay\" []) = Stack 'a' \"y\" []"] 4 | v3 [label="Assisted [InconclusiveProperty \"Simpler tree suggested with complexity 30(current tree has complexity of 41)\"]: focusUp (StackSet (Screen (Workspace (NonNegative 0) _ (Just (Stack 'a' \"y\" []))) 0 0) _ _ _) = StackSet (Screen (Workspace (NonNegative 0) _ (Just (Stack 'y' [] []))) 0 0) _ _ _"] 5 | v2 [label="Assisted [InconclusiveProperty \"We found values for the unevaluated expressions in the current statement that falsify\\na property, however the resulting tree is not simpler.\"]: focusUp (StackSet (Screen (Workspace (NonNegative 0) _ (Just (Stack 'r' \"ay\" []))) 0 0) _ _ _) = StackSet (Screen (Workspace (NonNegative 0) _ (Just (Stack 'a' \"y\" []))) 0 0) _ _ _"] 6 | v1 [label="Unassessed: focusWindow 'y' (StackSet (Screen (Workspace (NonNegative 0) _ (Just (Stack 'r' \"ay\" []))) 0 0) _ _ _) = StackSet (Screen (Workspace (NonNegative 0) _ (Just (Stack 'y' [] []))) 0 0) _ _ _"] 7 | v0 [label=root] 8 | v0 -> v1 [label=""] 9 | v1 -> v3 [label=""] 10 | v3 -> v5 [label=""] 11 | v1 -> v2 [label=""] 12 | v2 -> v4 [label=""] 13 | } 14 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Prop-t5.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v6 [label="Assisted [InconclusiveProperty \"\\n---\\n\\nApplying property prop_filter_f gives inconclusive result:\\n\\n*** Gave up! Passed only 0 tests.\\n\",InconclusiveProperty \"\\n---\\n\\nApplying property prop_filter_t gives inconclusive result:\\n\\n*** Gave up! Passed only 0 tests.\\n\"]: filter _ [] = []"] 3 | v5 [label="Assisted [InconclusiveProperty \"Simpler tree suggested with complexity 6(current tree has complexity of 35)\"]: filter { \\ 3 -> False } (3 : []) = 3 : []"] 4 | v4 [label="Right: isEven 3 = False"] 5 | v3 [label="Right: isEven 2 = True"] 6 | v2 [label="Assisted [InconclusiveProperty \"Simpler tree suggested with complexity 12(current tree has complexity of 35)\"]: filter { \\ 2 -> True , \\ 3 -> False } (2 : 3 : []) = 3 : []"] 7 | v1 [label="Assisted [InconclusiveProperty \"We found values for the unevaluated expressions in the current statement that falsify\\na property, however the resulting tree is not simpler.\"]: evens (2 : 3 : []) = 3 : []"] 8 | v0 [label=root] 9 | v1 -> v3 [label=""] 10 | v1 -> v4 [label=""] 11 | v0 -> v1 [label=""] 12 | v1 -> v2 [label=""] 13 | v2 -> v5 [label=""] 14 | v5 -> v6 [label=""] 15 | } 16 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Pure-t1.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v3 [label="f 2 = 1"] 3 | v2 [label="f 0 = 0"] 4 | v1 [label="g 2 = 1"] 5 | v0 [label="."shape=none] 6 | v3 -> v1 [label=""] 7 | v0 -> v2 [label=""] 8 | v0 -> v3 [label=""] 9 | } 10 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Pure-t2.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v6 [label="k 1 = 3"] 3 | v5 [label="l 1 = 1"] 4 | v4 [label="m 1 = 1"] 5 | v3 [label="m 2 = 2"] 6 | v2 [label="n 1 = 1"] 7 | v1 [label="n 2 = 2"] 8 | v0 [label="."shape=none] 9 | v3 -> v1 [label=""] 10 | v4 -> v2 [label=""] 11 | v5 -> v4 [label=""] 12 | v6 -> v3 [label=""] 13 | v6 -> v5 [label=""] 14 | v0 -> v6 [label=""] 15 | } 16 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Pure-t3.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v5 [label="isort (1 : 2 : []) = 1 : []"] 3 | v4 [label="isort (2 : []) = 2 : []"] 4 | v3 [label="isort [] = []"] 5 | v2 [label="insert 1 (2 : []) = 1 : []"] 6 | v1 [label="insert 2 [] = 2 : []"] 7 | v0 [label="."shape=none] 8 | v4 -> v3 [label=""] 9 | v4 -> v1 [label=""] 10 | v5 -> v4 [label=""] 11 | v5 -> v2 [label=""] 12 | v0 -> v5 [label=""] 13 | } 14 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Pure-t4.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v4 [label="isOdd 3 = False"] 3 | v3 [label="isEven 4 = False"] 4 | v2 [label="mod2 4 = 2"] 5 | v1 [label="plusOne 3 = 4"] 6 | v0 [label="."shape=none] 7 | v3 -> v2 [label=""] 8 | v4 -> v1 [label=""] 9 | v4 -> v3 [label=""] 10 | v0 -> v4 [label=""] 11 | } 12 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Pure-t5.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v2 [label="f (Just 3) = 6"] 3 | v1 [label="g 3 = 6"] 4 | v0 [label="."shape=none] 5 | v2 -> v1 [label=""] 6 | v0 -> v2 [label=""] 7 | } 8 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Pure-t7.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v2 [label="ap45 { \\ 4 5 -> 9 } = 9"] 3 | v1 [label="apxy { \\ 4 5 -> 9 } 4 5 = 9"] 4 | v0 [label="."shape=none] 5 | v2 -> v1 [label=""] 6 | v0 -> v2 [label=""] 7 | } 8 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Stk-DoublingServer.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v3 [label="{twotimes 2 = 4, twotimes 3 = 5} 3 | with stack [\"double\"]"] 4 | v2 [label="{server 2 socket = _, server 1 socket = _, server 0 _ = _, } 5 | with stack []"] 6 | v1 [label="{double \"2\" = \"4\", double \"3\" = \"5\", } 7 | with stack []"] 8 | v0 [label=root] 9 | v1 -> v3 [label=""] 10 | v0 -> v2 [label=""] 11 | v0 -> v1 [label=""] 12 | } 13 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Stk-Example1.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v2 [label="g 2 = 1 3 | with stack [\"f\"]"] 4 | v1 [label="{f 2 = 1, f 0 = 0, } 5 | with stack []"] 6 | v0 [label=root] 7 | v1 -> v2 [label=""] 8 | v0 -> v1 [label=""] 9 | } 10 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Stk-Example3.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v5 [label="n 1 = 1 3 | with stack [\"m\",\"l\",\"k\"]"] 4 | v4 [label="n 2 = 2 5 | with stack [\"m\",\"k\"]"] 6 | v3 [label="m 2 = 2 7 | with stack [\"k\"]"] 8 | v2 [label="k 1 = 3 9 | with stack []"] 10 | v1 [label=root] 11 | v0 [label="{l 1 = 1, m 1 = 1} 12 | with stack [\"k\"]"] 13 | v2 -> v5 [label=""] 14 | v3 -> v0 [label=""] 15 | v2 -> v4 [label=""] 16 | v0 -> v5 [label=""] 17 | v3 -> v4 [label=""] 18 | v2 -> v0 [label=""] 19 | v2 -> v3 [label=""] 20 | v1 -> v2 [label=""] 21 | } 22 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Stk-Example4.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v1 [label="main = 42 3 | with stack []"] 4 | v0 [label=root] 5 | v0 -> v1 [label=""] 6 | } 7 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Stk-IndirectRecursion.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v3 [label="h 4 = 5 3 | with stack [\"f\"]"] 4 | v2 [label="f 1 = 5 5 | with stack []"] 6 | v1 [label=root] 7 | v0 [label="{g 2 = 5, f 3 = 5} 8 | with stack [\"f\"]"] 9 | v0 -> v3 [label=""] 10 | v2 -> v0 [label=""] 11 | v2 -> v3 [label=""] 12 | v1 -> v2 [label=""] 13 | } 14 | -------------------------------------------------------------------------------- /tests/ref/hoed-tests-Stk-Insort2.graph: -------------------------------------------------------------------------------- 1 | diGraph G { 2 | v4 [label="{isort (2 : []) = 2 : [], isort [] = []} 3 | with stack [\"isort\",\"result\"]"] 4 | v3 [label="{insert 1 (2 : []) = 1 : [], insert 2 [] = 2 : []} 5 | with stack [\"isort\",\"result\"]"] 6 | v2 [label="isort (1 : 2 : []) = 1 : [] 7 | with stack [\"result\"]"] 8 | v1 [label="result = 1 : [] 9 | with stack []"] 10 | v0 [label=root] 11 | v1 -> v4 [label=""] 12 | v1 -> v3 [label=""] 13 | v4 -> v3 [label=""] 14 | v2 -> v3 [label=""] 15 | v2 -> v4 [label=""] 16 | v1 -> v2 [label=""] 17 | v0 -> v1 [label=""] 18 | } 19 | --------------------------------------------------------------------------------