Skip to content
This repository
tag: v1020
Fetching contributors…

Cannot retrieve contributors at this time

file 159 lines (150 sloc) 4.58 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
(** { cps tools } *)

type 'a continuation

module QmlCpsServerLib :
sig
  val uncps : ('b continuation -> unit) -> 'b
  val return : 'a continuation -> 'a -> unit
end =
struct
  let uncps _ = assert false
  let return _ = assert false
end

(* recurrence from uncps0 *)
module A :
sig
  val uncps : ('a continuation -> unit) -> 'a
  val uncps1 : ('a -> 'b continuation -> unit) -> 'a -> 'b
  val uncps2 :
    ('a -> ('b -> 'c continuation -> unit) continuation -> unit) ->
    'a -> 'b -> 'c
  val uncps3 :
    ('a ->
       ('b -> ('c -> 'd continuation -> unit) continuation -> unit)
         continuation -> unit) ->
    'a -> 'b -> 'c -> 'd
  val uncps4 :
    ('a ->
         ('b ->
            ('c -> ('d -> 'e continuation -> unit) continuation -> unit)
              continuation -> unit)
           continuation -> unit) ->
    'a -> 'b -> 'c -> 'd -> 'e
end =
struct
  let uncps = QmlCpsServerLib.uncps
  let uncps1 f x = uncps (f x)
  let uncps2 f x = uncps1 (uncps (f x))
  let uncps3 f x = uncps2 (uncps (f x))
  let uncps4 f x = uncps3 (uncps (f x))
end

(* recurrence from uncps1 *)
module B :
sig
  val uncps1 : ('a -> 'b continuation -> unit) -> 'a -> 'b
  val uncps2 :
    ('a -> ('b -> 'c continuation -> unit) continuation -> unit) ->
    'a -> 'b -> 'c
  val uncps3 :
    ('a ->
       ('b -> ('c -> 'd continuation -> unit) continuation -> unit)
         continuation -> unit) ->
    'a -> 'b -> 'c -> 'd
  val uncps4 :
    ('a ->
         ('b ->
            ('c -> ('d -> 'e continuation -> unit) continuation -> unit)
              continuation -> unit)
           continuation -> unit) ->
    'a -> 'b -> 'c -> 'd -> 'e
end =
struct
  let uncps1 = A.uncps1
  let uncps2 f x1 = uncps1 (uncps1 f x1)
  let uncps3 f x1 x2 = uncps1 (uncps2 f x1 x2)
  let uncps4 f x1 x2 x3 = uncps1 (uncps3 f x1 x2 x3)
end

(* in the other way *)
module C :
sig
  val cps0 : 'a -> 'a continuation -> unit
  val cps1 : ('a -> 'b) -> 'a -> 'b continuation -> unit
  val cps2 :
    ('a -> 'b -> 'c) ->
    'a -> ('b -> 'c continuation -> unit) continuation -> unit
  val cps3 :
    ('a -> 'b -> 'c -> 'd) ->
    'a ->
    ('b -> ('c -> 'd continuation -> unit) continuation -> unit)
      continuation -> unit
  val cps4 :
    ('a -> 'b -> 'c -> 'd -> 'e) ->
    'a ->
    ('b ->
       ('c -> ('d -> 'e continuation -> unit) continuation -> unit)
         continuation -> unit)
      continuation -> unit
end
=
struct
  let cps0 f k = QmlCpsServerLib.return k f
  let cps1 f x k = QmlCpsServerLib.return k (f x)
  let cps2 f x k = QmlCpsServerLib.return k (cps1 (f x))
  let cps3 f x k = QmlCpsServerLib.return k (cps2 (f x))
  let cps4 f x k = QmlCpsServerLib.return k (cps3 (f x))
end

(* NARY MODE *)

(* recursive definition *)
module D :
sig
  val uncps : ('a continuation -> unit) -> 'a
  val uncps1 : ('a -> 'b continuation -> unit) -> 'a -> 'b
  val uncps2 : ('a -> 'b -> 'c continuation -> unit) -> 'a -> 'b -> 'c
  val uncps3 : ('a -> 'b -> 'c -> 'd continuation -> unit) -> 'a -> 'b -> 'c -> 'd
  val uncps4 : ('a -> 'b -> 'c -> 'd -> 'e continuation -> unit) -> 'a -> 'b -> 'c -> 'd -> 'e
end =
struct
  let uncps = QmlCpsServerLib.uncps
  let uncps1 f a = uncps (f a)
  let uncps2 f a = uncps1 (f a)
  let uncps3 f a = uncps2 (f a)
  let uncps4 f a = uncps3 (f a)
end

(* expended definition *)
module E :
sig
  val uncps : ('a continuation -> unit) -> 'a
  val uncps1 : ('a -> 'b continuation -> unit) -> 'a -> 'b
  val uncps2 : ('a -> 'b -> 'c continuation -> unit) -> 'a -> 'b -> 'c
  val uncps3 : ('a -> 'b -> 'c -> 'd continuation -> unit) -> 'a -> 'b -> 'c -> 'd
  val uncps4 : ('a -> 'b -> 'c -> 'd -> 'e continuation -> unit) -> 'a -> 'b -> 'c -> 'd -> 'e
end =
struct
  let uncps = QmlCpsServerLib.uncps
  let uncps1 f a = uncps (f a)
  let uncps2 f a b = uncps (f a b)
  let uncps3 f a b c = uncps (f a b c)
  let uncps4 f a b c d = uncps (f a b c d)
end

(* in the other way *)
module C :
sig
  val cps0 : 'a -> 'a continuation -> unit
  val cps1 : ('a -> 'b) -> 'a -> 'b continuation -> unit
  val cps2 :
    ('a -> 'b -> 'c) ->
    ('a -> 'b -> 'c continuation -> unit)
  val cps3 :
    ('a -> 'b -> 'c -> 'd) ->
    ('a -> 'b -> 'c -> 'd continuation -> unit)
  val cps4 :
    ('a -> 'b -> 'c -> 'd -> 'e) ->
    ('a -> 'b -> 'c -> 'd -> 'e continuation -> unit)
end
=
struct
  let cps0 f k = QmlCpsServerLib.return k f
  let cps1 f x k = QmlCpsServerLib.return k (f x)
  let cps2 f x y k = QmlCpsServerLib.return k (f x y)
  let cps3 f x y z k = QmlCpsServerLib.return k (f x y z)
  let cps4 f x y z t k = QmlCpsServerLib.return k (f x y z t)
end
Something went wrong with that request. Please try again.