Log in

No account? Create an account

Kevin Reid's blog

Hvm.hs: an exercise in Haskell golf


Kevin Reid
My Website

Hvm.hs: an exercise in Haskell golf

Previous Entry Share Next Entry
import Char
import Debug.Trace
import System.Environment
import Control.Monad.Fix

  By Kevin Reid, 2008-06-15

  This is an implementation of the virtual machine described at 
  <http://www.hacker.org/hvm/>. It was designed to fit into a single IRC line
  so that its definition could be put into lambdabot
  <http://www.haskell.org/haskellwiki/Lambdabot>, and its inspiration and
  creation was documented at <http://swhack.com/logs/2008-06-15>.

  Haskell source not in HTML: <http://switchb.org/kpreid/2008/Hvm.hs>
  Non-blog location: <http://switchb.org/kpreid/2008/Hvm.html>

  Explanation of variables:

    r = VM execution function of call stack, memory, instruction pointer, and 
        operand stack
    c = call stack
    m = memory
    i = instruction pointer
    j = instruction pointer plus one
    o = operand stack

    a = arithmetic handler
    h = proceed with instruction pointer and operation stack modification
    g = proceed with operand stack modification

    z:x = one value popped from operand stack
    z:w:e = two values popped from operand stack
    k:l = one value popped from call stack

    d, t: slice lists using z as length

  To make it fit in IRC, discard comments, imports, and "main", replace 
  all line breaks with semicolons as appropriate, and discard the ' ' and _ 
  cases (i.e. the interpreter will not support whitespace or report invalid 
    perl -0777 -pe 's/\A.*(?=^s)//ms; s/\s*main .*//; s/--.*$//mg;
                    s/\n */;/g; s/[;\s]*(where|let)[;\s]*/$1 /g;
                    s/;'\'' '\''->g o;_->error\$show\(p!!i\)//;'

s p=r[](fix(0:))0[]
   r c m i o=--trace (show (m,i,(if length p<=i then '!' else p !! i),(reverse o),c)) $
     let a(&)=g$w&z:e
         h=r c m
         g=h j
         t=take z
      in case(p++"!")!!i of
         'p'->show z++g x
         'P'->chr(mod z 128):g x
         d|isDigit d->g$ord d-48:o
         '/'->a div
         '?'->h(i+case w of 0->z;_->1)e
         'c'->r(j:c)m z x
         '$'->r l m k o
         '>'->r c(t m++w:d m)j e
         'v'->g$x!!z:t x++d x
         'd'->g x
         ' '->g o

main = do [p] <- getArgs; putStrLn $ s p
Powered by LiveJournal.com