Changeset 339 for trunk/thune/rune

Show
Ignore:
Timestamp:
01/06/07 03:57:18 (2 years ago)
Author:
krobillard
Message:

Rune - Imported working boot script.

Location:
trunk/thune/rune
Files:
2 added
2 modified

Legend:

Unmodified
Added
Removed

  • trunk/thune/rune/boot.c

    r324 r339  
    22 
    33static char _bootScript[] = 
    4   "rune-ops: make context! [\n" 
     4  "declare-natives [\n" 
     5  "  add     [a int!/decimal! b int!/decimal!]\n" 
     6  "  sub     [a int!/decimal! b int!/decimal!]\n" 
     7  "  mul     [a int!/decimal! b int!/decimal!]\n" 
     8  "  div     [a int!/decimal! b int!/decimal!]\n" 
     9  "  func    [sig block! body block!]\n" 
     10  "  cout    [val]\n" 
     11  "  probe   [val]\n" 
     12  "  type?   [val]\n" 
     13  "  eq?     [a b]\n" 
     14  "  same?   [a b]\n" 
     15  "  zero?   [val]\n" 
     16  "  set     [word val]\n" 
     17  "  to-text [val]\n" 
     18  "  infuse  [blk ctx]\n" 
     19  "  reduce  [val]\n" 
     20  "  make    [type spec]\n" 
     21  "  func.loop [sig body]\n" 
     22  "  read    [file string!]\n" 
     23  "  fill    [ser limit val]\n" 
     24  "]\n" 
     25  "kernel-ops: make context! [\n" 
    526  "  true:  make logic! 1\n" 
    627  "  false: make logic! 0\n" 
    7   "  mk-op: func [n word | blk] [\n" 
    8   "    blk: [0 0]\n" 
    9   "    blk/1: n\n" 
    10   "    blk/2: word\n" 
    11   "    make opcode! blk\n" 
    12   "  ]\n" 
    13   "  nop:     mk-op 0 'nop\n" 
    14   "  do:      mk-op 1 'do\n" 
    15   "  does:    mk-op 2 'does \n" 
    16   "  reduce:  mk-op 3 'reduce\n" 
    17   "  if:      mk-op 4 'if\n" 
    18   "  if.else: mk-op 5 'if.else\n" 
    19   "  forever: mk-op 6 'does\n" 
    20   "  break:   mk-op 7 'does\n" 
    21   "  return:  mk-op 8 'does\n" 
    22   "  +:  mk-op  9 '+\n" 
    23   "  -:  mk-op 10 '-\n" 
    24   "  *:  mk-op 11 '*\n" 
    25   "  /:  mk-op 12 '/\n" 
    26   "  >:  mk-op 13 '>\n" 
    27   "  <:  mk-op 14 '<\n" 
     28  "  nop:     make opcode! [0 nop]\n" 
     29  "  do:      make opcode! [1 do]\n" 
     30  "  does:    make opcode! [2 does]\n" 
     31  "  reduce:  make opcode! [3 reduce]\n" 
     32  "  if:      make opcode! [4 if]\n" 
     33  "  if.else: make opcode! [5 if.else]\n" 
     34  "  forever: make opcode! [6 forever]\n" 
     35  "  each:    make opcode! [7 each]\n" 
     36  "  each-loop: make opcode! [8 each-loop]\n" 
     37  "  break:    make opcode! [9 break]\n" 
     38  "  return:   make opcode! [10 return]\n" 
     39  "  +: make opcode! [11 +]\n" 
     40  "  -: make opcode! [12 -]\n" 
     41  "  *: make opcode! [13 *]\n" 
     42  "  /: make opcode! [14 /]\n" 
     43  "  >: make opcode! [15 >]\n" 
     44  "  <: make opcode! [16 <]\n" 
    2845  "  number!: int!/decimal!\n" 
    2946  "  any-word!: word!/set-word!/get-word!/lit-word!\n" 
    3047  "  series!: binary!/string!/block!/paren!\n" 
    3148  "]\n" 
     49  "context: func [spec] [make context! spec]\n" 
     50  "prin:  func [val] [cout to-text val]\n" 
     51  "print: func [val] [cout to-text val cout eol]\n" 
     52  "time-blk: func [blk | s] [s: now  do blk  now - s]\n" 
    3253; 
    3354 
    3455static char _envScript[] = 
    35   "on: yes: make logic! 1\n" 
    36   "off: no: make logic! 0\n" 
     56  "yes: on: make logic! 1\n" 
     57  "no: off: make logic! 0\n" 
    3758  "eol: make char! 10\n" 
    3859  "pi: 3.14159265358979323846\n" 
    3960  "empty?: :tail?\n" 
    40   "q: does [quit]\n" 
    41   "to-block: func [val] [make block! val]\n" 
    42   "to-string: func [val] [to string! val]\n" 
    43   "context: func [spec] [make context! spec]\n" 
    44   "load: func [filename | blk] [\n" 
    45   "  blk: read filename\n" 
    46   "  if match blk \"#!\" [find blk eol]\n" 
    47   "  blk: to-block blk\n" 
    48   "  infuse blk urlan-ops\n" 
    49   "  blk\n" 
     61  "q: :quit\n" 
     62  "to-block: func [from][make block! from]\n" 
     63  "to-string: func [val][to string! val]\n" 
     64  "context: func [spec][make context! spec]\n" 
     65  "load: func [filename | str] [\n" 
     66  "  str: read filename\n" 
     67  "  ;if match str \"#!\" [\n" 
     68  "  ;  str: find str eol\n" 
     69  "  ;]\n" 
     70  "  infuse to-block str kernel-ops\n" 
    5071  "]\n" 
    51   "case: func [blk] [do select blk]\n" 
     72  ";case func [blk] [select blk if/keep do]\n" 
    5273  "break: does [throw 'break]\n" 
    53   "while func.loop [cond blk]\n" 
     74  "script-env: context [\n" 
     75  "  version: 0,0,1\n" 
     76  "  os: none\n" 
     77  "  devices: []\n" 
     78  "]\n" 
     79  "time-blk: func [blk | start] [\n" 
     80  "  start: now\n" 
     81  "  do blk\n" 
     82  "  now - start\n" 
     83  "]\n" 
     84  "make-opcodes: func [blk | ctx num word]\n" 
    5485  "[\n" 
    55   "  forever [if.not do cond break do blk]\n" 
     86  "  ctx: context []\n" 
     87  "  foreach blk [num word][\n" 
     88  "    set word ctx make opcode! [num word]\n" 
     89  "  ]\n" 
     90  "  ctx\n" 
    5691  "]\n" 
    57   "[\n" 
    58   "  int! verify\n" 
    59   "  [dup zero? ift break over do dec] forever\n" 
    60   "  drop drop\n" 
    61   "]\n" 
    62   "'loop proc :loop   ;(block count -- )\n" 
    63   "[body  n number!  limit number!] [\n" 
    64   "  n\n" 
    65   "  [[dup limit lt? iff break  dup body do  inc]\n" 
    66   "   [dup limit gt? iff break  dup body do  dec]]\n" 
    67   "  over limit lt? pick\n" 
    68   "  forever drop\n" 
    69   "] 'loop func :loop.to\n" 
    70   "[ser body]\n" 
    71   "[\n" 
    72   "  ser [first body do] iter\n" 
    73   "] 'loop func :each     ;(ser body -- )\n" 
    74   "[ser words block! body block! | len-1]\n" 
    75   "[\n" 
    76   "   ;words [first word! verify drop] iter\n" 
    77   "   ser\n" 
    78   "   words length?\n" 
    79   "   dup dec :len-1\n" 
    80   "   [\n" 
    81   "     1  [words set            body do]\n" 
    82   "     2  [words set next       body do]\n" 
    83   "        [words set len-1 skip body do]\n" 
    84   "   ] select\n" 
    85   "   iter\n" 
    86   "]\n" 
    87   "'loop func :each.set       ; (ser words body -- )\n" 
    88   "[ser comb]\n" 
    89   "[\n" 
    90   "  ser [dup first comb do 1 poke drop] iter\n" 
    91   "] 'loop func :map     ;(ser comb -- )\n" 
    92   "[reduce to-text console.out] proc :prin  ;(val -- )\n" 
    93   "[reduce [first to-text console.out] iter] proc :prin.pack  ;(val -- )\n" 
    94   "[reduce to-text console.out eol console.out] proc :print   ;(val -- )\n" 
    95   "[error! swap make throw] proc :error\n" 
    96   "[swap context bind proc] proc :proc.env      ;(env body -- proc)\n" 
    97   "[rot  context bind func] proc :func.env      ;(env sig body -- func)\n" 
    98   "[\n" 
    99   "  [some none] copy swap 2 poke\n" 
    100   "  parse\n" 
    101   "  dup tail? iff (\n" 
    102   "    \"parse.some failed at -^/\" copy\n" 
    103   "      swap string! as 80 copy.part\n" 
    104   "      append\n" 
    105   "    error\n" 
    106   "  ) drop\n" 
    107   "]\n" 
    108   "proc :parse.some  ;(data rules -- )\n" 
    109   "[\n" 
    110   "  0,0,1 :version\n" 
    111   "  none :os\n" 
    112   "  [] :devices\n" 
    113   "  [\n" 
    114   "    [\n" 
    115   "      [word word!/lit-word! def] [\n" 
    116   "        def: word: reader-macros last set\n" 
    117   "      ] func :macro\n" 
    118   "      [word word!/lit-word! sig block! body block!] [\n" 
    119   "        sig  urlan-ops infuse\n" 
    120   "        body urlan-ops infuse\n" 
    121   "        func word: reader-macros last set\n" 
    122   "      ] func :macrof\n" 
    123   "      [n] [[n: 'add word! as] reduce] func :+\n" 
    124   "      [n] [[n: 'sub word! as] reduce] func :-\n" 
    125   "      [n] [[n: 'mul word! as] reduce] func :*\n" 
    126   "      [n] [[n: 'div word! as] reduce] func :/\n" 
    127   "    ] context\n" 
    128   "  ] reduce :reader-macros\n" 
    129   "]\n" 
    130   "context :script-env\n" 
    131   "[swap copy swap append head] proc :join   ; (base addition -- new)\n" 
    132   "[val block!]\n" 
    133   "[\n" 
    134   "  val dup empty? ift return\n" 
    135   "  reduce\n" 
    136   "  dup first\n" 
    137   "    dup series! is-type? [copy] [string! to] either :val\n" 
    138   "  next [\n" 
    139   "    first val swap append drop\n" 
    140   "  ] iter\n" 
    141   "  val\n" 
    142   "] func :rejoin  ; (block -- string)\n" 
    143   "[ser pat rep]\n" 
    144   "[\n" 
    145   "  ser [dup first pat if/eq (rep 1 poke) drop] iter\n" 
    146   "  ser\n" 
    147   "]\n" 
    148   "func :replace   ; (ser pat rep -- ser)\n" 
    149   "[now swap do now swap sub] proc :time-blk\n" 
    150   "[\n" 
    151   "  dup [\n" 
    152   "    \".\"   [drop \"./\"  none]\n" 
    153   "    \"..\"  [drop \"../\"  none]\n" 
    154   "    [\n" 
    155   "      dup last '/' eq? ift (none return)\n" 
    156   "      dup '/' find.last dup iff (swap return)\n" 
    157   "      ; fullpath file\n" 
    158   "      next\n" 
    159   "      dup2 slice! rot.r make\n" 
    160   "      rot.r nip\n" 
    161   "    ]\n" 
    162   "  ] case\n" 
    163   "] proc :split-path    ; (fullpath -- path file)\n" 
    164   "[\n" 
    165   "  dup last '/' eq? iff (dup '/' append drop)\n" 
    166   "] proc :dirize    ; (path -- path)\n" 
    167   "[0 swap add] proc :to-dec\n" 
    168   "[blk | ctx num word]\n" 
    169   "[\n" 
    170   "  [] context :ctx\n" 
    171   "  blk [num word][\n" 
    172   "    opcode! num word make word ctx set\n" 
    173   "  ] each.set\n" 
    174   "  ctx\n" 
    175   "] func :make-opcodes    ; (block -- ctx)\n" 
    17692; 

  • trunk/thune/rune/tests/mandel.ru

    r323 r339  
    3737    ;loop [y -39 39] 
    3838    y: -39 
    39     loop 79 
     39    loop 33 ;79 
    4040    [ 
    4141                prin eol