Mercurial > repos > icfp2013
view src/bv.tp @ 30:a4bffcd381cd
eval(id) request fixed. Fail gracefully on non-200 http response.
author | William Morgan <bill@mrgn.org> |
---|---|
date | Sat, 10 Aug 2013 20:30:05 -0700 |
parents | 6384e577842d |
children | b00904b36aca |
line wrap: on
line source
{ #{ program <- { _input <- 0u64 _acc <- 0u64 _val <- 0u64 _zero <- #{ string <- { "0" } eval <- { 0u64 } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } } _one <- #{ string <- { "1" } eval <- { 1u64 } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } } _inputNode <- #{ string <- { "input" } eval <- { _input } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } } _accNode <- #{ string <- { "acc" } eval <- { _acc } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } } _valNode <- #{ string <- { "val" } eval <- { _val } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } } _opPlus <- 1 _opAnd <- 2 _opOr <- 4 _opXor <- 8 _opNot <- 0x10 _opShl1 <- 0x20 _opShr1 <- 0x40 _opShr4 <- 0x80 _opShr16 <- 0x100 _opIf0 <- 0x200 _opFold <- 0x400 _opTfold <- 0x800 _maskRemoveFold <- 0x3FF _names <- dict linear _names set: "plus" _opPlus _names set: "and" _opAnd _names set: "xor" _opXor _names set: "or" _opOr _names set: "not" _opNot _names set: "shl1" _opShl1 _names set: "shr1" _opShr1 _names set: "shr4" _opShr4 _names set: "shr16" _opShr16 _names set: "if0" _opIf0 _names set: "fold" _opFold _names set: "tfold" _opTfold _memo <- #[] _memoFoldBody <- #[] _memoFoldParam <- #[] #{ plus <- :left right { #{ string <- { "(plus " . (string: left) . " " . (string: right) . ")" } eval <- { (eval: left) + (eval: right)} operators <- { _opPlus or (left operators) or (right operators)} isTfold? <- { false } isTerminal? <- { false } } } zero <- { _zero } one <- { _one } opAnd <- :left right { #{ string <- { "(and " . (string: left) . " " . (string: right) . ")" } eval <- { (eval: left) and (eval: right)} operators <- { _opAnd or (left operators) or (right operators)} isTfold? <- { false } isTerminal? <- { false } } } opOr <- :left right { #{ string <- { "(or " . (string: left) . " " . (string: right) . ")" } eval <- { (eval: left) or (eval: right)} operators <- { _opOr or (left operators) or (right operators)} isTfold? <- { false } isTerminal? <- { false } } } opXor <- :left right { #{ string <- { "(xor " . (string: left) . " " . (string: right) . ")" } eval <- { (eval: left) xor (eval: right)} operators <- { _opXor or (left operators) or (right operators)} isTfold? <- { false } isTerminal? <- { false } } } opNot <- :exp { #{ string <- { "(not " . (string: exp) . ")" } eval <- { (eval: exp) xor -1u64 } operators <- { _opNot or (exp operators)} isTfold? <- { false } isTerminal? <- { false } } } shl1 <- :exp { #{ string <- { "(shl1 " . (string: exp) . ")" } eval <- { lshift: (eval: exp) by: 1u64 } operators <- { _opShl1 or (exp operators)} isTfold? <- { false } isTerminal? <- { false } } } shr1 <- :exp { #{ string <- { "(shr1 " . (string: exp) . ")" } eval <- { rshift: (eval: exp) by: 1u64 } operators <- { _opShr1 or (exp operators)} isTfold? <- { false } isTerminal? <- { false } } } shr4 <- :exp { #{ string <- { "(shr4 " . (string: exp) . ")" } eval <- { rshift: (eval: exp) by: 4u64 } operators <- { _opShr4 or (exp operators)} isTfold? <- { false } isTerminal? <- { false } } } shr16 <- :exp { #{ string <- { "(shr16 " . (string: exp) . ")" } eval <- { rshift: (eval: exp) by: 16u64 } operators <- { _opShr16 or (exp operators)} isTfold? <- { false } isTerminal? <- { false } } } input <- { _inputNode } acc <- { _accNode } val <- { _valNode } if0:then:else <- :exp ifzero :ifnotzero { #{ string <- { "(if0 " . (string: exp) . " " . (string: ifzero) . " " . (string: ifnotzero) . ")" } eval <- { if: (eval: exp) = 0u64 { eval: ifzero } else: { eval: ifnotzero } } operators <- { _opIf0 or (exp operators) or (ifzero operators) or (ifnotzero operators)} isTfold? <- { false } isTerminal? <- { false } } } fold:with:startingAt <- :toFold :fun :startAcc { #{ string <- { "(fold " . (string: toFold) . " " . (string: startAcc) . " (lambda (val acc) " . (string: fun) . "))" } eval <- { _acc <- (eval: startAcc) source <- (eval: toFold) //parser doesn''t currently like vertical whitespace in arays so //this needs to be on a single line until that bug is fixed vals <- #[source and 255u64 (rshift: source by: 8u64) and 255u64 (rshift: source by: 16u64) and 255u64 (rshift: source by: 24u64) and 255u64 (rshift: source by: 32u64) and 255u64 (rshift: source by: 40u64) and 255u64 (rshift: source by: 48u64) and 255u64 (rshift: source by: 56u64) and 255u64] foreach: vals :idx cur { _val <- cur _acc <- (eval: fun) } _acc } operators <- { _opFold or (toFold operators) or (fun operators) or (startAcc operators) } isTfold? <- { (toFold isTerminal?) && (startAcc isTerminal?) && (toFold string) = "input" && (startAcc string) = "0" } isTerminal? <- { false } } } run <- :in { _input <- in eval: root } root <- _zero string <- { "(lambda (input) " . (string: root) . ")" } gentestprog <- { root <- if0: (opAnd: input one) then: ( plus: (opOr: input (shl1: one)) ) else: ( opXor: input (shr16: input) ) self } exampleprog <- { root <- fold: input with: (opOr: val acc) startingAt: zero self } //TODO: memoize this to improve runtime for large n allOfSize:inFold? <- :n :infold? { memo <- if: infold? = 2 { _memoFoldBody } else: { if: infold? = 1 && n > 4 { _memoFoldParam } else: { _memo } } if: n - 1 < (memo length) { print: "Memo hit: " . (string: n) . "\n" memo get: (n - 1) } else: { if: n = 1 { res <- #[one zero input] if: infold? = 2 { res append: acc res append: val } print: "Saving at memo index: " . (string: (memo length)) . "\n" memo append: res res } else: { res <- #[] foreach: (allOfSize: n - 1 inFold?: infold?) :idx exp { res append: (opNot: exp) res append: (shl1: exp) res append: (shr1: exp) res append: (shr4: exp) res append: (shr16: exp) } if: n > 2 { numLeft <- 1 argTotal <- n - 1 while: { numLeft < argTotal } do: { numRight <- argTotal - numLeft choicesRight <- (allOfSize: numRight inFold?: infold?) foreach: (allOfSize: numLeft inFold?: infold?) :idx leftExp { foreach: choicesRight :idx rightExp { res append: (opAnd: leftExp rightExp) res append: (opOr: leftExp rightExp) res append: (opXor: leftExp rightExp) res append: (plus: leftExp rightExp) } } numLeft <- numLeft + 1 } if: n > 3 { numLeft <- 1 limitLeft <- n - 2 while: { numLeft < limitLeft } do: { numMid <- 1 limitMid <- n - (1 + numLeft) while: { numMid < limitMid } do: { numRight <- n - (1 + numLeft + numMid) choicesRight <- (allOfSize: numRight inFold?: infold?) choicesMid <- (allOfSize: numMid inFold?: infold?) foreach: (allOfSize: numLeft inFold?: infold?) :idx leftExp { foreach: choicesMid :idx midExp { foreach: choicesRight :idx rightExp { res append: (if0: leftExp then: midExp else: rightExp) } } } numMid <- numMid + 1 } numLeft <- numLeft + 1 } if: n > 4 && infold? = 0 { numSeq <- 1 limitSeq <- n - 3 while: { numSeq < limitSeq } do: { numFun <- 1 limitFun <- n - (2 + numSeq) while: { numFun < limitFun } do: { numStart <- n - (2 + numSeq + numFun) choicesStart <- (allOfSize: numStart inFold?: 1) choicesFun <- (allOfSize: numFun inFold?: 2) foreach: (allOfSize: numSeq inFold?: 1) :idx seqExp { foreach: choicesFun :idx funExp { foreach: choicesStart :idx startExp { res append: (fold: seqExp with: funExp startingAt: startExp) } } } numFun <- numFun + 1 } numSeq <- numSeq + 1 } } } } print: "Saving " . (string: n) . " at memo index: " . (string: (memo length)) . "\n" memo append: res res } } } allOfSize <- :n { allOfSize: (n - 1) inFold?: 0 } filterTrees <- :trees strops { filtered <- #[] ops <- strops fold: 0 with: :acc el { acc or (_names get: el withDefault: 0) } if: (ops and _opTfold) > 0 { foreach: trees :idx tree { if: (tree isTfold?) { if: (tree operators) and _maskRemoveFold = ops and _maskRemoveFold { filtered append: tree } } } } else: { foreach: trees :idx tree { if: (tree operators) = ops { filtered append: tree } } } filtered } } } test <- :prog { print: (string: prog) . "\n" print: "Operators: " . (hex: ((prog root) operators)) . "\n" if: ((prog root) isTfold?) { print: "TFold!\n" } //parser doesn''t currently like vertical whitespace in arays so //this needs to be on a single line until that bug is fixed vals <- #[0u64 1u64 2u64 3u64 4u64 5u64 6u64 7u64 8u64 9u64 10u64 11u64 12u64 13u64 14u64 15u64 0x30001u64 0x50015u64 (lshift: 0x11223344u64 by: 32u64) or 0x55667788u64] foreach: vals :idx val { print: "p(0x" . (hex: val) . ") = 0x" . (hex: (prog run: val)) . "\n" } } main <- :args { //test: (program gentestprog) //test: (program exampleprog) size <- 3 if: (args length) > 1 { size <- int32: (args get: 1) } if: size >= 2 { prog <- program trees <- (prog allOfSize: size) if: (args length) > 2 { ops <- (args get: 2) splitOn: "," trees <- prog filterTrees: trees ops } foreach: trees :idx tree { prog root! tree test: prog } } 0 } } }