Mercurial > repos > icfp2013
view src/bv.tp @ 50:f4399a22a704
Fix crash from calling srand during module initialization
author | Mike Pavone <pavone@retrodev.com> |
---|---|
date | Sun, 11 Aug 2013 05:54:42 -0700 |
parents | 96b2fcb746bf |
children | 0f8adc187d29 f864792a1b17 |
line wrap: on
line source
{ #{ program <- { _input <- 0u64 _acc <- 0u64 _val <- 0u64 _zero <- #{ string <- { "0" } eval <- { 0u64 } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } constant? <- { true } } _accInputNode <- _zero _foldInputNode <- _zero _one <- #{ string <- { "1" } eval <- { 1u64 } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } constant? <- { true } } _inputNode <- #{ string <- { "input" } eval <- { _input } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } constant? <- { false } } _accNode <- #{ string <- { "acc" } eval <- { _acc } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } constant? <- { _accInputNode constant? } } _valNode <- #{ string <- { "val" } eval <- { _val } operators <- { 0 } isTfold? <- { false } isTerminal? <- { true } constant? <- { _foldInputNode constant? } } _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 } constant? <- { (left constant?) && (right constant?) } } } 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 } constant? <- { if: (left constant?) { if: (right constant?) { true } else: { if: (string: left) = "0" { true } else: { false } } } else: { if: (right constant?) { if: (string: right) = "0" { true } else: { false } } else: { 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 } constant? <- { (left constant?) && (right constant?) } } } 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 } constant? <- { if: (left constant?) && (right constant?) { true } else: { (string: left) = (string: right) } } } } opNot <- :exp { #{ string <- { "(not " . (string: exp) . ")" } eval <- { (eval: exp) xor -1u64 } operators <- { _opNot or (exp operators)} isTfold? <- { false } isTerminal? <- { false } constant? <- { exp constant? } } } shl1 <- :exp { #{ string <- { "(shl1 " . (string: exp) . ")" } eval <- { lshift: (eval: exp) by: 1u64 } operators <- { _opShl1 or (exp operators)} isTfold? <- { false } isTerminal? <- { false } constant? <- { exp constant? } } } shr1 <- :exp { #{ string <- { "(shr1 " . (string: exp) . ")" } eval <- { rshift: (eval: exp) by: 1u64 } operators <- { _opShr1 or (exp operators)} isTfold? <- { false } isTerminal? <- { false } constant? <- { exp constant? } } } shr4 <- :exp { #{ string <- { "(shr4 " . (string: exp) . ")" } eval <- { rshift: (eval: exp) by: 4u64 } operators <- { _opShr4 or (exp operators)} isTfold? <- { false } isTerminal? <- { false } constant? <- { exp constant? } } } shr16 <- :exp { #{ string <- { "(shr16 " . (string: exp) . ")" } eval <- { rshift: (eval: exp) by: 16u64 } operators <- { _opShr16 or (exp operators)} isTfold? <- { false } isTerminal? <- { false } constant? <- { exp constant? } } } 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 } constant? <- { (exp constant?) && (ifzero constant?) && (ifnotzero constant?) } } } 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 } constant? <- { _accInputNode <- startAcc _foldInputNode <- toFold fun constant? } } } 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 } allOfSize:inFold?:withOps <- :n :infold? :ops { if: n = 1 { res <- #[one zero input] if: infold? = 2 { res append: acc res append: val } res } else: { res <- #[] origops <- ops if: (ops and _opTfold) > 0 { ops <- ops and _maskRemoveFold } if: (ops and (_opNot or _opShl1 or _opShr1 or _opShr4 or _opShr16)) > 0 { foreach: (allOfSize: n - 1 inFold?: infold? withOps: ops) :idx exp { if: (ops and _opNot) > 0 { res append: (opNot: exp) } if: (ops and _opShl1) > 0 { res append: (shl1: exp) } if: (ops and _opShr1) > 0 { res append: (shr1: exp) } if: (ops and _opShr4) > 0 { res append: (shr4: exp) } if: (ops and _opShr16) > 0 { res append: (shr16: exp) } } } if: n > 2 { numLeft <- 1 argTotal <- n - 1 if: (ops and (_opAnd or _opOr or _opXor or _opPlus)) > 0 { while: { numLeft < argTotal } do: { numRight <- argTotal - numLeft choicesRight <- (allOfSize: numRight inFold?: infold? withOps: ops) foreach: (allOfSize: numLeft inFold?: infold? withOps: ops) :idx leftExp { foreach: choicesRight :idx rightExp { if: (ops and _opAnd) > 0 { res append: (opAnd: leftExp rightExp) } if: (ops and _opOr) > 0 { res append: (opOr: leftExp rightExp) } if: (ops and _opXor) > 0 { res append: (opXor: leftExp rightExp) } if: (ops and _opPlus) > 0 { res append: (plus: leftExp rightExp) } } } numLeft <- numLeft + 1 } } if: n > 3 { numLeft <- 1 limitLeft <- n - 2 if: (ops and _opIf0) > 0 { while: { numLeft < limitLeft } do: { numMid <- 1 limitMid <- n - (1 + numLeft) while: { numMid < limitMid } do: { numRight <- n - (1 + numLeft + numMid) choicesRight <- (allOfSize: numRight inFold?: infold? withOps: ops) choicesMid <- (allOfSize: numMid inFold?: infold? withOps: ops) foreach: (allOfSize: numLeft inFold?: infold? withOps: ops ) :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 && (origops and (_opFold or _opTfold)) > 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 withOps: ops) choicesFun <- (allOfSize: numFun inFold?: 2 withOps: ops) foreach: (allOfSize: numSeq inFold?: 1 withOps: ops) :idx seqExp { foreach: choicesFun :idx funExp { foreach: choicesStart :idx startExp { if: (origops and _opFold) > 0 { res append: (fold: seqExp with: funExp startingAt: startExp) } else: { mtf <- fold: seqExp with: funExp startingAt: startExp if: (mtf isTfold?) { res append: mtf } } } } } numFun <- numFun + 1 } numSeq <- numSeq + 1 } } } } res } } allOfSize:withOps <- :size strops { ops <- strops fold: 0 with: :acc el { acc or (_names get: el withDefault: 0) } allOfSize: size inFold?: 0 withOps: ops } 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 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 ops <- #[] if: (args length) > 2 { ops <- (args get: 2) splitOn: "," } trees <- #[] if: (ops length) > 0 { if: size < 9 { trees <- (prog allOfSize: size) trees <- prog filterTrees: trees ops } else: { trees <- (prog allOfSize: size withOps: ops) } } else: { trees <- (prog allOfSize: size) } foreach: trees :idx tree { prog root! tree test: prog } } 0 } } }