setup.sw

def elif = \t. \then. \else. {if t then else} end
def else = \t. t end

// modulus function (%)
def mod : int -> int -> int = \i. \m.
  i - m * (i / m)
end

def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;

def until = \p. \c. q <- p; if q {} {c; until p c} end;
def while = \p. until (x <- p; return $ not x) end;

def isDivisibleBy = \dividend. \divisor.
    (dividend / divisor) * divisor == dividend;
    end;

def isEven = \x.
   isDivisibleBy x 2
   end;

/**
Performs a right bitshift of "x" by "n" places
*/
def shiftRight = \x. \n.
    x / (2^n);
    end;

/**
Performs a left bitshift of "x" by "n" places
*/
def shiftLeft = \x. \n.
    x * (2^n);
    end;

/**
Checks whether the bit at index "idx" is set in the "bitmask".
zero-based indexing; 0 is the LSB.
*/
def isBitSet = \bitmask. \idx.
    not $ isEven $ shiftRight bitmask idx;
    end;

/**
Tests whether only a single bit is set in the bitmask.
Aborts early with 'false' if a second bit is detected.
*/
def exactlyOneBit = \foundOneBit. \bitmask.
    if (bitmask == 0) {
      foundOneBit;
    } {
      let bitIsSet = not $ isEven bitmask in
      if (foundOneBit && bitIsSet) {
        false;
      } {
        exactlyOneBit (foundOneBit || bitIsSet) $ bitmask / 2;
      }
    }
    end;

/** Teleports to a new location to execute a function
  then returns to the original location before
  returning the functions output value.
*/
def atLocation = \newLoc. \f.
    prevLoc <- whereami;
    teleport self newLoc;
    retval <- f;
    teleport self prevLoc;
    return retval;
    end;

def placeSand =
    let item = "sand" in
    create item;
    place item;
    move;
    end;

/**
Repeatedly generate a random number until
we find one that's not in the bitmask.
*/
def getUnusedRandom = \maxval. \bitmask.
    nextRandomVal <- random maxval;
    if (isBitSet bitmask nextRandomVal) {
        getUnusedRandom maxval bitmask;
    } {
        return nextRandomVal;
    }
    end;

def getEntName = \idx.
    if (idx == 1) {
        "grape"
    } $ elif (idx == 2) {
        "lemon"
    } $ elif (idx == 3) {
        "apple"
    } $ elif (idx == 4) {
        "blueberry"
    } $ elif (idx == 5) {
        "watermelon"
    } $ elif (idx == 6) {
        "orange"
    } $ else {
        "dragonfruit"
    }
    end;

def getMissingBitRecursive = \bitmask. \idx.
    if (idx > 0) {
        if (isEven bitmask) {
            idx
        } {
            getMissingBitRecursive (bitmask / 2) $ idx - 1;
        }
    } {
        // The MSB was the missing bit.
        0;
    }
    end;

/**
Returns the index of the right-most bit that is zero.
*/
def getMissingBit = \bitmask. \maxIdx.
    let val = getMissingBitRecursive bitmask maxIdx in
    maxIdx - val;
    end;

/**
Use the `random` function to generate a random permuation of `n` contiguous values.
Uses a bitmask to ensure uniqueness.

Fisher-Yates would be more efficient, but requires a physical array.
*/
def naiveRandomStack = \valueFunc. \maxval. \bitmask. \n.
    val <- if (n > 1) {
        nextRandomVal <- getUnusedRandom maxval bitmask;

        // Recursion bug workaround (see #1032):
        let blahNextRandomVal = nextRandomVal in

        let newBitmask = bitmask + shiftLeft 1 nextRandomVal in
        naiveRandomStack valueFunc maxval newBitmask $ n - 1;
        return blahNextRandomVal;
    } {
        // We're at the peak of the stack.
        // Now we unwind it.

        // Saves some time in generating the last number by inferring the
        // only remaining possible choice.
        let missingBit = getMissingBit bitmask maxval in
        return missingBit;
    };
    valueFunc val;
    end;

def placeThing = \entIdx.
    let entName = getEntName entIdx in
    create entName;
    place entName;
    end;

def placeEntsForBits = \bitmask. \bitIndex.
    if (isBitSet bitmask bitIndex) {
        placeThing bitIndex;
        move;
    } {};
    end;

def columnFunc = \exclusionValue. \inputCardinality. \x.
    if (x != 0 && x != exclusionValue && not (exactlyOneBit false x)) {
        naiveRandomStack (placeEntsForBits x) inputCardinality 0 inputCardinality;
        myloc <- whereami;
        teleport self (fst myloc + 1, 0);
    } {};
    end;

def makeSandRow = \length.
    turn east;
    atLocation (0, -1) $ doN length placeSand;
    end;

def chooseExclusionValue = \powersetCardinality.

    // For cardinality 32, for example, the value of "r"
    // will be between 0 and 30, inclusive.
    r <- random $ powersetCardinality - 1;

    // We offset by one so as not to exclude zero.
    // So the exclusion value is now between
    // 1 and 31, inclusive.
    let value = r + 1 in

    if (exactlyOneBit false value) {
      chooseExclusionValue powersetCardinality;
    } {
      return value;
    }
    end;

/**
"inputCardinality" is the number of distinct entities
*/
def setup = \inputCardinality.
    let powersetCardinality = 2^inputCardinality in
    makeSandRow $ powersetCardinality - (1 + inputCardinality);

    turn north;
    move;
    exclusionValue <- chooseExclusionValue powersetCardinality;
    naiveRandomStack (columnFunc exclusionValue inputCardinality) powersetCardinality 0 powersetCardinality;
    return exclusionValue;
    end;

/**
One-based ordinal of the item.
*/
def getOrdinal : text -> cmd int = \item.
    count item;
    end;

def checkSolutionSum = \runningSum.
    maybeItem <- scan down;
    case maybeItem (\_. return runningSum) (\item.
        // The bell is the only other item we can place in this
        // scenario besides the fruits.
        if (item != "bell") {
            theOrdinal <- getOrdinal item;
            let binaryValue = shiftLeft 1 $ theOrdinal - 1 in
            move;
            checkSolutionSum $ binaryValue + runningSum;
        } {return runningSum};
    );
    end;

def waitForFirstPlacement =
    watch down;
    wait 1000;
    emptyhere <- isempty;
    if emptyhere {waitForFirstPlacement} {};
    end;

def go = \distinctCount.
    exclusionValue <- instant $ setup distinctCount;
    give base "bell";

    waitForFirstPlacement;
    while (as base {has "bell"}) $ wait 2;
    theSum <- checkSolutionSum 0;
    let sentinelItem = if (exclusionValue == theSum) {"bit (1)"} {"bit (0)"} in
    create sentinelItem;
    end;

go 7;