fork download
  1. module type QUEUE_FUN =
  2. sig
  3. type 'a t
  4. exception Empty of string
  5. val empty: unit -> 'a t
  6. val enqueue: 'a * 'a t -> 'a t
  7. val dequeue: 'a t -> 'a t
  8. val first: 'a t -> 'a
  9. val isEmpty: 'a t -> bool
  10. end;;
  11.  
  12. module QueueList : QUEUE_FUN =
  13. struct
  14. type 'a t = 'a list
  15. exception Empty of string
  16.  
  17. let empty () = []
  18.  
  19. let isEmpty queue = queue = []
  20.  
  21. let enqueue (x, queue) = queue @ [x]
  22.  
  23. let dequeue queue =
  24. match queue with
  25. | [] -> []
  26. | _ :: q -> q
  27.  
  28. let first queue =
  29. match queue with
  30. | [] -> raise (Empty "QueueList.first")
  31. | x :: _ -> x
  32. end;;
  33.  
  34. module QueueTwoLists : QUEUE_FUN =
  35. struct
  36. type 'a t = 'a list * 'a list
  37. exception Empty of string
  38.  
  39. let empty () = ([], [])
  40. let isEmpty queue = queue = ([], [])
  41. let enqueue (x, queue) =
  42. match queue with
  43. | ([], []) -> ([x], [])
  44. | ([], inbox) -> (List.rev inbox, [x])
  45. | (outbox, inbox) -> (outbox, x :: inbox)
  46. let dequeue queue =
  47. match queue with
  48. | ([], []) -> ([], [])
  49. | ([], inbox) ->
  50. let _ :: outbox = List.rev inbox in
  51. (outbox, [])
  52. | (_ :: outbox, inbox) -> (outbox, inbox)
  53. let first queue =
  54. match queue with
  55. | ([], _) -> raise (Empty "QueueTwoLists.first")
  56. | (x :: _, _) -> x
  57. end;;
  58.  
  59. exception Axiom_fail of string * int;;
  60.  
  61. let test_queue empty enqueue dequeue first isEmpty name =
  62. let test n axiom = if axiom then true else raise (Axiom_fail (name, n)) in
  63. let axiom1 = not (isEmpty (enqueue (42, empty ())))
  64. and axiom2 = isEmpty (empty ())
  65. and axiom3 = dequeue (enqueue (42, enqueue (69, empty ()))) =
  66. enqueue (42, dequeue (enqueue (69, empty ())))
  67. and axiom4 = dequeue (enqueue (42, empty ())) = empty ()
  68. and axiom5 = dequeue (empty ()) = empty ()
  69. and axiom6 = first (enqueue (42, enqueue (69, empty ()))) = first (enqueue (69, empty ()))
  70. and axiom7 = first (enqueue (42, empty ())) = 42
  71. in
  72. ( test 1 axiom1 ) &&
  73. ( test 2 axiom2 ) &&
  74. (*
  75.   *( test 3 axiom3 ) &&
  76.   *)
  77. ( test 4 axiom4 ) &&
  78. ( test 5 axiom5 ) &&
  79. ( test 6 axiom6 ) &&
  80. ( test 7 axiom7 )
  81.  
  82. let test_queuelist =
  83. test_queue QueueList.empty QueueList.enqueue QueueList.dequeue QueueList.first
  84. QueueList.isEmpty "QueueList"
  85. ;;
  86.  
  87. let test_queuetwolists =
  88. test_queue QueueTwoLists.empty QueueTwoLists.enqueue QueueTwoLists.dequeue QueueTwoLists.first
  89. QueueTwoLists.isEmpty "QueueTwoLists"
  90. ;;
  91.  
stdin
Standard input is empty
compilation info
File "prog.ml", line 65, characters 8-14:
Warning Y: unused variable axiom3.
File "prog.ml", line 50, characters 20-31:
Warning P: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
[]
stdout
Standard output is empty