First test work commit, don't touch

test/contracts/reason/rte.re

@@ -0,0 +1,60 @@
+
+/* Primitive types */
+type address     = string;
+type uint        = int;
+exception Abort;
+
+type env =
+  { mutable _caller : address
+  };
+
+let env = { _caller: "" };
+
+/* Builtin functions */
+let caller() : address = env._caller;
+let abort() = raise(Abort);
+
+let call(who, fn) = {
+  env._caller = who;
+  let res = try(fn()) { | e => env._caller = ""; raise(e) };
+  env._caller = "";
+  res
+};
+
+/* Library functions */
+let require(x) = x ? () : abort();
+
+/* -- Managing contract state ------------------------------------------------ */
+
+type state_rep('s) = { mutable state : option('s) };
+
+let newStateRep() : state_rep('s) = { state: None };
+
+exception UninitializedState;
+exception ReinitializedState;
+
+let getState(rep) =
+  switch(rep.state) {
+  | None => raise(UninitializedState)
+  | Some(s) => s
+  };
+
+let setState(rep, s) =
+  switch(rep.state) {
+  | None    => rep.state = Some(s)
+  | Some(_) => raise(ReinitializedState)
+  };
+
+module type Contract = {
+  type state;
+  type args;
+  let init : args => state;
+  let stateRep : state_rep(state);
+};
+
+module Setup = (C : Contract) => {
+  let init(creator, args) =
+    setState(C.stateRep, call(creator, () => C.init(args)));
+  let reset() = C.stateRep.state = None;
+};
+

test/contracts/reason/voting.re

@@ -0,0 +1,126 @@
+
+open Rte;
+
+/* Contract type */
+module type Voting = {
+  type state;
+  type args = list(string);
+  let stateRep : state_rep(state);
+
+  let init            : args => state;
+  let giveRightToVote : address => unit;
+  let delegate        : address => unit;
+  let vote            : int => unit;
+  let winnerName      : unit => string;
+  let currentTally    : unit => list((string, int));
+};
+
+/* Contract implementation */
+module Voting : Voting = {
+
+  /* Not so nice */
+  module AddrKey = { type t = address; let compare = Pervasives.compare };
+  module AddrMap = Map.Make(AddrKey);
+  type addr_map('a) = AddrMap.t('a);
+
+  /* Types */
+
+  type proposal =
+    { name: string
+    , mutable voteCount: uint
+    };
+
+  type voter =
+    { mutable weight: int
+    , mutable delegate: option(address)
+    , mutable vote: option(int)
+    };
+
+  type state =
+    { chairPerson: address
+    , mutable voters: addr_map(voter)
+    , proposals: list(proposal)
+    };
+
+  /* Initialization */
+  type args = list(string);
+  let init(proposalNames: args): state =
+    { chairPerson: caller(),
+      voters:      AddrMap.empty,
+      proposals:   List.map((name) => {name: name, voteCount: 0}, proposalNames)
+    };
+
+  /* Boilerplate */
+  let stateRep = newStateRep();
+  let state()  = getState(stateRep);
+
+  let initVoter() = { weight: 1, delegate: None, vote: None };
+
+  let giveRightToVote(voter: address) = {
+    require(caller() == state().chairPerson);
+    require(!AddrMap.mem(voter, state().voters));
+    state().voters = AddrMap.add(voter, initVoter(), state().voters);
+    ()
+  };
+
+  let rec delegateChain(delegate: address) = {
+    require(delegate != caller()); /* Delegation loop! */
+    let voter = AddrMap.find(delegate, state().voters);
+    switch(voter.delegate) {
+    | None    => delegate;
+    | Some(d) => delegateChain(d)
+    }
+  };
+
+  let addVote(candidate, weight) = {
+    let proposal = List.nth(state().proposals, candidate);
+    proposal.voteCount = proposal.voteCount + weight;
+  };
+
+  let delegateVote(delegateTo: address, weight: uint) = {
+    let voter = AddrMap.find(delegateTo, state().voters);
+    switch(voter.vote) {
+    | Some(vote) => addVote(vote, weight)
+    | None => voter.weight = voter.weight + weight
+    }
+  };
+
+  let delegate(delegateTo: address) = {
+    require(delegateTo != caller());
+    let voter = AddrMap.find(caller(), state().voters);
+    require(voter.vote == None);
+    let finalDelegate = delegateChain(delegateTo);
+    voter.vote = Some(0); /* Hm... */
+    voter.delegate = Some(finalDelegate);
+    delegateVote(finalDelegate, voter.weight)
+  };
+
+  let vote(candidate: uint) = {
+    let voter = AddrMap.find(caller(), state().voters);
+    require(voter.vote == None);
+    voter.vote = Some(candidate);
+    addVote(candidate, voter.weight);
+  };
+
+  let rec winningProposal'(current, rest) =
+    switch(rest) {
+    | []         => current;
+    | [p, ...ps] => winningProposal'(p.voteCount > current.voteCount ? p : current, ps)
+    };
+
+  /* const */
+  let winningProposal() : proposal = {
+    switch(state().proposals) {
+    | [] => abort()
+    | [p, ...ps] => winningProposal'(p, ps)
+    }
+  };
+
+  /* const */
+  let winnerName() = winningProposal().name;
+
+  /* const */
+  let currentTally() =
+    List.map((p) => (p.name, p.voteCount), state().proposals);
+
+}

test/contracts/reason/voting_test.re

@@ -0,0 +1,42 @@
+
+open Rte;
+open Voting;
+
+let creator = "0x123";
+let voter1  = "0x1001";
+let voter2  = "0x1002";
+let voter3  = "0x1003";
+let other   = "0xffff";
+
+module SetupVote = Setup(Voting);
+open Voting;
+
+let print_tally() = {
+  let tally = call(other, () => currentTally());
+  List.map(((name, count)) => Printf.printf("%s: %d\n", name, count), tally);
+  let winner = call(other, () => winnerName());
+  Printf.printf("Winner: %s\n", winner);
+};
+
+Printf.printf("Delegate before vote\n");
+SetupVote.init(creator, ["Cake", "Beer"]);
+call(creator, () => giveRightToVote(voter1));
+call(creator, () => giveRightToVote(voter2));
+call(creator, () => giveRightToVote(voter3));
+call(voter3,  () => delegate(voter1));
+call(voter1,  () => vote(1));
+call(voter2,  () => vote(0));
+print_tally();
+
+SetupVote.reset();
+
+Printf.printf("Delegate after vote\n");
+SetupVote.init(creator, ["Cake", "Beer"]);
+call(creator, () => giveRightToVote(voter1));
+call(creator, () => giveRightToVote(voter2));
+call(creator, () => giveRightToVote(voter3));
+call(voter1,  () => vote(1));
+call(voter3,  () => delegate(voter1));
+call(voter2,  () => vote(0));
+print_tally();
+