Friday, July 31, 2009

A month ago, I posted some obfuscated code. It's an Unlambda interpreter. Implemented in 45 lines of code in a language in which the only data type is a list of bits and the only operations are list concatenation and pattern matching.

Here is the code with comments and meaningful identifiers.

== unlambda 2 interpreter

unl2 input code = eval parse code _ _ _ _ input.

==============================================

== bit list utilities

drop 0x 0y = drop x y.
drop 0x 1y = drop x y.
drop 1x 0y = drop x y.
drop 1x 1y = drop x y.
drop _ y = y.

take 0x 0y = 0 take x y.
take 0x 1y = 1 take x y.
take . . = _.

concat x y = x y.

==============================================

== list processing
== 00 - 8 bits of data follow
== 01 - start sublist
== 11 - end sublist

car data = /car data _.
/car _ _ = _.
/car 00data _ = 00 take 00000000 data.
/car 00data nesting = 00 take 00000000 data /car drop 00000000 data nesting.
/car 01data nesting = 01 /car data concat 0 nesting.
/car 11. _ = _.
/car 11. 0_ = 11.
/car 11data 0nesting = 11 /car data nesting.

cdr data = drop car data data.

unlist 01data = /unlist data.
/unlist 11_ = _.
/unlist data = car data /unlist cdr data.

==============================================

parse _ = _.

== whitespace
parse 00100000input = parse input.
parse 00001001input = parse input.
parse 00001010input = parse input.
parse 00001101input = parse input.

== comment
parse 00100011input = strip-comment input.

strip-comment _ = _.
strip-comment 00001010input = parse input.
strip-comment input = strip-comment drop 00000000 input.

