Alla yksinkertainen tilakoneeseen perustuva numeerisen syötteen tarkastaja. Tuotantoversio todennäköisesti laskisi kaikki valmiiksi taulukkoon, mutta kehitysvaiheessa ohjelman kulkua on helpompi seurata ja hahmottaa jääkö joku mahdollinen tila käsittelemättä kun tilojen muodostus on näkyvillä.
Kirjastoon toteutettu:
validate:int?
validate:float?
E-notaatio on tuettuna ja kirjasto tukee niitä muotoja joista 8th muuntaa merkkijonosta numeron.
\ \ validate.8th \ \ Simple state machine based string validator for numbers. \ ns? ns: validate private 32 constant SPACE 09 constant TAB \ Status 0 constant EMPTY 1 constant PARTIAL-FAIL 2 constant PARTIAL-OK 3 constant OK 4 constant ERROR \ State 0 constant S0 1 constant IPART 2 constant FPART 3 constant ESIGN 4 constant EPART 0 constant INTEGER 1 constant FLOAT : make-dword \ lword hword -- dword 0xffff n:band 16 n:shl swap 0xffff n:band n:bor ; : s1 IPART "state" t:! PARTIAL-FAIL "status" t:! ; : s2 IPART "state" t:! OK "status" t:! ; : s3 FPART "state" t:! PARTIAL-FAIL "status" t:! ; : s4 ESIGN "state" t:! PARTIAL-OK "status" t:! ; : s5 OK "status" t:! ; : s6 FPART "state" t:! PARTIAL-FAIL "status" t:! ; : s7 ESIGN "state" t:! PARTIAL-OK "status" t:! ; : s8 OK "status" t:! ; : s9 ESIGN "state" t:! PARTIAL-OK "status" t:! ; : s10 EPART "state" t:! PARTIAL-FAIL "status" t:! ; : s11 EPART "state" t:! ; : s12 OK "status" t:! ; [ ( SPACE S0 make-dword "dword" t:@ n:= ) , ' noop , ( TAB S0 make-dword "dword" t:@ n:= ) , ' noop , ('+ S0 make-dword "dword" t:@ n:= ) , ' s1 , ( '- S0 make-dword "dword" t:@ n:= ) , ' s1 , ( '0 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '1 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '2 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '3 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '4 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '5 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '6 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '7 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '8 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '9 S0 make-dword "dword" t:@ n:= ) , ' s2 , ( '. S0 make-dword "dword" t:@ n:= ) , ' s3 , ( 'e S0 make-dword "dword" t:@ n:= ) , ' s4 , ( 'E S0 make-dword "dword" t:@ n:= ) , ' s4 , ( '0 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '1 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '2 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '3 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '4 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '5 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '6 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '7 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '8 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '9 IPART make-dword "dword" t:@ n:= ) , ' s5 , ( '. IPART make-dword "dword" t:@ n:= ) , ' s6 , ( 'e IPART make-dword "dword" t:@ n:= ) , ' s7 , ( 'E IPART make-dword "dword" t:@ n:= ) , ' s7 , ( '0 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '1 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '2 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '3 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '4 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '5 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '6 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '7 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '8 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( '9 FPART make-dword "dword" t:@ n:= ) , ' s8 , ( 'e FPART make-dword "dword" t:@ n:= ) , ' s9 , ( 'E FPART make-dword "dword" t:@ n:= ) , ' s9 , ( '+ ESIGN make-dword "dword" t:@ n:= ) , ' s10 , ( '- ESIGN make-dword "dword" t:@ n:= ) , ' s10 , ( '0 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '1 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '2 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '3 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '4 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '5 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '6 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '7 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '8 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '9 ESIGN make-dword "dword" t:@ n:= ) , ' s11 , ( '0 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '1 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '2 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '3 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '4 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '5 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '6 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '7 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '8 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( '9 EPART make-dword "dword" t:@ n:= ) , ' s12 , ( ERROR "status" t:! ) ] var, state-table : number S0 "state" t:! EMPTY "status" t:! ( "status" t:@ ERROR n:= if break 2drop else nip "state" t:@ make-dword "dword" t:! state-table @ a:when then ) s:each "status" t:@ "state" t:@ make-dword [ ( OK IPART make-dword over n:= ) , ( INTEGER ) , ( OK FPART make-dword over n:= ) , ( FLOAT ) , ( PARTIAL-OK FPART make-dword over n:= ) , ( FLOAT ) , ( PARTIAL-OK ESIGN make-dword over n:= ) , ( FLOAT ) , ( OK EPART make-dword over n:= ) , ( FLOAT ) , ( PARTIAL-OK EPART make-dword over n:= ) , ( FLOAT ) , ( null ) ] a:when nip ; public : int? \ s -- T #p:number null? if drop false else #p:INTEGER n:= then ; : float? \ s -- T #p:number null? if drop false else #p:FLOAT n:= then ; ns
Aihe on jo aika vanha, joten et voi enää vastata siihen.