Mercurial > repos > icfp2014
view code/ghc.lm @ 76:47eb447a74cc
Don't chase ghosts we can't catch
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Mon, 28 Jul 2014 02:57:56 -0700 |
parents | f1453e8970ca |
children |
line wrap: on
line source
#{ import: [ length reverse split:at map fold:with filter flatten ] from: (module: "ll.lm") import: [ makeTree:size makeTree filledTree _filledTree get:fromTree:size get:fromTree treeMap:size treeMap tree:size:update:with tree:update:with tree:set:to ] from: (module: "tree.lm") add8 <- :a b { a <- a + b if: a >= 256 { a <- a - 256 } else: {} a } sub8 <- :a b { a <- a - b if: a < 0 { a <- a + 256 } else: {} a } mul8 <- :a b { a <- a * b while: { a > 256 } do: { a <- a - 256 } a } and8 <- :a b { bit <- 128 out <- 0 while: { bit > 0 } do: { if: a >= bit { a <- a - bit if: b >= bit { b <- b - bit out <- out + bit } else: {} } else: { if: b >= bit { b <- b - bit } else: {} } bit <- bit / 2 } out } or8 <- :a b { bit <- 128 out <- 0 while: { bit > 0 } do: { if: a >= bit { a <- a - bit out <- out + bit if: b >= bit { b <- b - bit } else: {} } else: { if: b >= bit { b <- b - bit out <- out + bit } else: {} } bit <- bit / 2 } out } xor8 <- :a b { bit <- 128 out <- 0 while: { bit > 0 } do: { if: a >= bit { a <- a - bit if: b >= bit { b <- b - bit } else: { out <- out + bit } } else: { if: b >= bit { b <- b - bit out <- out + bit } else: {} } bit <- bit / 2 } out } makeCPU <- :code intHandler { a <- 0 b <- 0 c <- 0 d <- 0 e <- 0 f <- 0 g <- 0 h <- 0 dataMem <- filledTree: 0 256 getRegVal <- :regnum pc { if: regnum >= 4 { if: regnum >= 6 { if: regnum = 6 { regnum <- g } else: { if: regnum = 7 { regnum <- h } else: { regnum <- pc } } } else: { if: regnum = 4 { regnum <- e } else: { regnum <- f } } } else: { if: regnum >= 2 { if: regnum = 2 { regnum <- c } else: { regnum <- d } } else: { if: regnum { regnum <- b } else: { regnum <- a } } } regnum } getArg <- :arg pc { type <- arg value param <- arg tail if: type >= 2 { if: type = 3 { param <- get: param fromTree: dataMem } else: {} } else: { param <- getRegVal: param pc if: type { param <- get: param fromTree: dataMem } else: {} } param } setReg <- :regnum pc val { if: regnum >= 4 { if: regnum >= 6 { if: regnum = 6 { g <- val } else: { if: regnum = 7 { h <- val } else: { pc <- val } } } else: { if: regnum = 4 { e <- val } else: { f <- val } } } else: { if: regnum >= 2 { if: regnum = 2 { c <- val } else: { d <- val } } else: { if: regnum { b <- val } else: { a <- val } } } pc } saveDest <- :arg pc val { type <- arg value param <- arg tail if: type >= 2 { if: type = 3 { dataMem <- tree: dataMem set: param to: val } else: {} } else: { if: type { param <- getRegVal: param pc dataMem <- tree: dataMem set: param to: val } else: { pc <- setReg: param pc val } } pc } mov <- :args { dst <- args value src <- (args tail) value :pc { #[1 (saveDest: dst pc (getArg: src pc))] } } inc <- :args { dst <- args value :pc { #[1 (saveDest: dst pc (add8: (getArg: dst pc) 1))] } } dec <- :args { dst <- args value :pc { #[1 (saveDest: dst pc (sub8: (getArg: dst pc) 1))] } } add <- :args { dst <- args value src <- (args tail) value :pc { #[1 (saveDest: dst pc (add8: (getArg: dst pc) (getArg: src pc)))] } } sub <- :args { dst <- args value src <- (args tail) value :pc { #[1 (saveDest: dst pc (sub8: (getArg: dst pc) (getArg: src pc)))] } } mul <- :args { dst <- args value src <- (args tail) value :pc { #[1 (saveDest: dst pc (mul8: (getArg: dst pc) (getArg: src pc)))] } } div <- :args { dst <- args value src <- (args tail) value :pc { srcv <- getArg: src pc if: srcv = 0 { pc <- #[0 pc] } else: { pc <- #[1 (saveDest: dst pc (getArg: dst pc) / srcv)] } pc } } and <- :args { dst <- args value src <- (args tail) value :pc { #[1 (saveDest: dst pc (and8: (getArg: dst pc) (getArg: src pc)))] } } or <- :args { dst <- args value src <- (args tail) value :pc { #[1 (saveDest: dst pc (or8: (getArg: dst pc) (getArg: src pc)))] } } xor <- :args { dst <- args value src <- (args tail) value :pc { #[1 (saveDest: dst pc (xor8: (getArg: dst pc) (getArg: src pc)))] } } jlt <- :args { target <- args value x <- (args tail) value y <- ((args tail) tail) value :pc { if: x >= y { } else: { pc <- target } pc } } jeq <- :args { target <- args value x <- (args tail) value y <- ((args tail) tail) value :pc { if: x = y { pc <- target } else: { } pc } } jgt <- :args { target <- args value x <- (args tail) value y <- ((args tail) tail) value :pc { if: x > y { pc <- target } else: { } pc } } int <- :args { num <- args value :pc { iargs <- a if: num = 8 { iargs <- #[a b c d e f g h] } else: { if: num = 7 { iargs <- #[a b] } else: {} } intHandler: num iargs setReg pc } } hlt <- :pc { #[0 pc] } codeMem <- (fold: code #[(filledTree: hlt 256) 0] with: :acc inst { cmem <- acc value pc <- acc tail inum <- inst value args <- inst tail if: inum >= 7 { if: inum >= 11 { if: inum >= 13 { if: inum = 14 { inst <- hlt } else: { inst <- int: args } } else: { if: inum = 12 { inst <- jgt: args } else: { inst <- jeq: args } } } else: { if: inum >= 9 { if: inum = 10 { inst <- jlt: args } else: { inst <- xor: args } } else: { if: inum = 8 { inst <- or: args } else: { inst <- and: args } } } } else: { if: inum >= 3 { if: inum >= 5 { if: inum = 5 { inst <- mul: args } else: { inst <- div: args } } else: { if: inum = 3 { inst <- add: args } else: { inst <- sub: args } } } else: { if: inum = 2 { inst <- dec: args } else: { if: inum { inst <- inc: args } else: { inst <- mov: args } } } } #[(tree: cmem set: pc to: inst) pc + 1] }) value { cycle <- 0 pc <- 0 ret <- 0 run <- 1 while: { run } do: { ret <- get: pc fromTree: codeMem ret <- ret: pc run <- ret value if: (ret tail) = pc { pc <- pc + 1 } else: { pc <- ret tail } cycle <- cycle + 1 if: cycle >= 1024 { run <- 0 } else: {} } cycle } } main <- { cpu <- makeCPU: [ #[0 [#[0 0] #[2 31]]] //0 a <- 31 #[0 [#[0 1] #[2 45]]] //1 b <- 45 #[0 [#[0 2] #[2 57]]] //2 c <- 57 #[0 [#[0 3] #[2 127]]] //3 d <- 127 #[0 [#[0 4] #[2 128]]] //4 e <- 128 #[0 [#[0 5] #[2 254]]] //5 f <- 254 #[0 [#[0 6] #[2 255]]] //6 g <- 255 #[0 [#[0 7] #[2 3]]] //7 h <- 3 #[0 [#[3 0] #[2 45]]] //8 [0] <- 45 #[1 [#[0 0]]] //9 a <- a + 1 : 32 #[2 [#[0 1]]] //10 b <- b - 1 : 44 #[3 [#[0 2] #[0 3]]] //11 c <- c + d : 184 #[4 [#[0 4] #[0 5]]] //12 e <- e - f : 130 #[5 [#[0 6] #[0 7]]] //13 g <- g * h : 253 #[6 [#[3 0] #[0 0]]] //14 [0] <- [0] * a : 160 #[13 [8]] //15 #[14 []] //16 ] :num iargs setReg pc { print: #[num pc iargs] #[1 pc] } print: (add8: 2 3) print: (add8: 255 1) print: (add8: 129 128) print: (sub8: 4 2) print: (sub8: 2 4) print: (sub8: 0 255) print: (mul8: 255 255) print: (mul8: 255 2) print: (mul8: 3 5) print: (and8: 127 254) print: (and8: 3 5) print: (or8: 127 254) print: (or8: 3 5) print: (xor8: 127 254) print: (xor8: 3 5) print: (cpu: ) } }