== `
parse 01100000input = 00 01100000 parse input.

== k
parse 01101011input = 00 01101011 parse input.

== s
parse 01110011input = 00 01110011 parse input.

== i
parse 01101001input = 00 01101001 parse input.

== v
parse 01110110input = 00 01110110 parse input.

== c
parse 01100011input = 00 01100011 parse input.

== d
parse 01100100input = 00 01100100 parse input.

== r
parse 01110010input = 01 00 00101110 00 00001010 11 parse input.

== .c
parse 00101110input = 01 00 00101110 00 take 00000000 input 11 parse drop 00000000 input.

== e
parse 01100101input = 00 01100101 parse input.

== @
parse 01000000input = 00 01000000 parse input.

== ?c
parse 00111111input = 01 00 00111111 00 take 00000000 input 11 parse drop 00000000 input.

== |
parse 01111100input = 00 01111100 parse input.

== ignore unrecognized characters
parse input = parse drop 00000000 input.

==============================================

first-expr _ . = _.
first-expr . _ = _.
first-expr nest 00 01100000code = 00 01100000 first-expr concat 0 nest code.
first-expr 0nest 01 00 00101110 00 code = 01 00 00101110 00 take 0000000000 code first-expr nest drop 0000000000 code.
first-expr 0nest 01 00 00111111 00 code = 01 00 00111111 00 take 0000000000 code first-expr nest drop 0000000000 code.
first-expr 0nest code = take 0000000000 code first-expr nest drop 0000000000 code.

==============================================

== eval: end of code
eval _ . . _ . . = _.

== eval: delay
== stack was: d apply REST
== stack becomes: `dF REST
== `dF is: (D (F))
eval code 00 01100100. 00 01100000. stack-rest current-char input = eval drop first-expr 0 code code concat 01 00 01000100 01 concat first-expr 0 code 11 11 car stack-rest cdr stack-rest current-char input.

== eval
== stack was: apply REST
eval code 00 01100000. stack-second stack-rest current-char input = eval cdr code car code 00 01100000 concat stack-second stack-rest current-char input.

== eval
== stack was: X apply REST
eval code stack-first 00 01100000. stack-rest current-char input = eval cdr code car code stack-first concat 00 01100000 stack-rest current-char input.

== eval: apply
== stack was: X Y apply REST
eval code stack-first stack-second 00 01100000stack-rest current-char input = apply code stack-first stack-second stack-rest current-char input.

== eval
eval code stack-first stack-second stack-rest current-char input = eval cdr code car code stack-first concat stack-second stack-rest current-char input.

==============================================

== apply: k
== stack was: X k apply REST
== stack becomes: `kX REST
== `kX is: (K X)
apply code stack-first 00 01101011. stack-rest current-char input = eval code concat 01 00 01001011 concat stack-first 11 car stack-rest cdr stack-rest current-char input.

== apply: `kX = (K X)
== stack was: Y `kX apply REST
== stack becomes: X REST
apply code . 01 00 01001011stack-second stack-rest current-char input = eval code car stack-second car stack-rest cdr stack-rest current-char input.

== apply: s
== stack was: X s apply REST
== stack becomes: `sX REST
== `sX is: (S X)
apply code stack-first 00 01110011. stack-rest current-char input = eval code concat 01 00 01010011 concat stack-first 11 car stack-rest cdr stack-rest current-char input.

== apply: `sX = (S X)
== stack was: Y `sX apply REST
== stack becomes: `sXY REST
== `sXY is: (s8 Y X)
apply code stack-first 01 00 01010011stack-second stack-rest current-char input = eval code concat 01 00 11110011 concat stack-first stack-second car stack-rest cdr stack-rest current-char input.

== apply: `sXY = (s8 Y X)
== stack was: Z `sXY apply REST
== stack becomes: Z X apply `SYZ apply REST
== `SYZ is: (S8 Y Z)
apply code stack-first 01 00 11110011stack-second stack-rest current-char input = eval code stack-first car cdr stack-second concat 00 01100000 concat 01 00 11010011 concat car stack-second concat stack-first concat 11 00 01100000 stack-rest current-char input.

== apply: `SYZ = (S8 Y Z)
== stack was: X `SYZ apply REST
== stack becomes: Z Y apply X apply REST
apply code stack-first 01 00 11010011stack-second stack-rest current-char input = eval code car cdr stack-second car stack-second concat 00 01100000 concat stack-first concat 00 01100000 stack-rest current-char input.

== apply: .c
== stack was: X .c apply REST
== stack becomes: X REST
apply code stack-first 01 00 00101110 00 stack-second stack-rest current-char input = take 00000000 stack-second eval code stack-first car stack-rest cdr stack-rest current-char input.

== apply: i
== stack was: X i apply REST
== stack becomes: X REST
apply code stack-first 00 01101001. stack-rest current-char input = eval code stack-first car stack-rest cdr stack-rest current-char input.

== apply: v
== stack was: X v apply REST
== stack becomes: v REST
apply code stack-first 00 01110110. stack-rest current-char input = eval code 00 01110110 car stack-rest cdr stack-rest current-char input.

== apply: c
== stack was: X c apply REST
== stack becomes: (continuation) X apply REST
== (continuation) is: (C (code) (REST))
apply code stack-first 00 01100011. stack-rest current-char input = eval code concat 01 00 01000011 01 concat code concat 11 01 concat stack-rest 11 11 stack-first concat 00 01100000 stack-rest current-char input.

== apply: (continuation) = (C (code) (cREST))
== stack was: X (continuation) apply REST
== stack becomes: X cREST
apply . stack-first 01 00 01000011 stack-second . current-char input = eval unlist car stack-second stack-first car unlist car cdr stack-second cdr unlist car cdr stack-second current-char input.

== apply: d
== stack was: X d apply REST
== stack becomes: X REST
apply code stack-first 00 01100100. stack-rest current-char input = eval code stack-first car stack-rest cdr stack-rest current-char input.

== apply: `dF = (D (F))
== stack was: X `dF apply REST
== stack becomes: `DX apply REST
== `DX is (d8 X)
apply code stack-first 01 00 01000100stack-second stack-rest current-char input = eval concat unlist car stack-second code concat 01 00 11100100 concat stack-first 11_ 00 01100000 stack-rest current-char input.

== apply: `DX = (d8 X)
== stack was: F `DX apply REST
== stack becomes: X F apply REST
apply code stack-first 01 00 11100100stack-second stack-rest current-char input = eval code car stack-second stack-first concat 00 01100000 stack-rest current-char input.

== apply: e
apply . . 00 01100101. . . . = _.

== apply: @
== stack was: X @ apply REST
== stack becomes: v X apply REST
apply code stack-first 00 01000000. stack-rest . _ = eval code 00 01110110 stack-first concat 00 01100000 stack-rest _ _.

== stack becomes: i X apply REST
apply code stack-first 00 01000000. stack-rest . input = eval code 00 01101001 stack-first concat 00 01100000 stack-rest take 00000000 input drop 00000000 input.

== apply: ?c
== stack was: X ?c apply REST
== stack becomes: v X apply REST
apply code stack-first 01 00 00111111 00stack-second stack-rest _ input = eval code 00 01110110 stack-first concat 00 01100000 stack-rest _ input.

== stack becomes: ? X apply REST
apply code stack-first 01 00 00111111 00stack-second stack-rest current-char input = eval code ? current-char stack-second stack-first concat 00 01100000 stack-rest current-char input.

? _ 11 = 00 01101001.
? 0current-char 0compare = ? current-char compare.
? 1current-char 1compare = ? current-char compare.
? . . = 00 01110110.

== apply: |
== stack was: X | apply REST
== stack becomes: v X apply REST
apply code stack-first 00 01111100. stack-rest _ input = eval code 00 01110110 stack-first concat 00 01100000 stack-rest _ input.

== stack becomes: .c X apply REST
apply code stack-first 00 01111100. stack-rest current-char input = eval code concat 01 00 00101110 00 concat current-char 11 stack-first concat 00 01100000 stack-rest current-char input.

No comments:

Post a Comment