diff --git a/.gitattributes b/.gitattributes
new file mode 100644
index 0000000..1655562
--- /dev/null
+++ b/.gitattributes
@@ -0,0 +1 @@
+*.qky linguist-language=Forth
diff --git a/.nojekyll b/.nojekyll
new file mode 100644
index 0000000..e69de29
diff --git a/README.md b/README.md
index f7a1c49..bd62497 100644
--- a/README.md
+++ b/README.md
@@ -1,10 +1,11 @@
# Quackery
-Quackery is a lightweight, open-source language for recreational and
-educational programming, inspired by Forth and Lisp.
+
+Quackery is a lightweight, open-source language for recreational and educational programming, inspired by Forth and Lisp.
Sample Quackery Shell dialogue; defining and testing an insertion sort.
-/O> [ [] swap witheach
+```qky
+/O> [ [] swap witheach
... [ swap 2dup
... findwith [ over > ] [ ]
... nip stuff ] ] is i-sort ( [ --> [ )
@@ -21,42 +22,20 @@ Stack empty.
Stack empty.
/O>
-
-
-The Quackery language is an extensible assembler for a Quackery
-Engine. The Quackery Engine has a memory model based on dynamic arrays
-and bignums, so presumes comprehensive hardware support for these
-features.
-
-Program execution consists of the Quackery Processor traversing
-directed tree-like graphs built from dynamic arrays ("Nests" in the
-Quackery nomenclature) containing Operators (op-codes), Numbers
-(pointers to bignums) and pointers to Nests. The Quackery processor is
-stack-based rather than register-based.
-
-Programming in Quackery consists of extending the predefined graphs
-that constitute the Quackery environment.
-
-This implementation of a virtual Quackery Engine uses Python lists as
-Nests, Python functions as Operators and Python ints as Numbers.
-
-The Quackery processor and a basic Quackery compiler are coded in
-Python 3, and the Python Quackery compiler is used to compile the
-Quackery environment, which is written in Quackery and includes a more
-fully featured (and extensible) Quackery compiler, which is available
-to the Quackery programmer.
-
-That the Quackery language has similarities to Forth (also an
-extensible assembler for a stack processor), that it leans on Python
-for support for dynamic arrays and bignums, and that the majority of
-Quackery is written in Quackery all make for a very compact
-implementation, under 50k of source code. The downsides are that it is
-rather slow by modern standards, and that it is by no means "fully
-featured".
-
-In its defence it is possible to understand the entirety of Quackery
-in short order, and, once the hurdle of Reverse Polish Notation has
-been passed, program development with the interactive environment (the
-Quackery Shell) is quick and rewarding. Quackery is intended primarily
-for recreational and educational programming, and is a relatively
-painless introduction to the concatenative programming paradigm.
+```
+
+The Quackery language is an extensible assembler for a Quackery Engine. The Quackery Engine has a memory model based on dynamic arrays and bignums, so presumes comprehensive hardware support for these features.
+
+Program execution consists of the Quackery Processor traversing directed tree-like graphs built from dynamic arrays ("Nests" in the Quackery nomenclature) containing Operators (op-codes), Numbers (pointers to bignums) and pointers to Nests. The Quackery processor is stack-based rather than register-based.
+
+Programming in Quackery consists of extending the predefined graphs that constitute the Quackery environment.
+
+This implementation of a virtual Quackery Engine uses Python lists as Nests, Python functions as Operators and Python ints as Numbers.
+
+The Quackery processor and a basic Quackery compiler are coded in Python 3, and the Python Quackery compiler is used to compile the Quackery environment, which is written in Quackery and includes a more fully featured (and extensible) Quackery compiler, which is available to the Quackery programmer.
+
+That the Quackery language has similarities to Forth (also an extensible assembler for a stack processor), that it leans on Python for support for dynamic arrays and bignums, and that the majority of Quackery is written in Quackery all make for a very compact implementation, under 50k of source code. The downsides are that it is rather slow by modern standards, and that it is by no means "fully featured".
+
+In its defence it is possible to understand the entirety of Quackery in short order, and, once the hurdle of Reverse Polish Notation has been passed, program development with the interactive environment (the Quackery Shell) is quick and rewarding. Quackery is intended primarily for recreational and educational programming, and is a relatively painless introduction to the concatenative programming paradigm.
+
+**NEW May 3, 2022**: A beta web console is now available at Online Quackery Console
+
+
+
diff --git a/quackery.py b/quackery.py
index b870581..db8b804 100644
--- a/quackery.py
+++ b/quackery.py
@@ -21,6 +21,8 @@ def quackery(source_string):
def failed(message):
traverse(build(""" stacksize pack
decimal unbuild
+ ' base size 2 > if
+ [ base release ]
return$
nestdepth ]bailby[ """))
returnstack = string_from_stack()
@@ -749,898 +751,898 @@ def sub_build():
predefined = r"""
- [ 0 ] is false ( --> b )
+[ 0 ] is false ( --> b )
- [ 1 ] is true ( --> b )
+[ 1 ] is true ( --> b )
- [ dup nand ] is not ( b --> b )
+[ dup nand ] is not ( b --> b )
- [ nand not ] is and ( b b --> b )
+[ nand not ] is and ( b b --> b )
- [ not swap not nand ] is or ( b b --> b )
+[ not swap not nand ] is or ( b b --> b )
- [ = not ] is != ( x x --> b )
+[ = not ] is != ( x x --> b )
- [ not swap not != ] is xor ( b b --> b )
+[ not swap not != ] is xor ( b b --> b )
- [ swap > ] is < ( n n --> b )
+[ swap > ] is < ( n n --> b )
- [ negate + ] is - ( n --> n )
+[ negate + ] is - ( n --> n )
- [ /mod drop ] is / ( n n --> n )
+[ /mod drop ] is / ( n n --> n )
- [ swap drop ] is nip ( x x --> x )
+[ swap drop ] is nip ( x x --> x )
- [ /mod nip ] is mod ( n n --> n )
+[ /mod nip ] is mod ( n n --> n )
- [ 1 swap << ] is bit ( n --> n )
+[ 1 swap << ] is bit ( n --> n )
- [ swap over ] is tuck ( x x --> x x x )
+[ swap over ] is tuck ( x x --> x x x )
- [ rot rot ] is unrot ( x x x --> x x x )
+[ rot rot ] is unrot ( x x x --> x x x )
- [ rot tuck >
- unrot > not and ] is within ( n n n --> b )
+[ rot tuck >
+ unrot > not and ] is within ( n n n --> b )
- [ over over ] is 2dup ( x x --> x x x x )
+[ over over ] is 2dup ( x x --> x x x x )
- [ drop drop ] is 2drop ( x x --> )
+[ drop drop ] is 2drop ( x x --> )
- [ ]again[ ] is again ( --> )
+[ ]again[ ] is again ( --> )
- [ ]done[ ] is done ( --> )
+[ ]done[ ] is done ( --> )
- [ ]if[ ] is if ( b --> )
+[ ]if[ ] is if ( b --> )
- [ ]iff[ ] is iff ( b --> )
+[ ]iff[ ] is iff ( b --> )
- [ ]else[ ] is else ( --> )
+[ ]else[ ] is else ( --> )
- [ 2dup > if swap drop ] is min ( n n n --> n )
+[ 2dup > if swap drop ] is min ( n n n --> n )
- [ 2dup < if swap drop ] is max ( n n n --> n )
+[ 2dup < if swap drop ] is max ( n n n --> n )
- [ rot min max ] is clamp ( n n n --> n )
+[ rot min max ] is clamp ( n n n --> n )
- [ dup nest? iff [] join ] is copy ( [ --> [ )
+[ dup nest? iff [] join ] is copy ( [ --> [ )
- [ ]'[ ] is ' ( --> x )
+[ ]'[ ] is ' ( --> x )
- [ ]this[ ] is this ( --> [ )
+[ ]this[ ] is this ( --> [ )
- [ ]do[ ] is do ( x --> )
+[ ]do[ ] is do ( x --> )
- [ ]this[ do ] is recurse ( --> )
+[ ]this[ do ] is recurse ( --> )
- [ not if ]again[ ] is until ( b --> )
+[ not if ]again[ ] is until ( b --> )
- [ not if ]done[ ] is while ( b --> )
+[ not if ]done[ ] is while ( b --> )
- [ immovable ]this[ ]done[ ] is stack ( --> s )
+[ immovable ]this[ ]done[ ] is stack ( --> s )
- [ dup take dup rot put ] is share ( s --> x )
+[ dup take dup rot put ] is share ( s --> x )
- [ take drop ] is release ( s --> )
+[ take drop ] is release ( s --> )
- [ dup release put ] is replace ( x s --> )
+[ dup release put ] is replace ( x s --> )
- [ dup take rot + swap put ] is tally ( n s --> )
+[ dup take rot + swap put ] is tally ( n s --> )
- [ swap take swap put ] is move ( s s --> )
+[ swap take swap put ] is move ( s s --> )
- [ [] tuck put ] is nested ( x --> [ )
+[ [] tuck put ] is nested ( x --> [ )
- [ stack [ ] ] is protected ( --> s )
+[ stack [ ] ] is protected ( --> s )
- [ protected take
- ]'[ nested join
- protected put ] is protect ( --> )
+[ protected take
+ ]'[ nested join
+ protected put ] is protect ( --> )
- ' stack ' filepath put
- protect filepath
+' stack ' filepath put
+protect filepath
- [ stack ] is dip.hold ( --> s )
- protect dip.hold
+[ stack ] is dip.hold ( --> s )
+protect dip.hold
- [ dip.hold put
- ]'[ do dip.hold take ] is dip ( x --> x )
+[ dip.hold put
+ ]'[ do dip.hold take ] is dip ( x --> x )
- [ rot dip rot ] is 2swap ( x x x x --> x x x x )
+[ rot dip rot ] is 2swap ( x x x x --> x x x x )
- [ dip [ dip 2dup ] 2swap ] is 2over ( x x x x --> x x x x x x )
+[ dip [ dip 2dup ] 2swap ] is 2over ( x x x x --> x x x x x x )
- [ stack ] is depth ( --> s )
- protect depth
+[ stack ] is depth ( --> s )
+protect depth
- [ depth share
- 0 != while
- -1 depth tally
- ]this[ do
- 1 depth tally ] is decurse ( --> )
+[ depth share
+ 0 != while
+ -1 depth tally
+ ]this[ do
+ 1 depth tally ] is decurse ( --> )
- [ dup 0 < if negate ] is abs ( n --> n )
+[ dup 0 < if negate ] is abs ( n --> n )
- [ stack ] is times.start ( --> s )
- protect times.start
+[ stack ] is times.start ( --> s )
+protect times.start
- [ stack ] is times.count ( --> s )
- protect times.count
+[ stack ] is times.count ( --> s )
+protect times.count
- [ stack ] is times.action ( --> s )
- protect times.action
+[ stack ] is times.action ( --> s )
+protect times.action
- [ ]'[ times.action put
- dup times.start put
- [ 1 - dup -1 > while
- times.count put
- times.action share do
- times.count take again ]
- drop
- times.action release
- times.start release ] is times ( n --> )
-
- [ times.count share ] is i ( --> n )
-
- [ times.start share i 1+ - ] is i^ ( --> n )
-
- [ 0 times.count replace ] is conclude ( --> )
-
- [ times.start share
- times.count replace ] is refresh ( --> )
-
- [ times.count take 1+
- swap - times.count put ] is step ( --> s )
-
- [ stack ] is temp ( --> s )
- protect temp
+[ ]'[ times.action put
+ dup times.start put
+ [ 1 - dup -1 > while
+ times.count put
+ times.action share do
+ times.count take again ]
+ drop
+ times.action release
+ times.start release ] is times ( n --> )
- [ immovable
- dup -1 > +
- ]this[ swap peek
- ]done[ ] is table ( n --> x )
+[ times.count share ] is i ( --> n )
- [ [] unrot
- dup 1 < iff 2drop done
- [ 2 /mod over while
- if [ dip [ tuck join swap ] ]
- dip [ dup join ]
- again ] 2drop join ] is of ( x n --> [ )
+[ times.start share i 1+ - ] is i^ ( --> n )
- [ split 1 split
- swap dip join
- 0 peek ] is pluck ( [ n --> [ x )
+[ 0 times.count replace ] is conclude ( --> )
- [ split
- rot nested
- swap join join ] is stuff ( x [ n --> [ )
+[ times.start share
+ times.count replace ] is refresh ( --> )
- [ 0 pluck ] is behead ( [ --> [ x )
+[ times.count take 1+
+ swap - times.count put ] is step ( --> s )
- [ over size over size
- dup temp put
- swap - 1+ times
- [ 2dup over size split
- drop = if
- [ i^ temp replace
- conclude ]
- behead drop ]
- 2drop temp take ] is findseq ( [ [ --> n )
+[ stack ] is temp ( --> s )
+protect temp
- [ 13 ] is carriage ( --> c )
+[ immovable
+ dup -1 > +
+ ]this[ swap peek
+ ]done[ ] is table ( n --> x )
- [ carriage emit ] is cr ( --> )
+[ [] unrot
+ dup 1 < iff 2drop done
+ [ 2 /mod over while
+ if [ dip [ tuck join swap ] ]
+ dip [ dup join ]
+ again ] 2drop join ] is of ( x n --> [ )
- [ 32 ] is space ( --> c )
+[ split 1 split
+ swap dip join
+ 0 peek ] is pluck ( [ n --> [ x )
- [ space emit ] is sp ( --> )
+[ split
+ rot nested
+ swap join join ] is stuff ( x [ n --> [ )
- [ dup char a char { within
- if [ 32 - ] ] is upper ( c --> c )
+[ 0 pluck ] is behead ( [ --> [ x )
- [ dup char A char [ within
- if [ 32 + ] ] is lower ( c --> c )
+[ over size over size
+ dup temp put
+ swap - 1+ times
+ [ 2dup over size split
+ drop = if
+ [ i^ temp replace
+ conclude ]
+ behead drop ]
+ 2drop temp take ] is findseq ( [ [ --> n )
- [ dup 10 <
- iff 48 else 55 + ] is digit ( n --> c )
+[ 13 ] is carriage ( --> c )
- [ stack 10 ] is base ( --> s )
- protect base
+[ carriage emit ] is cr ( --> )
- [ 10 base put ] is decimal ( --> )
+[ 32 ] is space ( --> c )
- [ $ '' over abs
- [ base share /mod digit
- rot join swap
- dup 0 = until ]
- drop
- swap 0 < if
- [ $ '-' swap join ] ] is number$ ( n --> $ )
-
- [ stack ] is with.hold ( --> s )
- protect with.hold
+[ space emit ] is sp ( --> )
- [ nested
- ' [ dup with.hold put
- size times ]
- ' [ with.hold share
- i ~ peek ]
- rot join
- nested join
- ' [ with.hold release ]
- join ] is makewith ( x --> [ )
+[ dup char a char { within
+ if [ 32 - ] ] is upper ( c --> c )
- [ ]'[ makewith do ] is witheach ( [ --> )
+[ dup char A char [ within
+ if [ 32 + ] ] is lower ( c --> c )
- [ witheach emit ] is echo$ ( $ --> )
+[ dup 10 <
+ iff 48 else 55 + ] is digit ( n --> c )
- [ stack ] is mi.tidyup ( --> s )
- protect mi.tidyup
+[ stack 10 ] is base ( --> s )
+protect base
- [ stack ] is mi.result ( --> s )
- protect mi.result
-
- [ mi.tidyup put
- over size mi.result put
- nested
- ' [ if
- [ i^ mi.result replace
- conclude ] ]
- join makewith do
- mi.tidyup take do
- mi.result take ] is matchitem ( [ x x --> n )
-
- [ ]'[ ]'[ matchitem ] is findwith ( [ --> n )
+[ 10 base put ] is decimal ( --> )
- [ size < ] is found ( n [ --> b )
-
- [ space > ] is printable ( c --> b )
-
- [ dup findwith
- printable [ ]
- split nip ] is trim ( $ --> $ )
+[ $ '' over abs
+ [ base share /mod digit
+ rot join swap
+ dup 0 = until ]
+ drop
+ swap 0 < if
+ [ $ '-' swap join ] ] is number$ ( n --> $ )
- [ dup findwith
- [ printable not ] [ ]
- split swap ] is nextword ( $ --> $ $ )
-
- [ dup nest? if
- [ dup size 2 < if done
- dup size 2 / split
- recurse swap
- recurse join ] ] is reverse ( x --> x )
-
- [ [] swap times
- [ swap nested join ]
- reverse ] is pack ( * n --> [ )
-
- [ witheach [ ] ] is unpack ( [ --> * )
-
- [ stack ] is to-do ( --> s )
- protect to-do
-
- [ ' done swap put ] is new-do ( s --> )
-
- [ dip [ 1+ pack ] put ] is add-to ( * x n s --> )
-
- [ [ dup take
- unpack do again ] drop ] is now-do ( s --> )
-
- [ 1 split reverse join
- now-do ] is do-now ( s --> )
-
- [ [ dup take ' done = until ]
- drop ] is not-do ( s --> )
-
- [ stack ] is sort.test ( --> s )
- protect sort.test
-
- [ ]'[ sort.test put
- [] swap witheach
- [ swap 2dup findwith
- [ over sort.test share
- do ] [ ]
- nip stuff ]
- sort.test release ] is sortwith ( [ --> [ )
-
- [ sortwith > ] is sort ( [ --> [ )
-
- [ 32 127 clamp 32 -
- [ table
- 0 86 88 93 94 90 92 87 63 64 75 73 82 74 81 76
- 1 2 3 4 5 6 7 8 9 10 83 84 69 72 70 85
- 91 11 13 15 17 19 21 23 25 27 29 31 33 35 37 39
- 41 43 45 47 49 51 53 55 57 59 61 65 78 66 77 80
- 89 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40
- 42 44 46 48 50 52 54 56 58 60 62 67 79 68 71 0 ]
- ] is qacsfot ( c --> n )
-
- [ [ dup $ '' = iff false done
- over $ '' = iff true done
- behead rot behead rot
- 2dup = iff [ 2drop swap ] again
- qacsfot swap qacsfot > ]
- unrot 2drop ] is $< ( $ $ --> b )
-
- [ swap $< ] is $> ( $ $ --> b )
-
- [ sortwith $> ] is sort$ ( [ --> [ )
-
- [ upper 47 - 0 44 clamp
- [ table
- -1 0 1 2 3 4 5 6 7 8 9 -1 -1 -1 -1
- -1 -1 -1 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 -1 ]
- dup 0 base share
- within not if [ drop -1 ] ] is char->n ( c --> n )
-
- [ dup $ '' = iff [ drop 0 false ] done
- dup 0 peek char - =
- tuck if [ behead drop ]
- dup $ '' = iff [ 2drop 0 false ] done
- true 0 rot witheach
- [ char->n
- dup 0 < iff [ drop nip false swap ]
- else [ swap base share * + ] ]
- rot if negate
- swap ] is $->n ( $ --> n b )
-
- ( adapted from 'A small noncryptographic PRNG' by Bob Jenkins )
- ( https://burtleburtle.net/bob/rand/smallprng.html )
-
- [ hex FFFFFFFFFFFFFFFF ] is 64bitmask ( --> f )
-
- [ 64bitmask & ] is 64bits ( f --> f )
-
- [ dip 64bits 2dup << 64bits
- unrot 64 swap - >> | ] is rot64 ( f n --> f )
-
- [ stack 0 ] is prng.a ( --> s )
- [ stack 0 ] is prng.b ( --> s )
- [ stack 0 ] is prng.c ( --> s )
- [ stack 0 ] is prng.d ( --> s )
-
- [ prng.a share
- prng.b share tuck
- 7 rot64 - 64bits swap
- prng.c share tuck
- 13 rot64 ^ prng.a replace
- prng.d share tuck
- 37 rot64 + 64bits prng.b replace
- over + 64bits prng.c replace
- prng.a share + 64bits
- dup prng.d replace ] is prng ( --> n )
-
- [ hex F1EA5EAD prng.a replace
- dup prng.b replace
- dup prng.c replace
- prng.d replace
- 20 times [ prng drop ] ] is initrandom ( n --> )
-
- hex DEFACEABADFACADE initrandom
-
- [ time initrandom ] is randomise ( --> )
-
- [ 64bitmask 1+
- over / over *
- [ prng 2dup > not while
- drop again ]
- nip swap mod ] is random ( n --> n )
-
- [ [] swap dup size times
- [ dup size random pluck
- nested rot join swap ]
- drop ] is shuffle ( [ --> [ )
-
- [ stack ] is history ( --> s )
-
- [ protected share history put
- protected share 0
- [ over size over
- > while
- 2dup peek
- size unrot
- 1+ again ]
- 2drop
- protected share size pack
- history put
- pack dup history put unpack
- stacksize history put
- nestdepth history put
- false history put ] is backup ( n --> )
-
- [ history release
- nestdepth
- history take
- - ]bailby[
- true history put ] is bail ( --> )
-
- [ history take iff
- [ stacksize
- history take
- history share
- size - - times drop
- history take unpack
- history take unpack
- history share size
- [ dup 0 > while
- 1 -
- history share
- over peek
- rot over size
- swap -
- [ dup 0 > while
- over release
- 1 - again ]
- 2drop again ]
- drop
- history take
- protected replace
- true ]
- else
- [ 5 times
- [ history release ]
- false ] ] is bailed ( --> b )
+[ stack ] is with.hold ( --> s )
+protect with.hold
- [ quid swap quid = ] is oats ( x x --> b )
+[ nested
+ ' [ dup with.hold put
+ size times ]
+ ' [ with.hold share
+ i ~ peek ]
+ rot join
+ nested join
+ ' [ with.hold release ]
+ join ] is makewith ( x --> [ )
- [ [] swap
- [ trim
- dup size while
- nextword nested
- swap dip join again ]
- drop ] is nest$ ( $ --> [ )
+[ ]'[ makewith do ] is witheach ( [ --> )
- [ stack ] is namenest ( --> s )
+[ witheach emit ] is echo$ ( $ --> )
- [ namenest share ] is names ( --> [ )
+[ stack ] is mi.tidyup ( --> s )
+protect mi.tidyup
- [ names find names found ] is name? ( $ --> b )
+[ stack ] is mi.result ( --> s )
+protect mi.result
- forward is actions ( n --> x )
+[ mi.tidyup put
+ over size mi.result put
+ nested
+ ' [ if
+ [ i^ mi.result replace
+ conclude ] ]
+ join makewith do
+ mi.tidyup take do
+ mi.result take ] is matchitem ( [ x x --> n )
- [ ' actions ] is actiontable ( --> x )
+[ ]'[ ]'[ matchitem ] is findwith ( [ --> n )
- [ actiontable share tuck
- findwith [ over oats ] drop
- swap found ] is named? ( x --> b )
+[ size < ] is found ( n [ --> b )
- forward is reflect ( x --> x )
- [ dup nest? if
- [ dup [] = if done
- dup size 1 = iff
- [ 0 peek
- dup named? iff
- nested done
- reflect nested ]
- done
- dup size 2 / split
- recurse swap
- recurse join ] ] resolves reflect ( x --> x )
+[ space > ] is printable ( c --> b )
- [ stack ] is buildernest ( --> s )
+[ dup findwith
+ printable [ ]
+ split nip ] is trim ( $ --> $ )
- [ buildernest share ] is builders ( --> s )
+[ dup findwith
+ [ printable not ] [ ]
+ split swap ] is nextword ( $ --> $ $ )
- [ builders find
- builders found ] is builder? ( $ --> b )
+[ dup nest? if
+ [ dup size 2 < if done
+ dup size 2 / split
+ recurse swap
+ recurse join ] ] is reverse ( x --> x )
- forward is jobs ( n --> x )
+[ [] swap times
+ [ swap nested join ]
+ reverse ] is pack ( * n --> [ )
- [ ' jobs ] is jobtable ( --> [ )
+[ witheach [ ] ] is unpack ( [ --> * )
- [ stack ] is message ( --> s )
+[ stack ] is to-do ( --> s )
+protect to-do
- [ stack ] is b.nesting ( --> s )
- protect b.nesting
+[ ' done swap put ] is new-do ( s --> )
- [ stack ] is b.to-do ( --> s )
+[ dip [ 1+ pack ] put ] is add-to ( * x n s --> )
- [ $ '[' b.nesting put
- [] swap ] is b.[ ( [ $ --> [ [ $ )
+[ [ dup take
+ unpack do again ] drop ] is now-do ( s --> )
- [ b.nesting take dup
- $ '' = if
- [ $ 'Unexpected "]".'
- message put
- bail ]
- dup $ '[' = iff drop
- else
- [ $ 'Nest mismatch: '
- swap join $ ' ]' join
- message put
- bail ]
- dip [ nested join ] ] is b.] ( [ [ $ --> [ $ )
+[ 1 split reverse join
+ now-do ] is do-now ( s --> )
- [ over [] = if
- [ $ '"is" needs something to name before it.'
- message put
- bail ]
- dup $ '' = if
- [ $ '"is" needs a name after it.'
- message put
- bail ]
- nextword nested
- namenest take
- join
- namenest put
- dip
- [ -1 pluck
- actiontable take
- 1 stuff
- actiontable put ] ] is b.is ( [ $ --> [ $ )
-
- [ over [] = if
- [ $ '"builds" needs something to name before it.'
- message put
- bail ]
- dup $ '' = if
- [ $ '"builds" needs a name after it.'
- message put
- bail ]
- nextword nested
- buildernest take
- join
- buildernest put
- dip
- [ -1 pluck
- jobtable take
- 1 stuff
- jobtable put ] ] is b.builds ( [ $ --> [ $ )
-
- [ trim nextword
- dup $ '' = if
- [ $ 'Unfinished comment.'
- message put
- bail ]
- $ ')' = until ] is b.( ( [ $ --> $ [ )
+[ [ dup take ' done = until ]
+ drop ] is not-do ( s --> )
- [ $ 'Unexpected ")".'
- message put
- bail ] is b.) ( [ $ --> $ [ )
+[ stack ] is sort.test ( --> s )
+protect sort.test
- [ $ 'Unresolved reference.'
- fail ] is unresolved ( --> )
+[ ]'[ sort.test put
+ [] swap witheach
+ [ swap 2dup findwith
+ [ over sort.test share
+ do ] [ ]
+ nip stuff ]
+ sort.test release ] is sortwith ( [ --> [ )
- [ dip
- [ ' [ unresolved ]
- copy nested join ] ] is b.forward ( [ $ --> [ $ )
+[ sortwith > ] is sort ( [ --> [ )
- [ over [] = if
- [ $ '"resolves" needs something to resolve.'
- message put
- bail ]
- dup $ '' = if
- [ $ '"resolves" needs a name to resolve into.'
- message put
- bail ]
- dip [ -1 split ]
- nextword dup temp put
- names find
- dup names found not if
- [ $ 'Unknown word after "resolves": '
- temp take join
- message put
- bail ]
- actions
- dup ' [ unresolved ] = not if
- [ char " temp take join
- $ '" is not an unresolved forward reference.'
- join
- message put
- bail ]
- rot 0 peek over
- replace
- ' unresolved swap
- ' replace 2 b.to-do add-to
- temp release ] is b.resolves ( [ $ --> [ $ )
-
- [ 1 split
- over $ '' = if
- [ $ '"char" needs a character after it.'
- message put
- bail ]
- dip join ] is b.char ( [ $ --> [ $ )
-
- [ dup $ '' = if
- [ $ '"$" needs to be followed by a string.'
- message put
- bail ]
- behead over find
- 2dup swap found not if
- [ $ 'Endless string discovered.'
- message put
- bail ]
- split behead drop
- ' ' nested
- rot nested join
- nested swap dip join ] is b.$ ( [ $ --> [ $ )
-
- [ dup $ '' = if
- [ $ '"say" needs to be followed by a string.'
- message put
- bail ]
- $ '$' builders find jobs do
- dip
- [ -1 pluck
- ' echo$ nested join
- nested join ] ] is b.say ( [ $ --> [ $ )
-
- [ 16 base put
- nextword dup
- $ '' = if
- [ $ '"hex" needs a number after it.'
- message put
- bail ]
- dup $->n iff
- [ nip swap dip join ]
+[ 32 127 clamp 32 -
+ [ table
+ 0 86 88 93 94 90 92 87 63 64 75 73 82 74 81 76
+ 1 2 3 4 5 6 7 8 9 10 83 84 69 72 70 85
+ 91 11 13 15 17 19 21 23 25 27 29 31 33 35 37 39
+ 41 43 45 47 49 51 53 55 57 59 61 65 78 66 77 80
+ 89 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40
+ 42 44 46 48 50 52 54 56 58 60 62 67 79 68 71 0 ]
+] is qacsfot ( c --> n )
+
+[ [ dup $ '' = iff false done
+ over $ '' = iff true done
+ behead rot behead rot
+ 2dup = iff [ 2drop swap ] again
+ qacsfot swap qacsfot > ]
+ unrot 2drop ] is $< ( $ $ --> b )
+
+[ swap $< ] is $> ( $ $ --> b )
+
+[ sortwith $> ] is sort$ ( [ --> [ )
+
+[ upper 47 - 0 44 clamp
+ [ table
+ -1 0 1 2 3 4 5 6 7 8 9 -1 -1 -1 -1
+ -1 -1 -1 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 -1 ]
+ dup 0 base share
+ within not if [ drop -1 ] ] is char->n ( c --> n )
+
+[ dup $ '' = iff [ drop 0 false ] done
+ dup 0 peek char - =
+ tuck if [ behead drop ]
+ dup $ '' = iff [ 2drop 0 false ] done
+ true 0 rot witheach
+ [ char->n
+ dup 0 < iff [ drop nip false swap ]
+ else [ swap base share * + ] ]
+ rot if negate
+ swap ] is $->n ( $ --> n b )
+
+( adapted from 'A small noncryptographic PRNG' by Bob Jenkins )
+( https://burtleburtle.net/bob/rand/smallprng.html )
+
+[ hex FFFFFFFFFFFFFFFF ] is 64bitmask ( --> f )
+
+[ 64bitmask & ] is 64bits ( f --> f )
+
+[ dip 64bits 2dup << 64bits
+ unrot 64 swap - >> | ] is rot64 ( f n --> f )
+
+[ stack 0 ] is prng.a ( --> s )
+[ stack 0 ] is prng.b ( --> s )
+[ stack 0 ] is prng.c ( --> s )
+[ stack 0 ] is prng.d ( --> s )
+
+[ prng.a share
+ prng.b share tuck
+ 7 rot64 - 64bits swap
+ prng.c share tuck
+ 13 rot64 ^ prng.a replace
+ prng.d share tuck
+ 37 rot64 + 64bits prng.b replace
+ over + 64bits prng.c replace
+ prng.a share + 64bits
+ dup prng.d replace ] is prng ( --> n )
+
+[ hex F1EA5EAD prng.a replace
+ dup prng.b replace
+ dup prng.c replace
+ prng.d replace
+ 20 times [ prng drop ] ] is initrandom ( n --> )
+
+hex DEFACEABADFACADE initrandom
+
+[ time initrandom ] is randomise ( --> )
+
+[ 64bitmask 1+
+ over / over *
+ [ prng 2dup > not while
+ drop again ]
+ nip swap mod ] is random ( n --> n )
+
+[ [] swap dup size times
+ [ dup size random pluck
+ nested rot join swap ]
+ drop ] is shuffle ( [ --> [ )
+
+[ stack ] is history ( --> s )
+
+[ protected share history put
+ protected share 0
+ [ over size over
+ > while
+ 2dup peek
+ size unrot
+ 1+ again ]
+ 2drop
+ protected share size pack
+ history put
+ pack dup history put unpack
+ stacksize history put
+ nestdepth history put
+ false history put ] is backup ( n --> )
+
+[ history release
+ nestdepth
+ history take
+ - ]bailby[
+ true history put ] is bail ( --> )
+
+[ history take iff
+ [ stacksize
+ history take
+ history share
+ size - - times drop
+ history take unpack
+ history take unpack
+ history share size
+ [ dup 0 > while
+ 1 -
+ history share
+ over peek
+ rot over size
+ swap -
+ [ dup 0 > while
+ over release
+ 1 - again ]
+ 2drop again ]
+ drop
+ history take
+ protected replace
+ true ]
else
- [ drop
- char " swap join
- $ '" is not hexadecimal.'
- join message put
- bail ]
- base release ] is b.hex ( [ $ --> [ $ )
+ [ 5 times
+ [ history release ]
+ false ] ] is bailed ( --> b )
- [ dip [ -1 split ] swap do ] is b.now! ( [ $ --> [ $ )
+[ quid swap quid = ] is oats ( x x --> b )
- [ over [] = if
- [ $ '"constant" needs something before it.'
- message put
+[ [] swap
+ [ trim
+ dup size while
+ nextword nested
+ swap dip join again ]
+ drop ] is nest$ ( $ --> [ )
+
+[ stack ] is namenest ( --> s )
+
+[ namenest share ] is names ( --> [ )
+
+[ names find names found ] is name? ( $ --> b )
+
+ forward is actions ( n --> x )
+
+[ ' actions ] is actiontable ( --> x )
+
+[ actiontable share tuck
+ findwith [ over oats ] drop
+ swap found ] is named? ( x --> b )
+
+ forward is reflect ( x --> x )
+[ dup nest? if
+ [ dup [] = if done
+ dup size 1 = iff
+ [ 0 peek
+ dup named? iff
+ nested done
+ reflect nested ]
+ done
+ dup size 2 / split
+ recurse swap
+ recurse join ] ] resolves reflect ( x --> x )
+
+[ stack ] is buildernest ( --> s )
+
+[ buildernest share ] is builders ( --> s )
+
+[ builders find
+ builders found ] is builder? ( $ --> b )
+
+ forward is jobs ( n --> x )
+
+[ ' jobs ] is jobtable ( --> [ )
+
+[ stack ] is message ( --> s )
+
+[ stack ] is b.nesting ( --> s )
+protect b.nesting
+
+[ stack ] is b.to-do ( --> s )
+
+[ $ '[' b.nesting put
+ [] swap ] is b.[ ( [ $ --> [ [ $ )
+
+[ b.nesting take dup
+ $ '' = if
+ [ $ 'Unexpected "]".'
+ message put
+ bail ]
+ dup $ '[' = iff drop
+ else
+ [ $ 'Nest mismatch: '
+ swap join $ ' ]' join
+ message put
+ bail ]
+ dip [ nested join ] ] is b.] ( [ [ $ --> [ $ )
+
+[ over [] = if
+ [ $ '"is" needs something to name before it.'
+ message put
+ bail ]
+ dup $ '' = if
+ [ $ '"is" needs a name after it.'
+ message put
+ bail ]
+ nextword nested
+ namenest take
+ join
+ namenest put
+ dip
+ [ -1 pluck
+ actiontable take
+ 1 stuff
+ actiontable put ] ] is b.is ( [ $ --> [ $ )
+
+[ over [] = if
+ [ $ '"builds" needs something to name before it.'
+ message put
+ bail ]
+ dup $ '' = if
+ [ $ '"builds" needs a name after it.'
+ message put
+ bail ]
+ nextword nested
+ buildernest take
+ join
+ buildernest put
+ dip
+ [ -1 pluck
+ jobtable take
+ 1 stuff
+ jobtable put ] ] is b.builds ( [ $ --> [ $ )
+
+[ trim nextword
+ dup $ '' = if
+ [ $ 'Unfinished comment.'
+ message put
+ bail ]
+ $ ')' = until ] is b.( ( [ $ --> $ [ )
+
+[ $ 'Unexpected ")".'
+ message put
+ bail ] is b.) ( [ $ --> $ [ )
+
+[ $ 'Unresolved reference.'
+ fail ] is unresolved ( --> )
+
+[ dip
+ [ ' [ unresolved ]
+ copy nested join ] ] is b.forward ( [ $ --> [ $ )
+
+ [ over [] = if
+ [ $ '"resolves" needs something to resolve.'
+ message put
+ bail ]
+ dup $ '' = if
+ [ $ '"resolves" needs a name to resolve into.'
+ message put
+ bail ]
+ dip [ -1 split ]
+ nextword dup temp put
+ names find
+ dup names found not if
+ [ $ 'Unknown word after "resolves": '
+ temp take join
+ message put
+ bail ]
+ actions
+ dup ' [ unresolved ] = not if
+ [ char " temp take join
+ $ '" is not an unresolved forward reference.'
+ join
+ message put
+ bail ]
+ rot 0 peek over
+ replace
+ ' unresolved swap
+ ' replace 2 b.to-do add-to
+ temp release ] is b.resolves ( [ $ --> [ $ )
+
+[ 1 split
+ over $ '' = if
+ [ $ '"char" needs a character after it.'
+ message put
+ bail ]
+ dip join ] is b.char ( [ $ --> [ $ )
+
+[ dup $ '' = if
+ [ $ '"$" needs to be followed by a string.'
+ message put
+ bail ]
+ behead over find
+ 2dup swap found not if
+ [ $ 'Endless string discovered.'
+ message put
+ bail ]
+ split behead drop
+ ' ' nested
+ rot nested join
+ nested swap dip join ] is b.$ ( [ $ --> [ $ )
+
+[ dup $ '' = if
+ [ $ '"say" needs to be followed by a string.'
+ message put
+ bail ]
+ $ '$' builders find jobs do
+ dip
+ [ -1 pluck
+ ' echo$ nested join
+ nested join ] ] is b.say ( [ $ --> [ $ )
+
+[ 16 base put
+ nextword dup
+ $ '' = if
+ [ $ '"hex" needs a number after it.'
+ message put
+ bail ]
+ dup $->n iff
+ [ nip swap dip join ]
+ else
+ [ drop
+ char " swap join
+ $ '" is not hexadecimal.'
+ join message put
+ bail ]
+ base release ] is b.hex ( [ $ --> [ $ )
+
+[ dip [ -1 split ] swap do ] is b.now! ( [ $ --> [ $ )
+
+[ over [] = if
+ [ $ '"constant" needs something before it.'
+ message put
+ bail ]
+ dip
+ [ -1 pluck do
+ dup number? not if
+ [ ' ' nested swap
+ nested join
+ nested ]
+ join ] ] is b.constant ( [ $ --> [ $ )
+
+[ ' [ namenest actiontable
+ buildernest jobtable ]
+ witheach
+ [ do share copy
+ history put ] ] is backupwords ( --> )
+
+[ ' [ jobtable buildernest
+ actiontable namenest ]
+ witheach
+ [ do dup release
+ history swap move ] ] is restorewords ( --> )
+
+[ 4 times
+ [ history release ] ] is releasewords ( --> )
+
+[ backupwords
+ b.to-do new-do
+ 1 backup
+ [ $ '' b.nesting put
+ decimal
+ [] swap
+ [ trim
+ dup $ '' = iff drop done
+ nextword
+ dup builders find
+ dup builders found iff
+ [ dip [ drop trim ]
+ jobs do ] again
+ drop
+ dup names find
+ dup names found iff
+ [ actions nested
+ nip swap dip join ] again
+ drop
+ dup $->n iff
+ [ nip swap dip join ] again
+ drop
+ $ 'Unknown word: '
+ swap join message put
bail ]
- dip
- [ -1 pluck do
- dup number? not if
- [ ' ' nested swap
- nested join
- nested ]
- join ] ] is b.constant ( [ $ --> [ $ )
-
- [ ' [ namenest actiontable
- buildernest jobtable ]
- witheach
- [ do share copy
- history put ] ] is backupwords ( --> )
-
- [ ' [ jobtable buildernest
- actiontable namenest ]
- witheach
- [ do dup release
- history swap move ] ] is restorewords ( --> )
-
- [ 4 times
- [ history release ] ] is releasewords ( --> )
-
- [ backupwords
- b.to-do new-do
- 1 backup
- [ $ '' b.nesting put
- decimal
- [] swap
- [ trim
- dup $ '' = iff drop done
- nextword
- dup builders find
- dup builders found iff
- [ dip [ drop trim ]
- jobs do ] again
- drop
- dup names find
- dup names found iff
- [ actions nested
- nip swap dip join ] again
- drop
- dup $->n iff
- [ nip swap dip join ] again
- drop
- $ 'Unknown word: '
- swap join message put
- bail ]
- base release
- b.nesting take dup
- $ '' = iff drop
- else
- [ $ 'Unfinished nest: '
- swap join message put
- bail ] ]
- bailed iff
- [ drop b.to-do now-do
- restorewords
- ' ' nested
- message take nested join
- ' echo$ nested join ]
- else
- [ b.to-do not-do
- releasewords ] ] is build ( $ --> [ )
-
- [ build do ] is quackery ( $ --> )
-
- [ stack -1 ] is nesting ( --> [ )
-
- forward is unbuild ( x --> $ )
-
- [ nesting share
- 0 = iff [ drop $ '...' ] done
- $ '' swap
- dup number? iff
- [ number$ join ] done
- actiontable share
- behead drop
- [ dup [] = iff
- [ drop false ] done
- behead
- rot tuck oats iff
- [ drop size 2 +
- actiontable share
- size swap -
- names swap peek join
- true ] done
- swap again ]
- if done
- dup nest? iff
- [ $ '[ ' rot join swap
- [ dup [] = iff drop done
- behead
- -1 nesting tally
- unbuild
- 1 nesting tally
- space join
- swap dip join again ]
- $ ']' join ]
- else
- [ drop
- $ "Quackery was worried by a python."
- fail ] ] resolves unbuild ( x --> $ )
-
- [ unbuild echo$ ] is echo ( x --> )
-
- [ $ ''
- return -2 split drop
- witheach
- [ dup number? iff
- [ number$ join
- $ '} ' join ]
+ base release
+ b.nesting take dup
+ $ '' = iff drop
else
- [ $ '{' swap dip join
- actiontable share
- findwith
- [ over oats ] drop
- dup actiontable share
- found iff
- [ 1 - names swap
- peek join
- space join ]
- else
- [ drop $ '[...] '
- join ] ] ]
- -1 split drop ] is return$ ( --> $ )
-
- [ return$ echo$ ] is echoreturn ( --> )
-
- [ stacksize dup 0 = iff
- [ $ 'Stack empty.' echo$ drop ]
- else
- [ $ 'Stack: ' echo$
- pack dup
- witheach [ echo sp ]
- unpack ]
- cr ] is echostack ( --> )
-
- [ cr $ '' $ '/O> '
- [ input
- dup $ '' != while
- carriage join join
- $ '... ' again ]
- drop
- quackery
- 5 nesting put
- cr echostack
- nesting release again ] is shell ( --> )
-
- [ cr randomise 12 random
- [ table
- $ 'Goodbye.' $ 'Adieu.' $ 'So long.'
- $ 'Cheerio.' $ 'Aloha.' $ 'Ciao.'
- $ 'Farewell.' $ 'Be seeing you.'
- $ 'Sayonara.' $ 'Auf wiedersehen.'
- $ 'Toodles.' $ 'Hasta la vista.' ]
- do echo$ cr cr
- 3 ]bailby[ ] is leave ( --> )
-
- [ stacksize times drop ] is empty ( all --> )
-
- [ tuck temp put
- witheach
- [ dup size
- rot + dup
- temp share > iff
- [ cr drop dup size ]
- else sp 1+ swap echo$ ]
- drop temp release ] is wrap$ ( [ n --> )
-
- [ names reverse 70 wrap$ cr
- builders reverse
- 70 wrap$ cr ] is words ( --> )
-
- [ dup name? iff drop
+ [ $ 'Unfinished nest: '
+ swap join message put
+ bail ] ]
+ bailed iff
+ [ drop b.to-do now-do
+ restorewords
+ ' ' nested
+ message take nested join
+ ' echo$ nested join ]
+ else
+ [ b.to-do not-do
+ releasewords ] ] is build ( $ --> [ )
+
+[ build do ] is quackery ( $ --> )
+
+[ stack -1 ] is nesting ( --> [ )
+
+ forward is unbuild ( x --> $ )
+
+[ nesting share
+ 0 = iff [ drop $ '...' ] done
+ $ '' swap
+ dup number? iff
+ [ number$ join ] done
+ actiontable share
+ behead drop
+ [ dup [] = iff
+ [ drop false ] done
+ behead
+ rot tuck oats iff
+ [ drop size 2 +
+ actiontable share
+ size swap -
+ names swap peek join
+ true ] done
+ swap again ]
+ if done
+ dup nest? iff
+ [ $ '[ ' rot join swap
+ [ dup [] = iff drop done
+ behead
+ -1 nesting tally
+ unbuild
+ 1 nesting tally
+ space join
+ swap dip join again ]
+ $ ']' join ]
+ else
+ [ drop
+ $ "Quackery was worried by a python."
+ fail ] ] resolves unbuild ( x --> $ )
+
+[ unbuild echo$ ] is echo ( x --> )
+
+[ $ ''
+ return -2 split drop
+ witheach
+ [ dup number? iff
+ [ number$ join
+ $ '} ' join ]
else
- [ dup sharefile not if
- [ $ |$ 'file not found: "|
- swap join
- $ |"' echo$| join ]
- nip quackery ] ] is loadfile ( $ --> )
-
- [ dup sharefile iff
- [ swap releasefile ]
- else [ drop false ] ] is takefile ( $ --> $ b )
-
- [ dup releasefile iff
- putfile
- else [ 2drop false ] ] is replacefile ( $ $ --> b )
-
- [ nested ' [ ' ]
- swap join
- decimal unbuild
- base release ] is quackify ( x --> $ )
-
- $ "quackify replacefile takefile loadfile words empty wrap$ leave
- shell echostack echoreturn return$ echo unbuild nesting quackery
- build releasewords restorewords backupwords unresolved b.to-do
- b.nesting message jobtable jobs builder? builders buildernest
- reflect named? actiontable actions name? names namenest nest$ oats
- bailed bail backup history shuffle random randomise initrandom
- prng prng.d prng.c prng.b prng.a rot64 64bits 64bitmask $->n
- char->n sort$ $> $< qacsfot sort sortwith sort.test not-do do-now
- now-do add-to new-do to-do unpack pack reverse nextword trim
- printable found findwith matchitem mi.result mi.tidyup echo$
- witheach makewith with.hold number$ decimal base digit lower upper
- sp space cr carriage findseq behead stuff pluck of table temp step
- refresh conclude i^ i times times.action times.count times.start
- abs decurse depth 2over 2swap dip dip.hold protect protected
- nested move tally replace release share stack while until recurse
- do this ' copy clamp max min else iff if done again 2drop 2dup
- within unrot tuck bit mod nip / - < xor != or and not true false
- sharefile releasefile putfile filepath input ding emit quid
- operator? number? nest? size poke peek find join split [] take
- immovable put ]bailby[ ]do[ ]this[ ]'[ ]else[ ]iff[ ]if[ ]again[
- ]done[ over rot swap drop dup return nestdepth stacksize time ~ ^
- | & >> << ** /mod * negate + 1+ > = nand fail python"
-
- nest$ namenest put
-
- [ table
- quackify replacefile takefile loadfile words empty wrap$ leave
- shell echostack echoreturn return$ echo unbuild nesting quackery
- build releasewords restorewords backupwords unresolved b.to-do
- b.nesting message jobtable jobs builder? builders buildernest
- reflect named? actiontable actions name? names namenest nest$ oats
- bailed bail backup history shuffle random randomise initrandom
- prng prng.d prng.c prng.b prng.a rot64 64bits 64bitmask $->n
- char->n sort$ $> $< qacsfot sort sortwith sort.test not-do do-now
- now-do add-to new-do to-do unpack pack reverse nextword trim
- printable found findwith matchitem mi.result mi.tidyup echo$
- witheach makewith with.hold number$ decimal base digit lower upper
- sp space cr carriage findseq behead stuff pluck of table temp step
- refresh conclude i^ i times times.action times.count times.start
- abs decurse depth 2over 2swap dip dip.hold protect protected
- nested move tally replace release share stack while until recurse
- do this ' copy clamp max min else iff if done again 2drop 2dup
- within unrot tuck bit mod nip / - < xor != or and not true false
- sharefile releasefile putfile filepath input ding emit quid
- operator? number? nest? size poke peek find join split [] take
- immovable put ]bailby[ ]do[ ]this[ ]'[ ]else[ ]iff[ ]if[ ]again[
- ]done[ over rot swap drop dup return nestdepth stacksize time ~ ^
- | & >> << ** /mod * negate + 1+ > = nand fail python ]
-
- resolves actions ( n --> x )
-
- $ "constant now! hex say $ char resolves forward ) ( builds is ] ["
- nest$ buildernest put
-
+ [ $ '{' swap dip join
+ actiontable share
+ findwith
+ [ over oats ] drop
+ dup actiontable share
+ found iff
+ [ 1 - names swap
+ peek join
+ space join ]
+ else
+ [ drop $ '[...] '
+ join ] ] ]
+ -1 split drop ] is return$ ( --> $ )
+
+[ return$ echo$ ] is echoreturn ( --> )
+
+[ stacksize dup 0 = iff
+ [ $ 'Stack empty.' echo$ drop ]
+ else
+ [ $ 'Stack: ' echo$
+ pack dup
+ witheach [ echo sp ]
+ unpack ]
+ cr ] is echostack ( --> )
+
+[ cr $ '' $ '/O> '
+ [ input
+ dup $ '' != while
+ carriage join join
+ $ '... ' again ]
+ drop
+ quackery
+ 5 nesting put
+ cr echostack
+ nesting release again ] is shell ( --> )
+
+[ cr randomise 12 random
[ table
- b.constant b.now! b.hex b.say b.$ b.char b.resolves
- b.forward b.) b.( b.builds b.is b.] b.[ ]
-
- resolves jobs ( n --> x )
+ $ 'Goodbye.' $ 'Adieu.' $ 'So long.'
+ $ 'Cheerio.' $ 'Aloha.' $ 'Ciao.'
+ $ 'Farewell.' $ 'Be seeing you.'
+ $ 'Sayonara.' $ 'Auf wiedersehen.'
+ $ 'Toodles.' $ 'Hasta la vista.' ]
+ do echo$ cr cr
+ 3 ]bailby[ ] is leave ( --> )
+
+[ stacksize times drop ] is empty ( all --> )
+
+[ tuck temp put
+ witheach
+ [ dup size
+ rot + dup
+ temp share > iff
+ [ cr drop dup size ]
+ else sp 1+ swap echo$ ]
+ drop temp release ] is wrap$ ( [ n --> )
+
+[ names reverse 70 wrap$ cr
+ builders reverse
+ 70 wrap$ cr ] is words ( --> )
+
+[ dup name? iff drop
+ else
+ [ dup sharefile not if
+ [ $ |$ 'file not found: "|
+ swap join
+ $ |"' echo$| join ]
+ nip quackery ] ] is loadfile ( $ --> )
+
+[ dup sharefile iff
+ [ swap releasefile ]
+ else [ drop false ] ] is takefile ( $ --> $ b )
+
+[ dup releasefile iff
+ putfile
+ else [ 2drop false ] ] is replacefile ( $ $ --> b )
+
+[ nested ' [ ' ]
+ swap join
+ decimal unbuild
+ base release ] is quackify ( x --> $ )
+
+$ "quackify replacefile takefile loadfile words empty wrap$ leave
+ shell echostack echoreturn return$ echo unbuild nesting quackery
+ build releasewords restorewords backupwords unresolved b.to-do
+ b.nesting message jobtable jobs builder? builders buildernest
+ reflect named? actiontable actions name? names namenest nest$ oats
+ bailed bail backup history shuffle random randomise initrandom
+ prng prng.d prng.c prng.b prng.a rot64 64bits 64bitmask $->n
+ char->n sort$ $> $< qacsfot sort sortwith sort.test not-do do-now
+ now-do add-to new-do to-do unpack pack reverse nextword trim
+ printable found findwith matchitem mi.result mi.tidyup echo$
+ witheach makewith with.hold number$ decimal base digit lower upper
+ sp space cr carriage findseq behead stuff pluck of table temp step
+ refresh conclude i^ i times times.action times.count times.start
+ abs decurse depth 2over 2swap dip dip.hold protect protected
+ nested move tally replace release share stack while until recurse
+ do this ' copy clamp max min else iff if done again 2drop 2dup
+ within unrot tuck bit mod nip / - < xor != or and not true false
+ sharefile releasefile putfile filepath input ding emit quid
+ operator? number? nest? size poke peek find join split [] take
+ immovable put ]bailby[ ]do[ ]this[ ]'[ ]else[ ]iff[ ]if[ ]again[
+ ]done[ over rot swap drop dup return nestdepth stacksize time ~ ^
+ | & >> << ** /mod * negate + 1+ > = nand fail python"
+
+nest$ namenest put
+
+[ table
+ quackify replacefile takefile loadfile words empty wrap$ leave
+ shell echostack echoreturn return$ echo unbuild nesting quackery
+ build releasewords restorewords backupwords unresolved b.to-do
+ b.nesting message jobtable jobs builder? builders buildernest
+ reflect named? actiontable actions name? names namenest nest$ oats
+ bailed bail backup history shuffle random randomise initrandom
+ prng prng.d prng.c prng.b prng.a rot64 64bits 64bitmask $->n
+ char->n sort$ $> $< qacsfot sort sortwith sort.test not-do do-now
+ now-do add-to new-do to-do unpack pack reverse nextword trim
+ printable found findwith matchitem mi.result mi.tidyup echo$
+ witheach makewith with.hold number$ decimal base digit lower upper
+ sp space cr carriage findseq behead stuff pluck of table temp step
+ refresh conclude i^ i times times.action times.count times.start
+ abs decurse depth 2over 2swap dip dip.hold protect protected
+ nested move tally replace release share stack while until recurse
+ do this ' copy clamp max min else iff if done again 2drop 2dup
+ within unrot tuck bit mod nip / - < xor != or and not true false
+ sharefile releasefile putfile filepath input ding emit quid
+ operator? number? nest? size poke peek find join split [] take
+ immovable put ]bailby[ ]do[ ]this[ ]'[ ]else[ ]iff[ ]if[ ]again[
+ ]done[ over rot swap drop dup return nestdepth stacksize time ~ ^
+ | & >> << ** /mod * negate + 1+ > = nand fail python ]
+
+ resolves actions ( n --> x )
+
+$ "constant now! hex say $ char resolves forward ) ( builds is ] ["
+nest$ buildernest put
+
+[ table
+ b.constant b.now! b.hex b.say b.$ b.char b.resolves
+ b.forward b.) b.( b.builds b.is b.] b.[ ]
+
+ resolves jobs ( n --> x )
"""
diff --git a/quackery_OOP.py b/quackery_OOP.py
new file mode 100644
index 0000000..28e31d4
--- /dev/null
+++ b/quackery_OOP.py
@@ -0,0 +1,1708 @@
+# [ quackery ]
+
+import time
+import sys
+import os
+import types
+try:
+ import readline
+except:
+ pass
+
+__all__ = ['QuackeryContext', 'quackery']
+
+def isNest(item):
+ return isinstance(item, list)
+
+def isNumber(item):
+ return isinstance(item, int)
+
+def isOperator(item):
+ return isinstance(item, types.FunctionType)
+
+def isinteger(numstr):
+ if len(numstr) > 0 and numstr[0] == '-':
+ numstr = numstr[1:]
+ return numstr.isdigit()
+
+def ishex(hexstr):
+ if len(hexstr) > 1 and hexstr[0] == '-':
+ hexstr = hexstr[1:]
+ return all(char.lower() in '0123456789abcdef' for char in hexstr)
+
+class QuackeryError(Exception):
+ pass
+
+class QuackeryContext:
+ def __init__(self, qstack = None, operators = None, builders = None):
+ self.qstack = [] if qstack is None else qstack
+ self.rstack = []
+ self.operators = predefined_operators.copy() if operators is None else operators
+ self.builders = predefined_builders.copy() if builders is None else builders
+ self.program_counter = 0
+ self.current_nest = []
+ self.source = ''
+ self.current_build = []
+
+ def copy(self):
+ new = QuackeryContext(self.qstack.copy(), self.operators.copy(), self.builders.copy())
+ new.rstack = self.rstack.copy()
+ new.program_counter = self.program_counter
+ new.current_nest = self.current_nest.copy()
+ new.source = self.source
+ new.current_build = self.current_build.copy()
+ return new
+
+ def expect_something(self):
+ if self.qstack == []:
+ self.failed('Stack unexpectedly empty.')
+
+ def top_of_stack(self):
+ return self.qstack[-1]
+
+ def expect_nest(self):
+ self.expect_something()
+ if not isNest(self.top_of_stack()):
+ self.failed('Expected nest on stack.')
+
+ def expect_number(self):
+ self.expect_something()
+ if not isNumber(self.top_of_stack()):
+ self.failed('Expected number on stack.')
+
+ def to_stack(self, item):
+ self.qstack.append(item)
+
+ def from_stack(self):
+ self.expect_something()
+ return self.qstack.pop()
+
+ def string_from_stack(self):
+ self.expect_nest()
+ result = ''
+ for ch in self.from_stack():
+ if ch == 13: # \r
+ result += '\n'
+ elif 31 < ch < 127:
+ result += chr(ch)
+ else:
+ result += '?' # XXX @dragoncoder047 maybe use \uFFFD on platforms that support unicode?
+ return result
+
+ def string_to_stack(self, string):
+ result = []
+ for ch in string:
+ if ch == '\n':
+ result.append(13)
+ elif 31 < ord(ch) < 127:
+ result.append(ord(ch))
+ else:
+ result.append(ord('?')) # XXX @dragoncoder047 maybe \0 or NULL to signify bad char?
+ self.to_stack(result)
+
+ def bool_to_stack(self, qbool):
+ self.to_stack(true if qbool else false)
+
+ def to_return(self, item):
+ self.rstack.append(item)
+
+ def from_return(self):
+ if len(self.rstack) == 0:
+ self.failed('Return stack unexpectedly empty.')
+ return self.rstack.pop()
+
+ def failed(self, message):
+ self.traverse(self.build("stacksize pack decimal unbuild ' base size 2 > if [ base release ] return$ nestdepth ]bailby["))
+ returnstack = self.string_from_stack()
+ thestack = self.string_from_stack()
+ raise QuackeryError('\n Problem: ' + message +
+ '\nQuackery Stack: ' + str(thestack)[2:-2] +
+ '\n Return stack: ' + str(returnstack))
+
+ def tick(self):
+ if self.program_counter >= len(self.current_nest):
+ self.program_counter = self.from_return()
+ self.current_nest = self.from_return()
+ self.program_counter += 1
+ return
+ current_item = self.current_nest[self.program_counter]
+ if isNest(current_item):
+ self.to_return(self.current_nest)
+ self.to_return(self.program_counter)
+ self.current_nest = current_item
+ self.program_counter = 0
+ elif isOperator(current_item):
+ current_item(self)
+ self.program_counter += 1
+ elif isNumber(current_item):
+ self.to_stack(current_item)
+ self.program_counter += 1
+ else:
+ self.failed('Quackery was worried by a python.')
+
+
+ def traverse(self, the_nest):
+ orig_depth = len(self.rstack)
+ self.to_return(self.current_nest)
+ self.to_return(self.program_counter)
+ self.current_nest = the_nest
+ self.program_counter = 0
+ while len(self.rstack) > orig_depth:
+ self.tick()
+
+ def next_char(self):
+ if len(self.source) > 0:
+ char = self.source[0]
+ self.source = self.source[1:]
+ return char
+ else:
+ return ''
+
+ def next_word(self):
+ result = ''
+ while True:
+ char = self.next_char()
+ if char == '':
+ return result
+ if ord(char) < 33:
+ if result == '':
+ continue
+ return result
+ result += char
+
+ def one_char(self):
+ while True:
+ char = self.next_char()
+ if char == '':
+ return char
+ if ord(char) < 33:
+ continue
+ return char
+
+ def get_name(self):
+ name = self.next_word()
+ if name == '':
+ raise EOFError('Unexpected end of program text.')
+ return name
+
+ def check_build(self):
+ if len(self.current_build) == 0:
+ raise IndexError('Nothing to name.')
+
+ def build(self, source_string):
+ self.source = source_string
+ nesting = 0
+
+ def sub_build():
+ nonlocal nesting
+ the_nest = []
+ while True:
+ self.current_build = the_nest
+ word = self.next_word()
+ if word == '':
+ return the_nest
+ elif word == '[':
+ nesting += 1
+ the_nest.append(sub_build())
+ elif word == ']':
+ nesting -= 1
+ if nesting < 0:
+ raise SyntaxError('Unexpected end of nest.')
+ return the_nest
+ elif word in self.builders:
+ self.builders[word](self)
+ elif word in self.operators:
+ the_nest.append(self.operators[word])
+ elif isinteger(word):
+ the_nest.append(int(word, 10))
+ else:
+ raise NameError('Unrecognised word: ' + word)
+
+ the_nest = sub_build()
+ if nesting > 0:
+ raise SyntaxError('Unfinished nest.')
+ return the_nest
+
+ def run(self, source_string):
+ self.traverse(self.build(source_string))
+
+
+
+def python(ctx):
+ """For backwards compatibility only"""
+ scope = {
+ "to_stack": ctx.to_stack,
+ "from_stack": ctx.from_stack,
+ "string_to_stack": ctx.string_to_stack,
+ "string_from_stack": ctx.string_from_stack,
+ "ctx": ctx,
+ }
+ try:
+ exec(ctx.string_from_stack(), scope, globals())
+ except QuackeryError:
+ raise
+ except Exception as diagnostics:
+ ctx.failed('Python reported: "' + str(diagnostics) + '"')
+
+def qfail(ctx):
+ ctx.failed(ctx.string_from_stack())
+
+def stack_size(ctx):
+ ctx.to_stack(len(ctx.qstack))
+
+def qreturn(ctx):
+ ctx.to_stack(ctx.rstack)
+
+def dup(ctx):
+ a = ctx.from_stack()
+ ctx.to_stack(a)
+ ctx.to_stack(a)
+
+def drop(ctx):
+ ctx.from_stack()
+
+def swap(ctx):
+ a = ctx.from_stack()
+ b = ctx.from_stack()
+ ctx.to_stack(a)
+ ctx.to_stack(b)
+
+def rot(ctx): # XXX @dragoncoder047 maybe simplify to [ dip swap swap ] is rot ? There are no cyclic references that would prevent this
+ a = ctx.from_stack()
+ swap(ctx)
+ ctx.to_stack(a)
+ swap(ctx)
+
+def over(ctx): # XXX @dragoncoder047 maybe simplify to [ dip dup swap ] is over ? same reason as above
+ a = ctx.from_stack()
+ dup(ctx)
+ ctx.to_stack(a)
+ swap(ctx)
+
+def nest_depth(ctx):
+ ctx.to_stack(len(ctx.rstack) // 2)
+
+true = 1
+
+false = 0
+
+def nand(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ ctx.expect_number()
+ ctx.bool_to_stack(ctx.from_stack() == false or a == false)
+
+def equal(ctx):
+ ctx.expect_something()
+ a = ctx.from_stack()
+ ctx.expect_something()
+ ctx.bool_to_stack(a == ctx.from_stack())
+
+def greater(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ ctx.expect_number()
+ ctx.bool_to_stack(ctx.from_stack() > a)
+
+def inc(ctx):
+ ctx.expect_number()
+ ctx.to_stack(1 + ctx.from_stack())
+
+def plus(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ ctx.expect_number()
+ ctx.to_stack(a + ctx.from_stack())
+
+def negate(ctx):
+ ctx.expect_number()
+ ctx.to_stack(-ctx.from_stack())
+
+def multiply(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ ctx.expect_number()
+ ctx.to_stack(a * ctx.from_stack())
+
+def qdivmod(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ if a == 0:
+ ctx.failed('Division by zero.')
+ ctx.expect_number()
+ results = divmod(ctx.from_stack(), a)
+ ctx.to_stack(results[0])
+ ctx.to_stack(results[1])
+
+def exponentiate(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ if a < 0:
+ ctx.failed('Tried to raise to a negative power: ' + str(a))
+ ctx.expect_number()
+ ctx.to_stack(ctx.from_stack() ** a)
+
+def shift_left(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ if a < 0:
+ ctx.failed('Cannot << by a negative amount: ' + str(a))
+ ctx.expect_number()
+ ctx.to_stack(ctx.from_stack() << a)
+
+def shift_right(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ if a < 0:
+ ctx.failed('Cannot >> by a negative amount: ' + str(a))
+ ctx.expect_number()
+ ctx.to_stack(ctx.from_stack() >> a)
+
+def bitwise_and(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ ctx.expect_number()
+ ctx.to_stack(a & ctx.from_stack())
+
+def bitwise_or(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ ctx.expect_number()
+ ctx.to_stack(a | ctx.from_stack())
+
+def bitwise_xor(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ ctx.expect_number()
+ ctx.to_stack(a ^ ctx.from_stack())
+
+def bitwise_not(ctx):
+ ctx.expect_number()
+ ctx.to_stack(~ctx.from_stack())
+
+def qtime(ctx):
+ ctx.to_stack(int(time.time()*1000000))
+
+def meta_done(ctx):
+ ctx.from_return()
+ ctx.from_return()
+
+def meta_again(ctx):
+ ctx.from_return()
+ ctx.to_return(-1)
+
+def meta_if(ctx):
+ ctx.expect_number()
+ if ctx.from_stack() == 0:
+ ctx.to_return(ctx.from_return() + 1)
+
+def meta_iff(ctx):
+ ctx.expect_number()
+ if ctx.from_stack() == 0:
+ ctx.to_return(ctx.from_return() + 2)
+
+def meta_else(ctx):
+ ctx.to_return(ctx.from_return() + 1)
+
+def meta_literal(ctx):
+ pc = ctx.from_return() + 1
+ return_nest = ctx.from_return()
+ if len(return_nest) == pc:
+ ctx.failed('Found a "\'" at the end of a nest.')
+ ctx.to_stack(return_nest[pc])
+ ctx.to_return(return_nest)
+ ctx.to_return(pc)
+
+def meta_this(ctx):
+ pc = ctx.from_return()
+ return_nest = ctx.from_return()
+ ctx.to_stack(return_nest)
+ ctx.to_return(return_nest)
+ ctx.to_return(pc)
+
+def meta_do(ctx):
+ ctx.expect_something()
+ the_thing = ctx.from_stack()
+ if not isNest(the_thing):
+ the_thing = [the_thing]
+ ctx.to_return(the_thing)
+ ctx.to_return(-1)
+
+def meta_bail_by(ctx):
+ ctx.expect_number()
+ a = 2 * ctx.from_stack()
+ if a <= len(ctx.rstack):
+ for _ in range(a):
+ ctx.from_return()
+ else:
+ ctx.failed('Bailed out of Quackery.')
+
+def qput(ctx):
+ ctx.expect_nest()
+ a = ctx.from_stack()
+ ctx.expect_something()
+ b = ctx.from_stack()
+ a.append(b)
+
+def immovable(ctx):
+ pass
+
+def take(ctx):
+ ctx.expect_nest()
+ a = ctx.from_stack()
+ if len(a) == 0:
+ ctx.failed('Unexpectedly empty nest.')
+ if len(a) == 1:
+ if isNest(a[0]) and len(a[0]) > 0 and a[0][0] == immovable:
+ ctx.failed('Cannot remove an immovable item.')
+ ctx.to_stack(a.pop())
+
+def create_nest(ctx):
+ ctx.to_stack([])
+
+def qsplit(ctx):
+ ctx.expect_number()
+ a = ctx.from_stack()
+ ctx.expect_nest()
+ b = ctx.from_stack()
+ ctx.to_stack(b[:a])
+ ctx.to_stack(b[a:])
+
+def join(ctx):
+ ctx.expect_something()
+ b = ctx.from_stack()
+ if not isNest(b):
+ b = [b]
+ ctx.expect_something()
+ a = ctx.from_stack()
+ if not isNest(a):
+ a = [a]
+ ctx.to_stack(a + b)
+
+def qsize(ctx):
+ ctx.expect_nest()
+ ctx.to_stack(len(ctx.from_stack()))
+
+def qfind(ctx):
+ ctx.expect_nest()
+ nest = ctx.from_stack()
+ ctx.expect_something()
+ a = ctx.from_stack()
+ if a in nest:
+ ctx.to_stack(nest.index(a))
+ else:
+ ctx.to_stack(len(nest))
+
+def peek(ctx):
+ ctx.expect_number()
+ index = ctx.from_stack()
+ ctx.expect_nest()
+ nest = ctx.from_stack()
+ if index >= len(nest) or (
+ index < 0 and len(nest) < abs(index)):
+ ctx.failed('Cannot peek an item outside a nest.')
+ else:
+ ctx.to_stack(nest[index])
+
+def poke(ctx):
+ ctx.expect_number()
+ index = ctx.from_stack()
+ ctx.expect_nest()
+ nest = ctx.from_stack().copy()
+ ctx.expect_something()
+ value = ctx.from_stack()
+ if index >= len(nest) or (
+ index < 0 and len(nest) < abs(index)):
+ ctx.failed('Cannot poke an item outside a nest.')
+ else:
+ nest[index] = value
+ ctx.to_stack(nest)
+
+def qnest(ctx):
+ ctx.expect_something()
+ ctx.bool_to_stack(isNest(ctx.from_stack()))
+
+def qnumber(ctx):
+ ctx.expect_something()
+ ctx.bool_to_stack(isNumber(ctx.from_stack()))
+
+def qoperator(ctx):
+ ctx.expect_something()
+ ctx.bool_to_stack(isOperator(ctx.from_stack()))
+
+def quid(ctx):
+ ctx.expect_something()
+ ctx.to_stack(id(ctx.from_stack()))
+
+def qemit(ctx):
+ ctx.expect_number()
+ char = ctx.from_stack()
+ if char == 13:
+ sys.stdout.write('\r\n')
+ elif 31 < char < 127:
+ sys.stdout.write(chr(char))
+ else:
+ sys.stdout.write('?') # XXX @dragoncoder047 maybe use \uFFFD on platforms that support unicode?
+
+def ding(ctx):
+ sys.stdout.write('\a')
+
+def qinput(ctx):
+ prompt = ctx.string_from_stack()
+ ctx.string_to_stack(input(prompt))
+
+filepath = []
+
+def putfile(ctx):
+ filename = ctx.string_from_stack()
+ if len(filepath) > 1:
+ ctx.to_stack(filepath[-1])
+ filename = ctx.string_from_stack() + filename
+ filetext = ctx.string_from_stack()
+ try:
+ with open(filename, 'x'): pass
+ except FileExistsError:
+ ctx.to_stack(false)
+ except:
+ raise
+ else:
+ try:
+ with open(filename, 'w') as f: f.write(filetext)
+ except:
+ raise
+ else:
+ ctx.to_stack(true)
+
+def releasefile(ctx):
+ filename = ctx.string_from_stack()
+ if len(filepath) > 1:
+ ctx.to_stack(filepath[-1])
+ filename = ctx.string_from_stack() + filename
+ try:
+ os.remove(filename)
+ except FileNotFoundError:
+ ctx.to_stack(false)
+ except:
+ raise
+ else:
+ ctx.to_stack(true)
+
+def sharefile(ctx):
+ dup(ctx)
+ filename = ctx.string_from_stack()
+ if len(filepath) > 1:
+ ctx.to_stack(filepath[-1])
+ filename = ctx.string_from_stack() + filename
+ try:
+ with open(filename) as f: filetext = f.read()
+ except FileNotFoundError:
+ ctx.to_stack(false)
+ except:
+ raise
+ else:
+ drop(ctx)
+ ctx.string_to_stack(filetext)
+ ctx.to_stack(true)
+
+predefined_operators = {
+ 'python': python, # ( $ --> )
+ 'fail': qfail, # ( $ --> )
+ 'nand': nand, # ( b b --> b )
+ '=': equal, # ( x x --> b )
+ '>': greater, # ( n n --> b )
+ '1+': inc, # ( n --> n )
+ '+': plus, # ( n n --> n )
+ 'negate': negate, # ( n --> n )
+ '*': multiply, # ( n n --> n )
+ '/mod': qdivmod, # ( n n --> n n )
+ '**': exponentiate, # ( n n --> n )
+ '<<': shift_left, # ( f n --> f )
+ '>>': shift_right, # ( f n --> f )
+ '&': bitwise_and, # ( f f --> f )
+ '|': bitwise_or, # ( f f --> f )
+ '^': bitwise_xor, # ( f f --> f )
+ '~': bitwise_not, # ( f --> f )
+ 'time': qtime, # ( --> n )
+ 'stacksize': stack_size, # ( --> n )
+ 'nestdepth': nest_depth, # ( --> n )
+ 'return': qreturn, # ( --> [ )
+ 'dup': dup, # ( x --> x x )
+ 'drop': drop, # ( x --> )
+ 'swap': swap, # ( x x --> x x )
+ 'rot': rot, # ( x x x --> x x x )
+ 'over': over, # ( x x --> x x x )
+ ']done[': meta_done, # ( --> )
+ ']again[': meta_again, # ( --> )
+ ']if[': meta_if, # ( b --> )
+ ']iff[': meta_iff, # ( b --> )
+ ']else[': meta_else, # ( --> )
+ "]'[": meta_literal, # ( --> x )
+ ']this[': meta_this, # ( --> [ )
+ ']do[': meta_do, # ( x --> )
+ ']bailby[': meta_bail_by, # ( n --> )
+ 'put': qput, # ( x [ --> )
+ 'immovable': immovable, # ( --> )
+ 'take': take, # ( [ --> x )
+ '[]': create_nest, # ( --> n )
+ 'split': qsplit, # ( [ n --> [ [ )
+ 'join': join, # ( x x --> [ )
+ 'find': qfind, # ( x --> b )
+ 'peek': peek, # ( [ n --> x )
+ 'poke': poke, # ( x [ n --> )
+ 'size': qsize, # ( [ --> n )
+ 'nest?': qnest, # ( x --> b )
+ 'number?': qnumber, # ( x --> b )
+ 'operator?': qoperator, # ( x --> b )
+ 'quid': quid, # ( x --> n )
+ 'emit': qemit, # ( c --> )
+ 'ding': ding, # ( --> )
+ 'input': qinput, # ( $ --> $ )
+ 'filepath': filepath, # ( --> s )
+ 'putfile': putfile, # ( $ --> b )
+ 'releasefile': releasefile, # ( $ --> b )
+ 'sharefile': sharefile # ( $ --> $ b )
+}
+
+def qis(ctx):
+ ctx.check_build()
+ name = ctx.get_name()
+ ctx.operators[name] = ctx.current_build.pop()
+
+def qcomment(ctx):
+ word = ''
+ while word != ')':
+ word = ctx.next_word()
+ if word == '':
+ raise EOFError('Unclosed comment.')
+
+def endcomment(ctx):
+ raise SyntaxError('Too many end of comments.')
+
+def unresolved(ctx):
+ raise TypeError('Unresolved forward reference.')
+
+def forward(ctx):
+ ctx.current_build.append([unresolved])
+
+def resolves(ctx):
+ name = ctx.get_name()
+ if name in ctx.operators:
+ if ctx.operators[name][0] != unresolved:
+ raise TypeError(name + ' is not a forward reference.')
+ ctx.check_build()
+ ctx.operators[name][0] = ctx.current_build.pop()
+ else:
+ raise NameError('Unrecognised word: ' + name)
+
+def char_literal(ctx):
+ char = ctx.one_char()
+ if char == '':
+ raise SyntaxError('No character found.')
+ ctx.current_build.append(ord(char))
+
+def string_literal(ctx):
+ delimiter = ''
+ result = []
+ while delimiter == '':
+ char = ctx.next_char()
+ if char == '':
+ raise EOFError('No string found.')
+ if ord(char) > 32:
+ delimiter = char
+ char = ''
+ while char != delimiter:
+ char = ctx.next_char()
+ if char == '':
+ raise EOFError('Endless string discovered.')
+ if char != delimiter:
+ result.append(ord(char))
+ ctx.current_build.append([[meta_literal], result])
+
+def hexnum(ctx):
+ word = ctx.get_name()
+ if not ishex(word):
+ raise SyntaxError(word + " is not hexadecimal.")
+ ctx.current_build.append(int(word, 16))
+
+predefined_builders = {
+ 'is': qis,
+ '(': qcomment,
+ ')': endcomment,
+ 'forward': forward,
+ 'resolves': resolves,
+ 'char': char_literal,
+ '$': string_literal,
+ 'hex': hexnum
+}
+
+
+predefined_qky = r"""
+
+[ 0 ] is false ( --> b )
+
+[ 1 ] is true ( --> b )
+
+[ dup nand ] is not ( b --> b )
+
+[ nand not ] is and ( b b --> b )
+
+[ not swap not nand ] is or ( b b --> b )
+
+[ = not ] is != ( x x --> b )
+
+[ not swap not != ] is xor ( b b --> b )
+
+[ swap > ] is < ( n n --> b )
+
+[ negate + ] is - ( n --> n )
+
+[ /mod drop ] is / ( n n --> n )
+
+[ swap drop ] is nip ( x x --> x )
+
+[ /mod nip ] is mod ( n n --> n )
+
+[ 1 swap << ] is bit ( n --> n )
+
+[ swap over ] is tuck ( x x --> x x x )
+
+[ rot rot ] is unrot ( x x x --> x x x )
+
+[ rot tuck >
+ unrot > not and ] is within ( n n n --> b )
+
+[ over over ] is 2dup ( x x --> x x x x )
+
+[ drop drop ] is 2drop ( x x --> )
+
+[ ]again[ ] is again ( --> )
+
+[ ]done[ ] is done ( --> )
+
+[ ]if[ ] is if ( b --> )
+
+[ ]iff[ ] is iff ( b --> )
+
+[ ]else[ ] is else ( --> )
+
+[ 2dup > if swap drop ] is min ( n n n --> n )
+
+[ 2dup < if swap drop ] is max ( n n n --> n )
+
+[ rot min max ] is clamp ( n n n --> n )
+
+[ dup nest? iff [] join ] is copy ( [ --> [ )
+
+[ ]'[ ] is ' ( --> x )
+
+[ ]this[ ] is this ( --> [ )
+
+[ ]do[ ] is do ( x --> )
+
+[ ]this[ do ] is recurse ( --> )
+
+[ not if ]again[ ] is until ( b --> )
+
+[ not if ]done[ ] is while ( b --> )
+
+[ immovable ]this[ ]done[ ] is stack ( --> s )
+
+[ dup take dup rot put ] is share ( s --> x )
+
+[ take drop ] is release ( s --> )
+
+[ dup release put ] is replace ( x s --> )
+
+[ dup take rot + swap put ] is tally ( n s --> )
+
+[ swap take swap put ] is move ( s s --> )
+
+[ [] tuck put ] is nested ( x --> [ )
+
+[ stack [ ] ] is protected ( --> s )
+
+[ protected take
+ ]'[ nested join
+ protected put ] is protect ( --> )
+
+' stack ' filepath put
+protect filepath
+
+[ stack ] is dip.hold ( --> s )
+protect dip.hold
+
+[ dip.hold put
+ ]'[ do dip.hold take ] is dip ( x --> x )
+
+[ rot dip rot ] is 2swap ( x x x x --> x x x x )
+
+[ dip [ dip 2dup ] 2swap ] is 2over ( x x x x --> x x x x x x )
+
+[ stack ] is depth ( --> s )
+protect depth
+
+[ depth share
+ 0 != while
+ -1 depth tally
+ ]this[ do
+ 1 depth tally ] is decurse ( --> )
+
+[ dup 0 < if negate ] is abs ( n --> n )
+
+[ stack ] is times.start ( --> s )
+protect times.start
+
+[ stack ] is times.count ( --> s )
+protect times.count
+
+[ stack ] is times.action ( --> s )
+protect times.action
+
+[ ]'[ times.action put
+ dup times.start put
+ [ 1 - dup -1 > while
+ times.count put
+ times.action share do
+ times.count take again ]
+ drop
+ times.action release
+ times.start release ] is times ( n --> )
+
+[ times.count share ] is i ( --> n )
+
+[ times.start share i 1+ - ] is i^ ( --> n )
+
+[ 0 times.count replace ] is conclude ( --> )
+
+[ times.start share
+ times.count replace ] is refresh ( --> )
+
+[ times.count take 1+
+ swap - times.count put ] is step ( --> s )
+
+[ stack ] is temp ( --> s )
+protect temp
+
+[ immovable
+ dup -1 > +
+ ]this[ swap peek
+ ]done[ ] is table ( n --> x )
+
+[ [] unrot
+ dup 1 < iff 2drop done
+ [ 2 /mod over while
+ if [ dip [ tuck join swap ] ]
+ dip [ dup join ]
+ again ] 2drop join ] is of ( x n --> [ )
+
+[ split 1 split
+ swap dip join
+ 0 peek ] is pluck ( [ n --> [ x )
+
+[ split
+ rot nested
+ swap join join ] is stuff ( x [ n --> [ )
+
+[ 0 pluck ] is behead ( [ --> [ x )
+
+[ over size over size
+ dup temp put
+ swap - 1+ times
+ [ 2dup over size split
+ drop = if
+ [ i^ temp replace
+ conclude ]
+ behead drop ]
+ 2drop temp take ] is findseq ( [ [ --> n )
+
+[ 13 ] is carriage ( --> c )
+
+[ carriage emit ] is cr ( --> )
+
+[ 32 ] is space ( --> c )
+
+[ space emit ] is sp ( --> )
+
+[ dup char a char { within
+ if [ 32 - ] ] is upper ( c --> c )
+
+[ dup char A char [ within
+ if [ 32 + ] ] is lower ( c --> c )
+
+[ dup 10 <
+ iff 48 else 55 + ] is digit ( n --> c )
+
+[ stack 10 ] is base ( --> s )
+protect base
+
+[ 10 base put ] is decimal ( --> )
+
+[ $ '' over abs
+ [ base share /mod digit
+ rot join swap
+ dup 0 = until ]
+ drop
+ swap 0 < if
+ [ $ '-' swap join ] ] is number$ ( n --> $ )
+
+[ stack ] is with.hold ( --> s )
+protect with.hold
+
+[ nested
+ ' [ dup with.hold put
+ size times ]
+ ' [ with.hold share
+ i ~ peek ]
+ rot join
+ nested join
+ ' [ with.hold release ]
+ join ] is makewith ( x --> [ )
+
+[ ]'[ makewith do ] is witheach ( [ --> )
+
+[ witheach emit ] is echo$ ( $ --> )
+
+[ stack ] is mi.tidyup ( --> s )
+protect mi.tidyup
+
+[ stack ] is mi.result ( --> s )
+protect mi.result
+
+[ mi.tidyup put
+ over size mi.result put
+ nested
+ ' [ if
+ [ i^ mi.result replace
+ conclude ] ]
+ join makewith do
+ mi.tidyup take do
+ mi.result take ] is matchitem ( [ x x --> n )
+
+[ ]'[ ]'[ matchitem ] is findwith ( [ --> n )
+
+[ size < ] is found ( n [ --> b )
+
+[ space > ] is printable ( c --> b )
+
+[ dup findwith
+ printable [ ]
+ split nip ] is trim ( $ --> $ )
+
+[ dup findwith
+ [ printable not ] [ ]
+ split swap ] is nextword ( $ --> $ $ )
+
+[ dup nest? if
+ [ dup size 2 < if done
+ dup size 2 / split
+ recurse swap
+ recurse join ] ] is reverse ( x --> x )
+
+[ [] swap times
+ [ swap nested join ]
+ reverse ] is pack ( * n --> [ )
+
+[ witheach [ ] ] is unpack ( [ --> * )
+
+[ stack ] is to-do ( --> s )
+protect to-do
+
+[ ' done swap put ] is new-do ( s --> )
+
+[ dip [ 1+ pack ] put ] is add-to ( * x n s --> )
+
+[ [ dup take
+ unpack do again ] drop ] is now-do ( s --> )
+
+[ 1 split reverse join
+ now-do ] is do-now ( s --> )
+
+[ [ dup take ' done = until ]
+ drop ] is not-do ( s --> )
+
+[ stack ] is sort.test ( --> s )
+protect sort.test
+
+[ ]'[ sort.test put
+ [] swap witheach
+ [ swap 2dup findwith
+ [ over sort.test share
+ do ] [ ]
+ nip stuff ]
+ sort.test release ] is sortwith ( [ --> [ )
+
+[ sortwith > ] is sort ( [ --> [ )
+
+[ 32 127 clamp 32 -
+ [ table
+ 0 86 88 93 94 90 92 87 63 64 75 73 82 74 81 76
+ 1 2 3 4 5 6 7 8 9 10 83 84 69 72 70 85
+ 91 11 13 15 17 19 21 23 25 27 29 31 33 35 37 39
+ 41 43 45 47 49 51 53 55 57 59 61 65 78 66 77 80
+ 89 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40
+ 42 44 46 48 50 52 54 56 58 60 62 67 79 68 71 0 ]
+] is qacsfot ( c --> n )
+
+[ [ dup $ '' = iff false done
+ over $ '' = iff true done
+ behead rot behead rot
+ 2dup = iff [ 2drop swap ] again
+ qacsfot swap qacsfot > ]
+ unrot 2drop ] is $< ( $ $ --> b )
+
+[ swap $< ] is $> ( $ $ --> b )
+
+[ sortwith $> ] is sort$ ( [ --> [ )
+
+[ upper 47 - 0 44 clamp
+ [ table
+ -1 0 1 2 3 4 5 6 7 8 9 -1 -1 -1 -1
+ -1 -1 -1 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 -1 ]
+ dup 0 base share
+ within not if [ drop -1 ] ] is char->n ( c --> n )
+
+[ dup $ '' = iff [ drop 0 false ] done
+ dup 0 peek char - =
+ tuck if [ behead drop ]
+ dup $ '' = iff [ 2drop 0 false ] done
+ true 0 rot witheach
+ [ char->n
+ dup 0 < iff [ drop nip false swap ]
+ else [ swap base share * + ] ]
+ rot if negate
+ swap ] is $->n ( $ --> n b )
+
+( adapted from 'A small noncryptographic PRNG' by Bob Jenkins )
+( https://burtleburtle.net/bob/rand/smallprng.html )
+
+[ hex FFFFFFFFFFFFFFFF ] is 64bitmask ( --> f )
+
+[ 64bitmask & ] is 64bits ( f --> f )
+
+[ dip 64bits 2dup << 64bits
+ unrot 64 swap - >> | ] is rot64 ( f n --> f )
+
+[ stack 0 ] is prng.a ( --> s )
+[ stack 0 ] is prng.b ( --> s )
+[ stack 0 ] is prng.c ( --> s )
+[ stack 0 ] is prng.d ( --> s )
+
+[ prng.a share
+ prng.b share tuck
+ 7 rot64 - 64bits swap
+ prng.c share tuck
+ 13 rot64 ^ prng.a replace
+ prng.d share tuck
+ 37 rot64 + 64bits prng.b replace
+ over + 64bits prng.c replace
+ prng.a share + 64bits
+ dup prng.d replace ] is prng ( --> n )
+
+[ hex F1EA5EAD prng.a replace
+ dup prng.b replace
+ dup prng.c replace
+ prng.d replace
+ 20 times [ prng drop ] ] is initrandom ( n --> )
+
+hex DEFACEABADFACADE initrandom
+
+[ time initrandom ] is randomise ( --> )
+
+[ 64bitmask 1+
+ over / over *
+ [ prng 2dup > not while
+ drop again ]
+ nip swap mod ] is random ( n --> n )
+
+[ [] swap dup size times
+ [ dup size random pluck
+ nested rot join swap ]
+ drop ] is shuffle ( [ --> [ )
+
+[ stack ] is history ( --> s )
+
+[ protected share history put
+ protected share 0
+ [ over size over
+ > while
+ 2dup peek
+ size unrot
+ 1+ again ]
+ 2drop
+ protected share size pack
+ history put
+ pack dup history put unpack
+ stacksize history put
+ nestdepth history put
+ false history put ] is backup ( n --> )
+
+[ history release
+ nestdepth
+ history take
+ - ]bailby[
+ true history put ] is bail ( --> )
+
+[ history take iff
+ [ stacksize
+ history take
+ history share
+ size - - times drop
+ history take unpack
+ history take unpack
+ history share size
+ [ dup 0 > while
+ 1 -
+ history share
+ over peek
+ rot over size
+ swap -
+ [ dup 0 > while
+ over release
+ 1 - again ]
+ 2drop again ]
+ drop
+ history take
+ protected replace
+ true ]
+ else
+ [ 5 times
+ [ history release ]
+ false ] ] is bailed ( --> b )
+
+[ quid swap quid = ] is oats ( x x --> b )
+
+[ [] swap
+ [ trim
+ dup size while
+ nextword nested
+ swap dip join again ]
+ drop ] is nest$ ( $ --> [ )
+
+[ stack ] is namenest ( --> s )
+
+[ namenest share ] is names ( --> [ )
+
+[ names find names found ] is name? ( $ --> b )
+
+ forward is actions ( n --> x )
+
+[ ' actions ] is actiontable ( --> x )
+
+[ actiontable share tuck
+ findwith [ over oats ] drop
+ swap found ] is named? ( x --> b )
+
+ forward is reflect ( x --> x )
+[ dup nest? if
+ [ dup [] = if done
+ dup size 1 = iff
+ [ 0 peek
+ dup named? iff
+ nested done
+ reflect nested ]
+ done
+ dup size 2 / split
+ recurse swap
+ recurse join ] ] resolves reflect ( x --> x )
+
+[ stack ] is buildernest ( --> s )
+
+[ buildernest share ] is builders ( --> s )
+
+[ builders find
+ builders found ] is builder? ( $ --> b )
+
+ forward is jobs ( n --> x )
+
+[ ' jobs ] is jobtable ( --> [ )
+
+[ stack ] is message ( --> s )
+
+[ stack ] is b.nesting ( --> s )
+protect b.nesting
+
+[ stack ] is b.to-do ( --> s )
+
+[ $ '[' b.nesting put
+ [] swap ] is b.[ ( [ $ --> [ [ $ )
+
+[ b.nesting take dup
+ $ '' = if
+ [ $ 'Unexpected "]".'
+ message put
+ bail ]
+ dup $ '[' = iff drop
+ else
+ [ $ 'Nest mismatch: '
+ swap join $ ' ]' join
+ message put
+ bail ]
+ dip [ nested join ] ] is b.] ( [ [ $ --> [ $ )
+
+[ over [] = if
+ [ $ '"is" needs something to name before it.'
+ message put
+ bail ]
+ dup $ '' = if
+ [ $ '"is" needs a name after it.'
+ message put
+ bail ]
+ nextword nested
+ namenest take
+ join
+ namenest put
+ dip
+ [ -1 pluck
+ actiontable take
+ 1 stuff
+ actiontable put ] ] is b.is ( [ $ --> [ $ )
+
+[ over [] = if
+ [ $ '"builds" needs something to name before it.'
+ message put
+ bail ]
+ dup $ '' = if
+ [ $ '"builds" needs a name after it.'
+ message put
+ bail ]
+ nextword nested
+ buildernest take
+ join
+ buildernest put
+ dip
+ [ -1 pluck
+ jobtable take
+ 1 stuff
+ jobtable put ] ] is b.builds ( [ $ --> [ $ )
+
+[ trim nextword
+ dup $ '' = if
+ [ $ 'Unfinished comment.'
+ message put
+ bail ]
+ $ ')' = until ] is b.( ( [ $ --> $ [ )
+
+[ $ 'Unexpected ")".'
+ message put
+ bail ] is b.) ( [ $ --> $ [ )
+
+[ $ 'Unresolved reference.'
+ fail ] is unresolved ( --> )
+
+[ dip
+ [ ' [ unresolved ]
+ copy nested join ] ] is b.forward ( [ $ --> [ $ )
+
+ [ over [] = if
+ [ $ '"resolves" needs something to resolve.'
+ message put
+ bail ]
+ dup $ '' = if
+ [ $ '"resolves" needs a name to resolve into.'
+ message put
+ bail ]
+ dip [ -1 split ]
+ nextword dup temp put
+ names find
+ dup names found not if
+ [ $ 'Unknown word after "resolves": '
+ temp take join
+ message put
+ bail ]
+ actions
+ dup ' [ unresolved ] = not if
+ [ char " temp take join
+ $ '" is not an unresolved forward reference.'
+ join
+ message put
+ bail ]
+ rot 0 peek over
+ replace
+ ' unresolved swap
+ ' replace 2 b.to-do add-to
+ temp release ] is b.resolves ( [ $ --> [ $ )
+
+[ 1 split
+ over $ '' = if
+ [ $ '"char" needs a character after it.'
+ message put
+ bail ]
+ dip join ] is b.char ( [ $ --> [ $ )
+
+[ dup $ '' = if
+ [ $ '"$" needs to be followed by a string.'
+ message put
+ bail ]
+ behead over find
+ 2dup swap found not if
+ [ $ 'Endless string discovered.'
+ message put
+ bail ]
+ split behead drop
+ ' ' nested
+ rot nested join
+ nested swap dip join ] is b.$ ( [ $ --> [ $ )
+
+[ dup $ '' = if
+ [ $ '"say" needs to be followed by a string.'
+ message put
+ bail ]
+ $ '$' builders find jobs do
+ dip
+ [ -1 pluck
+ ' echo$ nested join
+ nested join ] ] is b.say ( [ $ --> [ $ )
+
+[ 16 base put
+ nextword dup
+ $ '' = if
+ [ $ '"hex" needs a number after it.'
+ message put
+ bail ]
+ dup $->n iff
+ [ nip swap dip join ]
+ else
+ [ drop
+ char " swap join
+ $ '" is not hexadecimal.'
+ join message put
+ bail ]
+ base release ] is b.hex ( [ $ --> [ $ )
+
+[ dip [ -1 split ] swap do ] is b.now! ( [ $ --> [ $ )
+
+[ over [] = if
+ [ $ '"constant" needs something before it.'
+ message put
+ bail ]
+ dip
+ [ -1 pluck do
+ dup number? not if
+ [ ' ' nested swap
+ nested join
+ nested ]
+ join ] ] is b.constant ( [ $ --> [ $ )
+
+[ ' [ namenest actiontable
+ buildernest jobtable ]
+ witheach
+ [ do share copy
+ history put ] ] is backupwords ( --> )
+
+[ ' [ jobtable buildernest
+ actiontable namenest ]
+ witheach
+ [ do dup release
+ history swap move ] ] is restorewords ( --> )
+
+[ 4 times
+ [ history release ] ] is releasewords ( --> )
+
+[ backupwords
+ b.to-do new-do
+ 1 backup
+ [ $ '' b.nesting put
+ decimal
+ [] swap
+ [ trim
+ dup $ '' = iff drop done
+ nextword
+ dup builders find
+ dup builders found iff
+ [ dip [ drop trim ]
+ jobs do ] again
+ drop
+ dup names find
+ dup names found iff
+ [ actions nested
+ nip swap dip join ] again
+ drop
+ dup $->n iff
+ [ nip swap dip join ] again
+ drop
+ $ 'Unknown word: '
+ swap join message put
+ bail ]
+ base release
+ b.nesting take dup
+ $ '' = iff drop
+ else
+ [ $ 'Unfinished nest: '
+ swap join message put
+ bail ] ]
+ bailed iff
+ [ drop b.to-do now-do
+ restorewords
+ ' ' nested
+ message take nested join
+ ' echo$ nested join ]
+ else
+ [ b.to-do not-do
+ releasewords ] ] is build ( $ --> [ )
+
+[ build do ] is quackery ( $ --> )
+
+[ stack -1 ] is nesting ( --> [ )
+
+ forward is unbuild ( x --> $ )
+
+[ nesting share
+ 0 = iff [ drop $ '...' ] done
+ $ '' swap
+ dup number? iff
+ [ number$ join ] done
+ actiontable share
+ behead drop
+ [ dup [] = iff
+ [ drop false ] done
+ behead
+ rot tuck oats iff
+ [ drop size 2 +
+ actiontable share
+ size swap -
+ names swap peek join
+ true ] done
+ swap again ]
+ if done
+ dup nest? iff
+ [ $ '[ ' rot join swap
+ [ dup [] = iff drop done
+ behead
+ -1 nesting tally
+ unbuild
+ 1 nesting tally
+ space join
+ swap dip join again ]
+ $ ']' join ]
+ else
+ [ drop
+ $ "Quackery was worried by a python."
+ fail ] ] resolves unbuild ( x --> $ )
+
+[ unbuild echo$ ] is echo ( x --> )
+
+[ $ ''
+ return -2 split drop
+ witheach
+ [ dup number? iff
+ [ number$ join
+ $ '} ' join ]
+ else
+ [ $ '{' swap dip join
+ actiontable share
+ findwith
+ [ over oats ] drop
+ dup actiontable share
+ found iff
+ [ 1 - names swap
+ peek join
+ space join ]
+ else
+ [ drop $ '[...] '
+ join ] ] ]
+ -1 split drop ] is return$ ( --> $ )
+
+[ return$ echo$ ] is echoreturn ( --> )
+
+[ stacksize dup 0 = iff
+ [ $ 'Stack empty.' echo$ drop ]
+ else
+ [ $ 'Stack: ' echo$
+ pack dup
+ witheach [ echo sp ]
+ unpack ]
+ cr ] is echostack ( --> )
+
+[ cr $ '' $ '/O> '
+ [ input
+ dup $ '' != while
+ carriage join join
+ $ '... ' again ]
+ drop
+ quackery
+ 5 nesting put
+ cr echostack
+ nesting release again ] is shell ( --> )
+
+[ cr randomise 12 random
+ [ table
+ $ 'Goodbye.' $ 'Adieu.' $ 'So long.'
+ $ 'Cheerio.' $ 'Aloha.' $ 'Ciao.'
+ $ 'Farewell.' $ 'Be seeing you.'
+ $ 'Sayonara.' $ 'Auf wiedersehen.'
+ $ 'Toodles.' $ 'Hasta la vista.' ]
+ do echo$ cr cr
+ 3 ]bailby[ ] is leave ( --> )
+
+[ stacksize times drop ] is empty ( all --> )
+
+[ tuck temp put
+ witheach
+ [ dup size
+ rot + dup
+ temp share > iff
+ [ cr drop dup size ]
+ else sp 1+ swap echo$ ]
+ drop temp release ] is wrap$ ( [ n --> )
+
+[ names reverse 70 wrap$ cr
+ builders reverse
+ 70 wrap$ cr ] is words ( --> )
+
+[ dup name? iff drop
+ else
+ [ dup sharefile not if
+ [ $ |$ 'file not found: "|
+ swap join
+ $ |"' echo$| join ]
+ nip quackery ] ] is loadfile ( $ --> )
+
+[ dup sharefile iff
+ [ swap releasefile ]
+ else [ drop false ] ] is takefile ( $ --> $ b )
+
+[ dup releasefile iff
+ putfile
+ else [ 2drop false ] ] is replacefile ( $ $ --> b )
+
+[ nested ' [ ' ]
+ swap join
+ decimal unbuild
+ base release ] is quackify ( x --> $ )
+
+$ "quackify replacefile takefile loadfile words empty wrap$ leave
+ shell echostack echoreturn return$ echo unbuild nesting quackery
+ build releasewords restorewords backupwords unresolved b.to-do
+ b.nesting message jobtable jobs builder? builders buildernest
+ reflect named? actiontable actions name? names namenest nest$ oats
+ bailed bail backup history shuffle random randomise initrandom
+ prng prng.d prng.c prng.b prng.a rot64 64bits 64bitmask $->n
+ char->n sort$ $> $< qacsfot sort sortwith sort.test not-do do-now
+ now-do add-to new-do to-do unpack pack reverse nextword trim
+ printable found findwith matchitem mi.result mi.tidyup echo$
+ witheach makewith with.hold number$ decimal base digit lower upper
+ sp space cr carriage findseq behead stuff pluck of table temp step
+ refresh conclude i^ i times times.action times.count times.start
+ abs decurse depth 2over 2swap dip dip.hold protect protected
+ nested move tally replace release share stack while until recurse
+ do this ' copy clamp max min else iff if done again 2drop 2dup
+ within unrot tuck bit mod nip / - < xor != or and not true false
+ sharefile releasefile putfile filepath input ding emit quid
+ operator? number? nest? size poke peek find join split [] take
+ immovable put ]bailby[ ]do[ ]this[ ]'[ ]else[ ]iff[ ]if[ ]again[
+ ]done[ over rot swap drop dup return nestdepth stacksize time ~ ^
+ | & >> << ** /mod * negate + 1+ > = nand fail python"
+
+nest$ namenest put
+
+[ table
+ quackify replacefile takefile loadfile words empty wrap$ leave
+ shell echostack echoreturn return$ echo unbuild nesting quackery
+ build releasewords restorewords backupwords unresolved b.to-do
+ b.nesting message jobtable jobs builder? builders buildernest
+ reflect named? actiontable actions name? names namenest nest$ oats
+ bailed bail backup history shuffle random randomise initrandom
+ prng prng.d prng.c prng.b prng.a rot64 64bits 64bitmask $->n
+ char->n sort$ $> $< qacsfot sort sortwith sort.test not-do do-now
+ now-do add-to new-do to-do unpack pack reverse nextword trim
+ printable found findwith matchitem mi.result mi.tidyup echo$
+ witheach makewith with.hold number$ decimal base digit lower upper
+ sp space cr carriage findseq behead stuff pluck of table temp step
+ refresh conclude i^ i times times.action times.count times.start
+ abs decurse depth 2over 2swap dip dip.hold protect protected
+ nested move tally replace release share stack while until recurse
+ do this ' copy clamp max min else iff if done again 2drop 2dup
+ within unrot tuck bit mod nip / - < xor != or and not true false
+ sharefile releasefile putfile filepath input ding emit quid
+ operator? number? nest? size poke peek find join split [] take
+ immovable put ]bailby[ ]do[ ]this[ ]'[ ]else[ ]iff[ ]if[ ]again[
+ ]done[ over rot swap drop dup return nestdepth stacksize time ~ ^
+ | & >> << ** /mod * negate + 1+ > = nand fail python ]
+
+ resolves actions ( n --> x )
+
+$ "constant now! hex say $ char resolves forward ) ( builds is ] ["
+nest$ buildernest put
+
+[ table
+ b.constant b.now! b.hex b.say b.$ b.char b.resolves
+ b.forward b.) b.( b.builds b.is b.] b.[ ]
+
+ resolves jobs ( n --> x )
+
+ """
+
+# bootstrap only once
+_qs = QuackeryContext()
+_qs.run(predefined_qky)
+predefined_operators = _qs.operators
+del _qs
+
+
+def quackery(source_string, ctx = None):
+
+ if ctx is None:
+ ctx = QuackeryContext()
+ else:
+ for required_word in ('stacksize', 'pack', 'decimal', 'unbuild', 'quackery'):
+ if required_word not in ctx.operators:
+ raise NameError('QuackeryContext must have word %s defined.' % required_word)
+
+ while True:
+ ctx.to_stack([ord(char) for char in source_string])
+ try:
+ ctx.run('quackery')
+ except QuackeryError as diagnostics:
+ if __name__ == '__main__' and len(sys.argv) == 1:
+ print(diagnostics)
+ continue
+ else:
+ raise
+ except Exception as diagnostics:
+ print('Quackery system damage detected.')
+ print('Python error: ' + str(diagnostics))
+ raise
+ else:
+ ctx.run('stacksize pack decimal unbuild')
+ the_stack = ctx.from_stack()
+ return ''.join(map(chr, the_stack[2:-2]))
+
+if __name__ == '__main__':
+ if len(sys.argv) > 1:
+ filename = sys.argv[1]
+ try:
+ with open(filename) as f:
+ filetext = f.read()
+ except FileNotFoundError:
+ print('file not found: "' + filename + '"')
+ sys.exit(1)
+ else:
+ try:
+ print(quackery(filetext))
+ print()
+ except QuackeryError as diagnostics:
+ print('\nQuackery crashed.\n')
+ print(diagnostics)
+ print()
+ sys.exit(1)
+ except Exception as diagnostics:
+ print('Quackery system damage detected.')
+ print('Python error: ' + str(diagnostics))
+ sys.exit(1)
+ else:
+ print('\nWelcome to Quackery.')
+ print('\nEnter "leave" to leave the shell.')
+ try:
+ quackery(r"""
+
+ $ 'extensions.qky' dup name? not
+ dip sharefile and iff
+ [ cr say 'Building extensions.' cr quackery ]
+ else drop
+
+ shell """)
+ except QuackeryError as diagnostics:
+ print('\nQuackery crashed.\n')
+ print(diagnostics)
+ print()
diff --git a/webapp.css b/webapp.css
new file mode 100644
index 0000000..7687342
--- /dev/null
+++ b/webapp.css
@@ -0,0 +1,32 @@
+body {
+ padding: none;
+ margin: none;
+ background: black;
+ color: white;
+ font-family: monospace;
+}
+
+.terminal {
+ --size: 1.5;
+}
+
+a:visited {
+ color: white;
+}
+
+a {
+ color: blue;
+}
+
+header {
+ height: 2em;
+ vertical-align: middle;
+ margin: none;
+ font-size: 1.5em;
+}
+
+#terminal {
+ height: calc(90vh - 2em);
+ padding: none;
+ margin: none;
+}
\ No newline at end of file
diff --git a/webapp_main.js b/webapp_main.js
new file mode 100644
index 0000000..9d7bdbd
--- /dev/null
+++ b/webapp_main.js
@@ -0,0 +1,70 @@
+// modified from the Pyodide console (https://pyodide.org/en/stable/console.html), since it already uses jQuery.terminal
+
+const ORIGIN = 'https://dragoncoder047.github.io/QuackeryFork'
+
+function sleep(s) {
+ return new Promise((resolve) => setTimeout(resolve, s));
+}
+
+window.addEventListener('DOMContentLoaded', async function main() {
+
+
+ var term = $("#terminal").terminal(() => {}, {
+ greetings: '',
+ prompt: '',
+ completionEscape: false,
+ pauseEvents: false,
+ exit: false,
+ scrollOnEcho: true,
+ mousewheel: () => true
+ });
+ term.pause();
+ window.term = term;
+ await sleep(500);
+ term.echo('Quackery (and Python) are loading...');
+ var c = setTimeout(() => term.echo('this may take a while...'), 5000);
+ try {
+ globalThis.pyodide = await loadPyodide({
+ homedir: '/quackery',
+ stderr: line => { clearTimeout(c); requestAnimationFrame(() => term.error(line)); },
+ stdout: line => { clearTimeout(c); requestAnimationFrame(() => term.echo(line)); },
+ stdin: window.prompt,
+ });
+
+
+ pyodide._api.on_fatal = async (e) => {
+ term.error("AAAAH!! You crashed Python! Please report this error:");
+ term.exception(e);
+ term.error("Look in the browser console for more details.");
+ term.pause();
+ await sleep(15);
+ term.pause();
+ };
+
+ var resp = await fetch('webapp_start.py');
+ var py = await resp.text();
+
+ await pyodide.runPythonAsync(py.replaceAll('@@ORIGIN@@', ORIGIN));
+
+ term.error('Reload the page to run Quackery again.');
+ }
+ catch (e) {
+ term.error('A fatal error occurred while loading Quackery.')
+ term.error('Please report this error if it continues to occur.');
+ term.error('https://github.com/dragoncoder047/QuackeryFork/issues');
+ term.echo();
+ term.exception(e);
+ term.echo();
+ term.echo('Until this problem is resolved, to run Quackery you can go to');
+ term.echo('https://www.pythonanywhere.com/embedded3/ and paste in this code:')
+ term.echo();
+ term.echo('from requests import get');
+ term.echo('def load(url):');
+ term.echo(' c = compile(get(url).text, url, \'exec\')');
+ term.echo(' exec(c, globals(), globals())');
+ term.echo('load(\'https://raw.githubusercontent.com/GordonCharlton/Quackery/main/quackery.py\')');
+ term.echo();
+ term.pause();
+ throw e;
+ }
+});
diff --git a/webapp_start.py b/webapp_start.py
new file mode 100644
index 0000000..4d5c4f1
--- /dev/null
+++ b/webapp_start.py
@@ -0,0 +1,71 @@
+# @@ORIGIN@@ will be replaced in Javascript
+
+from pyodide.http import pyfetch
+from os import mkdir
+import js
+
+async def delay(time):
+ await js.Promise.new(lambda resolve, reject: js.setTimeout(resolve, time))
+
+mkdir('sundry')
+files = ['bigrat', 'extensions', 'turtleduck', 'sundry/cards', 'sundry/demo', 'sundry/fsm', 'sundry/heapsort']
+
+for file in files:
+ print(f'Downloading {file}.qky... ', end='')
+ # N. B. top-level await is only allowed in Pyodide
+ resp = await pyfetch(f'@@ORIGIN@@/{file}.qky')
+ text = await resp.string()
+ with open(f'{file}.qky', 'w') as f: f.write(text)
+ await delay(300)
+ print('done')
+
+print('Downloading quackery_OOP.py... ', end='')
+resp = await pyfetch('@@ORIGIN@@/quackery_OOP.py')
+quackerytext = await resp.string()
+with open('quackery.py', 'w') as f: f.write(quackerytext)
+print('done')
+
+async def ainput(prompt):
+ term = js.term
+ term.resume()
+ print('\u200c', end='') #
+ promise = term.read(prompt)
+ term.history().enable()
+ result = await promise
+ term.pause()
+ return result
+
+print('Compiling builtins... ', end='')
+from quackery import quackery, QuackeryContext
+qc = QuackeryContext()
+print('done')
+
+quackery(r'''$ 'extensions.qky' dup name? not dip sharefile and iff [ say 'Compiling extensions... ' cr quackery say 'done' cr ] else drop''', qc)
+
+print('Starting...')
+await delay(1000)
+js.term.clear()
+
+print(r'''
+ ___ _ ___ _ _
+ / _ \ _ _ __ _ ___| | _____ _ __ _ _ / _ \ _ __ | (_)_ __ ___
+ | | | | | | |/ _` |/ __| |/ / _ \ '__| | | | | | | | '_ \| | | '_ \ / _ \
+ | |_| | |_| | (_| | (__| < __/ | | |_| | | |_| | | | | | | | | | __/
+ \__\_\\__,_|\__,_|\___|_|\_\___|_| \__, | \___/|_| |_|_|_|_| |_|\___|
+ |___/
+ Welcome to Quackery running on the Pyodide virtual machine.
+ Don't type 'leave' or you'll break something.''')
+
+async def shell_loop():
+ while True:
+ prompt = '/O> '
+ input = ''
+ while True:
+ i = await ainput(prompt)
+ input += i + '\n'
+ prompt = '... '
+ if not i:
+ break
+ qc.to_stack([ord(char) for char in input])
+ quackery('0 backup [ quackery ] bailed not iff [ 5 nesting put cr echostack nesting release ] else [ message take echo$ ]', qc)
+await shell_loop()
diff --git a/webapp_sw.js b/webapp_sw.js
new file mode 100644
index 0000000..6011a7c
--- /dev/null
+++ b/webapp_sw.js
@@ -0,0 +1,40 @@
+// modified from https://stackoverflow.com/questions/70455869/how-to-enable-sharedarraybuffer-in-microsoft-edge-javascript
+
+self.addEventListener("install", e => {
+ self.skipWaiting();
+ console.log('[service worker] installed!')
+});
+
+self.addEventListener("activate", e => {
+ e.waitUntil(self.clients.claim());
+ console.log('[service worker] activated!')
+});
+
+self.addEventListener("fetch", e => {
+ if (e.request.cache === "only-if-cached" && e.request.mode !== "same-origin") {
+ return;
+ }
+ console.log(`[service worker] fudging request to ${e.request.url} !`)
+
+ e.respondWith(
+ fetch(e.request).then(response => {
+ // It seems like we only need to set the headers for index.html
+ // If you want to be on the safe side, comment this out
+ // if (!response.url.includes("index.html")) return response;
+
+ const newHeaders = new Headers(response.headers);
+ newHeaders.set("Cross-Origin-Embedder-Policy", "require-corp");
+ newHeaders.set("Cross-Origin-Opener-Policy", "same-origin");
+
+ const fudgedResponse = new Response(response.body, {
+ status: response.status,
+ statusText: response.statusText,
+ headers: newHeaders,
+ });
+ console.log(`[service worker] fudging done!`)
+ return fudgedResponse;
+ }).catch(function (e) {
+ console.error(e);
+ })
+ );
+});
\ No newline at end of file