root/trunk/thune/boot.c

/* Generated by mkboot.t */

static char _bootScript[] =
  "context! [\n"
  "  logic! 1 make :true\n"
  "  logic! 0 make :false\n"
  "  opcode!  0 'nop     make :nop\n"
  "  opcode!  3 'drop    make :drop\n"
  "  opcode!  4 'dup     make :dup\n"
  "  opcode!  5 'dup2    make :dup2\n"
  "  opcode!  6 'over    make :over\n"
  "  opcode!  7 'swap    make :swap\n"
  "  opcode!  8 'nip     make :nip\n"
  "  opcode!  9 'tuck    make :tuck\n"
  "  opcode! 10 'rot     make :rot\n"
  "  opcode! 11 'rot.r   make :rot.r\n"
  "  opcode! 12 'do      make :do\n"
  "  opcode! 13 'proc    make :proc\n"
  "  opcode! 14 'iter    make :iter\n"
  "  opcode! 15 'each    make :each\n"
  "  opcode! 16 'recurse make :recurse\n"
  "  opcode! 17 'return  make :return\n"
  "  opcode! 18 'throw   make :throw\n"
  "  opcode! 19 'try     make :try\n"
  "  opcode! 20 'ift     make :ift\n"
  "  opcode! 21 'if-some make :if-some\n"
  "  opcode! 22 'iff     make :iff\n"
  "  opcode! 23 'or-else make :or-else\n"
  "  opcode! 24 'if      make :if\n"
  "  opcode! 25 'halt    make :halt\n"
  "  opcode! 26 'quit    make :quit\n"
  "  opcode! 27 'inc     make :inc\n"
  "  opcode! 28 'dec     make :dec\n"
  "  opcode! 29 '++      make :++\n"
  "  opcode! 30 '--      make :--\n"
  "  opcode! 31 'verify  make :verify\n"
  "  opcode! 32 'forever make :forever\n"
  "  opcode! 33 'loop    make :loop\n"
  "  int!/decimal! :number!\n"
  "  word!/set-word!/get-word!/lit-word! :any-word!\n"
  "  binary!/string!/block!/paren! :series!\n"
  "] make :kernel-ops\n"
;

static char _envScript[] =
  "logic! 1 make dup :yes :on\n"
  "logic! 0 make dup :no :off\n"
  "char!  9 make :tab\n"
  "char! 10 make :eol\n"
  "3.14159265358979323846 :pi\n"
  "tail?: :empty?\n"
  "[quit] proc :q\n"
  "[block!  swap make] proc :to-block\n"
  "[string! to] proc :to-string\n"
  "[context! swap make] proc :context\n"
  "[\n"
  "  read\n"
  "  dup \"#!\" match ift (eol find)\n"
  "  to-block kernel-ops infuse\n"
  "] proc :load    ;(filename -- block)\n"
  "[open swap string! to write close] proc :save    ;(value filename -- )\n"
  "[select if-some do] proc :case\n"
  "['break throw] proc :break\n"
  "[\n"
  "  [dup do iff break over do] forever\n"
  "  drop drop\n"
  "]\n"
  "'loop proc :while  ;(block cond -- )\n"
  "[body  n number!  limit number!] [\n"
  "  n\n"
  "  [[dup limit lt? iff break  dup body do  inc]\n"
  "   [dup limit gt? iff break  dup body do  dec]]\n"
  "  over limit lt? pick\n"
  "  forever drop\n"
  "] 'loop func :loop.to\n"
  "[ser words block! body block!]\n"
  "[\n"
  "  ser [words set body do] words length? iter\n"
  "]\n"
  "'loop func :each.set    ;(ser words body -- )\n"
  "[ser comb] [\n"
  "  ser [dup first comb do 1 poke drop] iter\n"
  "] 'loop func :map       ;(ser comb -- )\n"
  "[[do if-some return] each false] proc :any    ; (blk -- logic)\n"
  "[[do dup iff return drop] each true] proc :all    ; (blk -- logic)\n"
  "[ser old new | len] [\n"
  "  old length? :len\n"
  "  ser old find if-some (new len change :ser recurse)\n"
  "  ser\n"
  "] func :replace.all     ;(ser old new -- ser)\n"
  "[reduce to-text console.out] proc :prin  ;(val -- )\n"
  "[reduce [first to-text console.out] iter] proc :prin.pack  ;(val -- )\n"
  "[reduce to-text console.out eol console.out] proc :print   ;(val -- )\n"
  "[error! swap make throw] proc :error\n"
  "[swap context bind proc] proc :proc.env      ;(env body -- proc)\n"
  "[rot  context bind func] proc :func.env      ;(env sig body -- func)\n"
  "[\n"
  "  [some none] copy swap 2 poke\n"
  "  parse\n"
  "  dup tail? iff (\n"
  "    \"parse.some failed at -^/\" copy\n"
  "      swap string! as 80 copy.part\n"
  "      append\n"
  "    error\n"
  "  ) drop\n"
  "]\n"
  "proc :parse.some  ;(data rules -- )\n"
  "[\n"
  "  0,0,5 :version\n"
  "  none :os\n"
  "  [] :devices\n"
  "]\n"
  "context :script-env\n"
  "[swap copy swap append head] proc :join   ; (base addition -- new)\n"
  "[val block!]\n"
  "[\n"
  "  val dup empty? ift return\n"
  "  reduce\n"
  "  dup first\n"
  "    dup series! is-type? [copy] [to-text] either :val\n"
  "  next [\n"
  "    first val swap append drop\n"
  "  ] iter\n"
  "  val\n"
  "] func :rejoin  ; (block -- string)\n"
  "[ser pat rep]\n"
  "[\n"
  "  ser [dup first pat if/eq (rep 1 poke) drop] iter\n"
  "  ser\n"
  "]\n"
  "func :replace   ; (ser pat rep -- ser)\n"
  "[bind [dup second swap first set] iter/2] proc :set-key-values ; (blk ctx -- )\n"
  "[now swap do now swap sub] proc :time-blk\n"
  "[\n"
  "  dup [\n"
  "    \".\"   [drop \"./\"  none]\n"
  "    \"..\"  [drop \"../\"  none]\n"
  "    [\n"
  "      dup last '/' eq? ift (none return)\n"
  "      dup '/' find.last dup iff (swap return)\n"
  "      ; fullpath file\n"
  "      next\n"
  "      dup2 slice\n"
  "      rot.r nip\n"
  "    ]\n"
  "  ] case\n"
  "] proc :split-path    ; (fullpath -- path file)\n"
  "[\n"
  "  dup last dup '/' if/eq (drop return)\n"
  "    '\\' if/eq return\n"
  "  '/' append head\n"
  "] proc :dirize    ; (path -- path)\n"
  "[0 swap add] proc :to-dec\n"
  "[rot minimum maximum] proc :limit   ; (n min max -- n)\n"
  "[blk | ctx num word]\n"
  "[\n"
  "  [] context :ctx\n"
  "  blk [num word][\n"
  "    opcode! num word make word ctx set\n"
  "  ] each.set\n"
  "  ctx\n"
  "] func :make-opcodes    ; (block -- ctx)\n"
;