palate 0.3.7

File type detection combining tft and hyperpolyglot
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

\ -*- forth -*- Copyright 2004, 2013 Lars Brinkhoff

( Tools words. )

: .s ( -- )
    [char] < emit  depth (.)  ." > "
    'SP @ >r r@ depth 1- cells +
    begin
	dup r@ <>
    while
	dup @ .
	/cell -
    repeat r> 2drop ;

: ?   @ . ;

: c?   c@ . ;

: dump   bounds do i ? /cell +loop cr ;

: cdump   bounds do i c? loop cr ;

: again   postpone branch , ; immediate

: see-find ( caddr -- end xt )
    >r here lastxt @
    begin
	dup 0= abort" Undefined word"
	dup r@ word= if r> drop exit then
	nip dup >nextxt
    again ;

: cabs ( char -- |char| )   dup 127 > if 256 swap - then ;

: xt. ( xt -- )
    ( >name ) count cabs type ;

: xt? ( xt -- flag )
    >r lastxt @ begin
	?dup
    while
	dup r@ = if r> 2drop -1 exit then
	>nextxt
    repeat r> drop 0 ;

: disassemble ( x -- )
    dup xt? if
        ( >name ) count
        dup 127 > if ." postpone " then
        cabs type
    else
        .
    then ;

: .addr  dup . ;

: see-line ( addr -- )
    cr ."     ( " .addr ." ) "  @ disassemble ;

: see-word ( end xt -- )
    >r ." : " r@ xt.
    r@ >body do i see-line /cell +loop
    ."  ;" r> c@ 127 > if ."  immediate" then ;

: see   bl word see-find see-word cr ;

: #body   bl word see-find >body - ;

: type-word ( end xt -- flag )
    xt. space drop 0 ;

: traverse-dictionary ( in.. xt -- out.. )
    \ xt execution: ( in.. end xt2 -- in.. 0 | in.. end xt2 -- out.. true )
    >r  here lastxt @  begin
	?dup
    while
	r> 2dup >r >r execute
	if r> r> 2drop exit then
	r> dup >nextxt
    repeat r> 2drop ;

: words ( -- )
    ['] type-word traverse-dictionary cr ;

\ ----------------------------------------------------------------------

( Tools extension words. )

\ ;code

\ assembler

\ in kernel: bye

\ code

\ cs-pick

\ cs-roll

\ editor

: forget   ' dup >nextxt lastxt !  'here !  reveal ;

\ Kernel: state

\ [else]

\ [if]

\ [then]

\ ----------------------------------------------------------------------

( Forth2012 tools extension words. )

\ TODO: n>r

\ TODO: nr>

\ TODO: synonym

: [undefined]   bl-word find nip 0= ; immediate

: [defined]   postpone [undefined] invert ; immediate

\ ----------------------------------------------------------------------

: @+ ( addr -- addr+/cell x )   dup cell+ swap @ ;

: !+ ( x addr -- addr+/cell )   tuck ! cell+ ;

: -rot   swap >r swap r> ;