r3/my-name-in-binary.tng
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 57 52eb7e976a66
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
57
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     1
"
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     2
(list->string
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     3
 (map (lambda (x) (integer->char (+ 96 (string->number x 2))))
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     4
      (map list->string
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     5
	   (unfold null?
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     6
		   (lambda (x) (take x 5))
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     7
		   (lambda (x) (drop x 5))
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     8
		   (map (lambda (x) (cdr (assq x '((#\/ . #\1) (#\\ . #\0)))))
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     9
			(string->list ""/\\/\\\\\\////\\///\\//\\\\/\\\\///""))))))
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    10
"
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    11
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    12
map: [digits: ((digits as: Integer base: 2) + 96 as: Character encoding: Encoding::Ascii)]
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    13
over: (unfold: (map: [$/: $1 $\: $0] over: '/\/\\\////\///\//\\/\\///')
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    14
       until: [seed: seed isEmpty]
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    15
       with: [seed: (seed take: 5, seed drop: 5)])
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    16
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    17
map [digits: ((digits as: Integer base: 2) + 96 as: Character encoding: Encoding::Ascii)]
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    18
    (unfold until: .isEmpty er
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    19
	    with: [seed: (seed splitAt: 5)]
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    20
	    seed: (map [$/: $1 $\: $0] '/\/\\\////\///\//\\/\\///'))
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    21
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    22
map [x: ((fold: [(d,n): d + (n * 2)] seed: 0 over: x) + 96
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    23
         as: Character encoding: Encoding::Ascii)]
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    24
    (unfold until: .isEmpty er
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    25
	    with: [seed: (seed splitAt: 5)]
52eb7e976a66 More experimental notes.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    26
	    seed: (map [$/: 1 $\: 0] '/\/\\\////\///\//\\/\\///'))